elmo/elmo-date.el

   1 ;;; elmo-date.el --- Date processing module for ELMO.
   2
   3 ;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
   4
   5 ;; Author: Yuuichi Teranishi <teranisi@gohome.org>
   6 ;; Keywords: mail, net news
   7
   8 ;; This file is part of ELMO (Elisp Library for Message Orchestration).
   9
  10 ;; This program is free software; you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation; either version 2, or (at your option)
  13 ;; any later version.
  14 ;;
  15 ;; This program is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19 ;;
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  23 ;; Boston, MA 02111-1307, USA.
  24 ;;
  25
  26 ;;; Commentary:
  27 ;;
  28
  29 ;;; Code:
  30 ;;
  31
  32
  33 (require 'path-util)
  34 (require 'timezone)
  35 (require 'elmo-vars)
  36
  37 (defmacro elmo-match-substring (pos string from)
  38   "Substring of POSth matched string of STRING."
  39   (` (substring (, string)
  40                 (+ (match-beginning (, pos)) (, from))
  41                 (match-end (, pos)))))
  42
  43 (defmacro elmo-match-string (pos string)
  44   "Substring POSth matched STRING."
  45   (` (substring (, string) (match-beginning (, pos)) (match-end (, pos)))))
  46
  47 (defmacro elmo-match-buffer (pos)
  48   "Substring POSth matched from the current buffer."
  49   (` (buffer-substring-no-properties
  50       (match-beginning (, pos)) (match-end (, pos)))))
  51
  52 ;; from subr.el
  53 (defun elmo-replace-in-string (str regexp newtext &optional literal)
  54   "Replace all matches in STR for REGEXP with NEWTEXT string.
  55 And returns the new string.
  56 Optional LITERAL non-nil means do a literal replacement.
  57 Otherwise treat \\ in NEWTEXT string as special:
  58   \\& means substitute original matched text,
  59   \\N means substitute match for \(...\) number N,
  60   \\\\ means insert one \\."
  61   (let ((rtn-str "")
  62         (start 0)
  63         (special)
  64         match prev-start)
  65     (while (setq match (string-match regexp str start))
  66       (setq prev-start start
  67             start (match-end 0)
  68             rtn-str
  69             (concat
  70              rtn-str
  71              (substring str prev-start match)
  72              (cond (literal newtext)
  73                    (t (mapconcat
  74                        (function
  75                         (lambda (c)
  76                           (if special
  77                               (progn
  78                                 (setq special nil)
  79                                 (cond ((eq c ?\\) "\\")
  80                                       ((eq c ?&)
  81                                        (elmo-match-string 0 str))
  82                                       ((and (>= c ?0) (<= c ?9))
  83                                        (if (> c (+ ?0 (length
  84                                                        (match-data))))
  85                                            ;; Invalid match num
  86                                            (error "Invalid match num: %c" c)
  87                                          (setq c (- c ?0))
  88                                          (elmo-match-string c str)))
  89                                       (t (char-to-string c))))
  90                             (if (eq c ?\\) (progn (setq special t) nil)
  91                               (char-to-string c)))))
  92                        newtext ""))))))
  93     (concat rtn-str (substring str start))))
  94
  95 (defvar elmo-date-descriptions
  96   '((yesterday . [0 0 1])
  97     (lastweek  . [0 0 7])
  98     (lastmonth . [0 1 0])
  99     (lastyear  . [1 0 0])))
 100
 101 (defun elmo-date-get-description (datevec)
 102   (format "%d-%s-%d"
 103           (aref datevec 2)
 104           (car (rassq (aref datevec 1)
 105                       timezone-months-assoc))
 106           (aref datevec 0)))
 107
 108 (defun elmo-date-get-datevec (description)
 109   (cond
 110    ((not elmo-date-match)
 111     (error "Date match is not available"))
 112    ((string-match "^[ \t]*\\([0-9]+\\)?[ \t]*\\([a-zA-Z]+\\)$" description)
 113     (let ((today
 114            (save-match-data
 115              (timezone-fix-time (current-time-string) (current-time-zone)
 116                                 nil)))
 117           (number
 118            (string-to-int
 119             (if (match-beginning 1)
 120                 (elmo-match-string 1 description)
 121               "0")))
 122           (suffix (downcase (elmo-match-string 2 description)))
 123           pair)
 124       (if (setq pair (assq (intern suffix) elmo-date-descriptions))
 125           (elmo-datevec-substitute today (cdr pair))
 126         (if (string= "daysago" suffix)
 127             (elmo-date-get-offset-datevec today number)
 128           (error "%s is not supported yet" suffix)))))
 129    ((string-match "[0-9]+-[A-Za-z]+-[0-9]+" description)
 130     (timezone-fix-time
 131      (concat (elmo-replace-in-string description "-" " ") " 0:0")
 132      (current-time-zone) nil))
 133    ((string-match "\\([0-9]+\\)-\\([0-9]+\\)-\\([0-9]+\\)" description)
 134     (vector (string-to-number (match-string 1 description))
 135             (string-to-number (match-string 2 description))
 136             (string-to-number (match-string 3 description))
 137             0 0 0
 138             (current-time-zone)))))
 139
 140 (defun elmo-datevec-substitute (datevec1 datevec2)
 141   (if (/= (aref datevec2 2) 0)
 142       (elmo-date-get-offset-datevec datevec1 (aref datevec2 2))
 143     (let ((year (- (aref datevec1 0) (aref datevec2 0)))
 144           (month (- (aref datevec1 1) (aref datevec2 1)))
 145           (timezone (current-time-zone)))
 146       (while (<= month 0)
 147         (setq year (1- year)
 148               month (+ 12 month)))
 149       (timezone-fix-time
 150        (format "%d %s %d 0:00 %s"
 151                (aref datevec1 2)
 152                (car (rassq month timezone-months-assoc))
 153                year
 154                (cadr timezone)) nil nil))))
 155
 156 (defun elmo-date-get-week (year month mday)
 157   (let ((wday (symbol-value (intern (format
 158                                      "elmo-weekday-name-%s"
 159                                      elmo-lang))))
 160         y1 days p)
 161     (setq y1 (- year 1))
 162     (setq days (- (+ (* y1 365) (/ y1 400) (/ y1 4)) (/ y1 100)))
 163     (setq p 1)
 164     (while (< p month)
 165       (setq days (+ days (timezone-last-day-of-month p year)))
 166       (setq p (+ p 1)))
 167     (setq days (+ days mday))
 168     (aref wday (% days 7))))
 169
 170 (defun elmo-date-get-offset-datevec (datevec offset &optional time)
 171   (let ((year  (aref datevec 0))
 172         (month (aref datevec 1))
 173         (day   (aref datevec 2))
 174         (hour     (aref datevec 3))
 175         (minute   (aref datevec 4))
 176         (second   (aref datevec 5))
 177         (timezone (aref datevec 6))
 178         day-number p
 179         day-of-month)
 180     (setq p 1)
 181     (setq day-number (- (timezone-day-number month day year)
 182                         offset))
 183     (while (<= day-number 0)
 184       (setq year (1- year)
 185             day-number (+ (timezone-day-number 12 31 year)
 186                           day-number)))
 187     (while (> day-number (setq day-of-month
 188                                (timezone-last-day-of-month p year)))
 189       (setq day-number (- day-number day-of-month))
 190       (setq p (1+ p)))
 191     (setq month p)
 192     (setq day day-number)
 193     (timezone-fix-time
 194      (format "%d %s %d %s %s"
 195              day
 196              (car (rassq month timezone-months-assoc))
 197              year
 198              (if time
 199                  (format "%d:%d:%d" hour minute second)
 200                "0:00")
 201              (cadr timezone)) nil nil)))
 202
 203 (defmacro elmo-date-make-sortable-string (datevec)
 204   "Make a sortable string from DATEVEC."
 205   (` (timezone-make-sortable-date
 206       (aref (, datevec) 0)
 207       (aref (, datevec) 1)
 208       (aref (, datevec) 2)
 209       (timezone-make-time-string
 210        (aref (, datevec) 3)
 211        (aref (, datevec) 4)
 212        (aref (, datevec) 5)))))
 213
 214 (require 'product)
 215 (product-provide (provide 'elmo-date) (require 'elmo-version))
 216
 217 ;;; elmo-date.el ends here