current-time

[Yuuichi Teranishi]

tm-ja: 5371 の Mito さんによる current-time 実装を改造して、
サブ関数を使わないように(見えないように?)してみました。
できれば poe-18.el にマージしたいです。

;; 正しいかどうかは自信ありません。

;; 17日〜20日の間 unplugged になります。

(defun tera:current-time ()
  (let* ((cts (split-string (current-time-string) "[ :]"))
	 (yyyy (string-to-int (nth 6 cts)))
	 (mm (length (member (nth 1 cts)
			     '("Dec" "Nov" "Oct" "Sep" "Aug" "Jul"
			       "Jun" "May" "Apr" "Mar" "Feb" "Jan"))))
	 (dd (string-to-int (nth 2 cts)))
	 (HH (string-to-int (nth 3 cts)))
	 (MM (string-to-int (nth 4 cts)))
	 (SS (string-to-int (nth 5 cts)))
	 dn ct1 ct2 i1 i2
	 year uru)
    (setq ct1 0 ct2 0 i1 0 i2 0)
    (setq year (- yyyy 1970))
    (while (> year 0)
      (setq year (1- year)
	    ct1 (+ ct1 481)
	    ct2 (+ ct2 13184))
      (while (> ct2 65535)
	(setq ct1 (1+ ct1)
	      ct2 (- ct2 65536))))
    (setq uru (- (+ (- (/ yyyy 4) (/ yyyy 100)) 
		    (/ yyyy 400)) 477))
    (while (> uru 0)
      (setq uru (1- uru)
	    i1 (1+ i1)
	    i2 (+ i2 20864))
      (if (> i2 65535)
	  (setq i1 (1+ i1)
		i2 (- i2 65536))))
    (setq ct1 (+ ct1 i1)
	  ct2 (+ ct2 i2))
    (while (> ct2 65535)
      (setq ct1 (1+ ct1)
	    ct2 (- ct2 65536)))
    (setq dn (+ dd (* 31 (1- mm))))
    (if (> mm 2)
	(setq dn (+ (- dn (/ (+ 23 (* 4 mm)) 10))
		    (if (and (zerop (% yyyy 4))
			     (or (not (zerop (% yyyy 100)))
				 (zerop (% yyyy 400))))
			1 0))))
    (setq dn (1- dn)
	  i1 0 
	  i2 0)
    (while (> dn 0)
      (setq dn (1- dn)
	    i1 (1+ i1)
	    i2 (+ i2 20864))
      (if (> i2 65535)
	  (setq i1 (1+ i1)
		i2 (- i2 65536))))
    (setq ct1 (+ (+ (+ ct1 i1) (/ ct2 65536)) 
		 (/ (+ (* HH 3600) (* MM 60) SS)
		    65536))
	  ct2 (+ (+ i2 (% ct2 65536))
		 (% (+ (* HH 3600) (* MM 60) SS)
		    65536)))
    (while (< (- ct2 32400) 0)
      (setq ct1 (1- ct1)
	    ct2 (+ ct2 65536)))
    (setq ct2 (- ct2 32400))
    (while (> ct2 65535)
      (setq ct1 (1+ ct1)
	    ct2 (- ct2 65536)))
    (list ct1 ct2 0)))

--
Yuuichi Teranishi (寺西裕一) <teranisi ＠ gohome.org>
PGP 5.0i Public Key: http://www.gohome.org/pgp5/teranisi.key
"So we sailed out of the sun till we found the see of green..."