X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;ds=sidebyside;f=elmo%2Felmo-date.el;h=7a4fe4c54b0e20648b05df8f1035572af05e8a2d;hb=fceaa7d966c72630d1b8b146ae0414b4d144a8c6;hp=52e4c66cf25a67c015503db6c10d3d3703656ac8;hpb=85b5f594b70fad59980ac2f404404c712be02435;p=elisp%2Fwanderlust.git diff --git a/elmo/elmo-date.el b/elmo/elmo-date.el index 52e4c66..7a4fe4c 100644 --- a/elmo/elmo-date.el +++ b/elmo/elmo-date.el @@ -1,4 +1,4 @@ -;;; elmo-date.el -- Date processing module for ELMO. +;;; elmo-date.el --- Date processing module for ELMO. ;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi @@ -24,16 +24,74 @@ ;; ;;; Commentary: -;; +;; ;;; Code: -;; +;; (require 'path-util) -(if (module-installed-p 'timezone) - (require 'timezone)) +(require 'timezone) (require 'elmo-vars) +(eval-when-compile (require 'cl)) + +(defmacro elmo-match-substring (pos string from) + "Substring of POSth matched string of STRING." + `(substring ,string + (+ (match-beginning ,pos) ,from) + (match-end ,pos))) + +(defmacro elmo-match-string (pos string) + "Substring POSth matched STRING." + `(substring ,string (match-beginning ,pos) (match-end ,pos))) + +(defmacro elmo-match-buffer (pos) + "Substring POSth matched from the current buffer." + `(buffer-substring-no-properties + (match-beginning ,pos) (match-end ,pos))) + +;; from subr.el +(defun elmo-replace-in-string (str regexp newtext &optional literal) + "Replace all matches in STR for REGEXP with NEWTEXT string. +And returns the new string. +Optional LITERAL non-nil means do a literal replacement. +Otherwise treat \\ in NEWTEXT string as special: + \\& means substitute original matched text, + \\N means substitute match for \(...\) number N, + \\\\ means insert one \\." + (let ((rtn-str "") + (start 0) + (special) + match prev-start) + (while (setq match (string-match regexp str start)) + (setq prev-start start + start (match-end 0) + rtn-str + (concat + rtn-str + (substring str prev-start match) + (cond (literal newtext) + (t (mapconcat + (function + (lambda (c) + (if special + (progn + (setq special nil) + (cond ((eq c ?\\) "\\") + ((eq c ?&) + (elmo-match-string 0 str)) + ((and (>= c ?0) (<= c ?9)) + (if (> c (+ ?0 (length + (match-data)))) + ;; Invalid match num + (error "Invalid match num: %c" c) + (setq c (- c ?0)) + (elmo-match-string c str))) + (t (char-to-string c)))) + (if (eq c ?\\) (progn (setq special t) nil) + (char-to-string c))))) + newtext "")))))) + (concat rtn-str (substring str start)))) (defvar elmo-date-descriptions '((yesterday . [0 0 1]) @@ -58,7 +116,7 @@ (timezone-fix-time (current-time-string) (current-time-zone) nil))) (number - (string-to-int + (string-to-number (if (match-beginning 1) (elmo-match-string 1 description) "0"))) @@ -71,8 +129,14 @@ (error "%s is not supported yet" suffix))))) ((string-match "[0-9]+-[A-Za-z]+-[0-9]+" description) (timezone-fix-time - (concat (elmo-replace-in-string description "-" " ") " 0:00") - nil nil)))) + (concat (elmo-replace-in-string description "-" " ") " 0:0") + (current-time-zone) nil)) + ((string-match "\\([0-9]+\\)-\\([0-9]+\\)-\\([0-9]+\\)" description) + (vector (string-to-number (match-string 1 description)) + (string-to-number (match-string 2 description)) + (string-to-number (match-string 3 description)) + 0 0 0 + (current-time-zone))))) (defun elmo-datevec-substitute (datevec1 datevec2) (if (/= (aref datevec2 2) 0) @@ -100,8 +164,7 @@ (setq p 1) (while (< p month) (setq days (+ days (timezone-last-day-of-month p year))) - (setq p (+ p 1)) - ) + (setq p (+ p 1))) (setq days (+ days mday)) (aref wday (% days 7)))) @@ -140,11 +203,87 @@ (defmacro elmo-date-make-sortable-string (datevec) "Make a sortable string from DATEVEC." - (` (timezone-make-sortable-date - (aref (, datevec) 0) - (aref (, datevec) 1) - (aref (, datevec) 2) - (aref (, datevec) 3)))) + `(timezone-make-sortable-date + (aref ,datevec 0) + (aref ,datevec 1) + (aref ,datevec 2) + (timezone-make-time-string + (aref ,datevec 3) + (aref ,datevec 4) + (aref ,datevec 5)))) + +(defsubst elmo-datevec-to-time (datevec) + (encode-time (aref datevec 5) (aref datevec 4) (aref datevec 3) + (aref datevec 2) (aref datevec 1) (aref datevec 0) + (aref datevec 6))) + +(defun elmo-time-parse-date-string (date) + (ignore-errors + (elmo-datevec-to-time (timezone-fix-time date nil nil)))) + +(defun elmo-time-make-date-string (time) + (let ((system-time-locale "C")) + (format-time-string "%a, %d %b %Y %T %z" time))) + +(defun elmo-time-less-p (lhs rhs) + (while (and (car lhs) (car rhs)) + (cond ((< (car lhs) (car rhs)) + (setq lhs nil)) + ((= (car lhs) (car rhs)) + (setq lhs (cdr lhs) + rhs (cdr rhs))) + (t + (setq rhs nil)))) + (not (null rhs))) + +(defalias 'elmo-time< 'elmo-time-less-p) + +(defun elmo-time-to-days (time) + (let ((date (decode-time time))) + (timezone-absolute-from-gregorian + (nth 4 date) (nth 3 date) (nth 5 date)))) + +;; from timezone-fix-time in `timezone.el' +(defun elmo-time-to-datevec (time &optional timezone) + (when time + (let* ((date (decode-time time)) + (year (nth 5 date)) + (month (nth 4 date)) + (day (nth 3 date)) + (hour (nth 2 date)) + (minute (nth 1 date)) + (second (nth 0 date)) + (local (nth 8 date)) + (timezone + (or timezone + (timezone-time-zone-from-absolute + (timezone-absolute-from-gregorian month day year) + (+ second (* 60 (+ minute (* 60 hour))))))) + (diff (- (timezone-zone-to-minute timezone) (/ local 60))) + (minute (+ minute diff)) + (hour-fix (floor minute 60))) + (setq hour (+ hour hour-fix)) + (setq minute (- minute (* 60 hour-fix))) + ;; HOUR may be larger than 24 or smaller than 0. + (cond ((<= 24 hour) ;24 -> 00 + (setq hour (- hour 24)) + (setq day (1+ day)) + (when (< (timezone-last-day-of-month month year) day) + (setq month (1+ month)) + (setq day 1) + (when (< 12 month) + (setq month 1) + (setq year (1+ year))))) + ((> 0 hour) + (setq hour (+ hour 24)) + (setq day (1- day)) + (when (> 1 day) + (setq month (1- month)) + (when (> 1 month) + (setq month 12) + (setq year (1- year))) + (setq day (timezone-last-day-of-month month year))))) + (vector year month day hour minute second timezone)))) (require 'product) (product-provide (provide 'elmo-date) (require 'elmo-version))