home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / elisp / misc / timezone.el < prev    next >
Encoding:
Text File  |  1993-02-01  |  10.3 KB  |  301 lines
  1. ;;; Timezone package for GNU Emacs
  2. ;; Copyright(C) 1990, 1991, 1992 Masanobu UMEDA (umerin@mse.kyutech.ac.jp)
  3. ;; $Header: timezone.el,v 1.4 93/01/26 12:05:40 umerin Locked $
  4.  
  5. ;; LCD Archive Entry:
  6. ;; timezone|Masanobu UMEDA|umerin@mse.kyutech.ac.jp|
  7. ;; Timezone package for GNU Emacs|
  8. ;; 93-01-26|1.4|~/misc/timezone.el.Z|
  9.  
  10. ;; This file is part of GNU Emacs.
  11.  
  12. ;; GNU Emacs is distributed in the hope that it will be useful,
  13. ;; but WITHOUT ANY WARRANTY.  No author or distributor
  14. ;; accepts responsibility to anyone for the consequences of using it
  15. ;; or for whether it serves any particular purpose or works at all,
  16. ;; unless he says so in writing.  Refer to the GNU Emacs General Public
  17. ;; License for full details.
  18.  
  19. ;; Everyone is granted permission to copy, modify and redistribute
  20. ;; GNU Emacs, but only under the conditions described in the
  21. ;; GNU Emacs General Public License.   A copy of this license is
  22. ;; supposed to have been given to you along with GNU Emacs so you
  23. ;; can know your rights and responsibilities.  It should be in a
  24. ;; file named COPYING.  Among other things, the copyright notice
  25. ;; and this notice must be preserved on all copies.
  26.  
  27. (provide 'timezone)
  28.  
  29. (defvar timezone-world-timezones
  30.   '(("PST" .  -800)
  31.     ("PDT" .  -700)
  32.     ("MST" .  -700)
  33.     ("MDT" .  -600)
  34.     ("CST" .  -600)
  35.     ("CDT" .  -500)
  36.     ("EST" .  -500)
  37.     ("EDT" .  -400)
  38.     ("GMT" .  +000)
  39.     ("BST" .  +100)
  40.     ("MET" .  +100)
  41.     ("EET" .  +200)
  42.     ("JST" .  +900)
  43.     ("GMT+1"  .  +100) ("GMT+2"  .  +200) ("GMT+3"  .  +300)
  44.     ("GMT+4"  .  +400) ("GMT+5"  .  +500) ("GMT+6"  .  +600)
  45.     ("GMT+7"  .  +700) ("GMT+8"  .  +800) ("GMT+9"  .  +900)
  46.     ("GMT+10" . +1000) ("GMT+11" . +1100) ("GMT+12" . +1200) ("GMT+13" . +1300)
  47.     ("GMT-1"  .  -100) ("GMT-2"  .  -200) ("GMT-3"  .  -300)
  48.     ("GMT-4"  .  -400) ("GMT-5"  .  -500) ("GMT-6"  .  -600)
  49.     ("GMT-7"  .  -700) ("GMT-8"  .  -800) ("GMT-9"  .  -900)
  50.     ("GMT-10" . -1000) ("GMT-11" . -1100) ("GMT-12" . -1200))
  51.   "*Time differentials of timezone from GMT in hour.")
  52.  
  53. (defvar timezone-months-assoc
  54.   '(("JAN" .  1)("FEB" .  2)("MAR" .  3)
  55.     ("APR" .  4)("MAY" .  5)("JUN" .  6)
  56.     ("JUL" .  7)("AUG" .  8)("SEP" .  9)
  57.     ("OCT" . 10)("NOV" . 11)("DEC" . 12))
  58.   "Alist of first three letters of a month and its numerical representation.")
  59.  
  60. (defun timezone-make-date-arpa-standard (date &optional local timezone)
  61.   "Convert DATE to an arpanet standard date.
  62. Optional 1st argumetn LOCAL specifies the default local timezone of the DATE.
  63. Optional 2nd argument TIMEZONE specifies a timezone to be represented in."
  64.   (let* ((date   (timezone-parse-date date))
  65.      (year   (string-to-int (aref date 0)))
  66.      (month  (string-to-int (aref date 1)))
  67.      (day    (string-to-int (aref date 2)))
  68.      (time   (timezone-parse-time (aref date 3)))
  69.      (hour   (string-to-int (aref time 0)))
  70.      (minute (string-to-int (aref time 1)))
  71.      (second (string-to-int (aref time 2)))
  72.      (local  (or (aref date 4) local)) ;Use original if defined
  73.      (timezone (or timezone local))
  74.      (diff   (- (timezone-zone-to-minute timezone)
  75.             (timezone-zone-to-minute local)))
  76.      (new    (timezone-fix-time year month day
  77.                     hour (+ minute diff) second)))
  78.     (timezone-make-arpa-date (aref new 0) (aref new 1) (aref new 2)
  79.                  (timezone-make-time-string
  80.                   (aref new 3) (aref new 4) (aref new 5))
  81.                  timezone)
  82.     ))
  83.  
  84. (defun timezone-make-date-sortable (date &optional local timezone)
  85.   "Convert DATE to a sortable date string.
  86. Optional 1st argumetn LOCAL specifies the default local timezone of the DATE.
  87. Optional 2nd argument TIMEZONE specifies a timezone to be represented in."
  88.   (let* ((date   (timezone-parse-date date))
  89.      (year   (string-to-int (aref date 0)))
  90.      (month  (string-to-int (aref date 1)))
  91.      (day    (string-to-int (aref date 2)))
  92.      (time   (timezone-parse-time (aref date 3)))
  93.      (hour   (string-to-int (aref time 0)))
  94.      (minute (string-to-int (aref time 1)))
  95.      (second (string-to-int (aref time 2)))
  96.      (local  (or (aref date 4) local)) ;Use original if defined
  97.      (timezone (or timezone local))
  98.      (diff   (- (timezone-zone-to-minute timezone)
  99.             (timezone-zone-to-minute local)))
  100.      (new    (timezone-fix-time year month day
  101.                     hour (+ minute diff) second)))
  102.     (timezone-make-sortable-date (aref new 0) (aref new 1) (aref new 2)
  103.                  (timezone-make-time-string
  104.                   (aref new 3) (aref new 4) (aref new 5)))
  105.     ))
  106.  
  107.  
  108. ;;
  109. ;; Parsers and Constructors of Date and Time
  110. ;;
  111.  
  112. (defun timezone-make-arpa-date (year month day time &optional timezone)
  113.   "Make arpanet standard date string from YEAR, MONTH, DAY, and TIME.
  114. Optional argument TIMEZONE specifies a time zone."
  115.   (format "%02d %s %4d %s%s"
  116.       day
  117.       (capitalize (car (rassq month timezone-months-assoc)))
  118.       ;;(- year (* (/ year 100) 100))    ;1990 -> 90
  119.       (if (< year 100) (+ year 1900) year) ;90->1990
  120.       time
  121.       (if timezone (concat " " timezone) "")
  122.       ))
  123.  
  124. (defun timezone-make-sortable-date (year month day time)
  125.   "Make sortable date string from YEAR, MONTH, DAY, and TIME."
  126.   (format "%4d%02d%02d%s"
  127.       ;;(- year (* (/ year 100) 100))    ;1990 -> 90
  128.       (if (< year 100) (+ year 1900) year) ;90->1990
  129.       month day time))
  130.  
  131. (defun timezone-make-time-string (hour minute second)
  132.   "Make time string from HOUR, MINUTE, and SECOND."
  133.   (format "%02d:%02d:%02d" hour minute second))
  134.  
  135. (defun timezone-parse-date (date)
  136.   "Parse DATE and return a vector [year month day time timezone].
  137. 19 is prepended to year if necessary. Timezone may be NIL if nothing.
  138. Understand the following styles:
  139.  (1) 14 Apr 89 03:20[:12] [GMT]
  140.  (2) Fri, 17 Mar 89 4:01[:33] [GMT]
  141.  (3) Mon Jan 16 16:12[:37] [GMT] 1989
  142.  (4) 6 May 1992 1641-JST (Wednesday)"
  143.   (let ((date (or date ""))
  144.     (year nil)
  145.     (month nil)
  146.     (day nil)
  147.     (time nil)
  148.     (zone nil))            ;This may be nil.
  149.     (cond ((string-match
  150. "\\([0-9]+\\) \\([^ ,]+\\) \\([0-9]+\\) \\([0-9]+:[0-9:]+\\)[ ]*\\'" date)
  151.        ;; Styles: (1) and (2) without timezone
  152.        (setq year 3 month 2 day 1 time 4 zone nil))
  153.       ((string-match
  154. "\\([0-9]+\\) \\([^ ,]+\\) \\([0-9]+\\) \\([0-9]+:[0-9:]+\\)[ ]*\\([-+a-zA-Z0-9]+\\)" date)
  155.        ;; Styles: (1) and (2) with timezone and buggy timezone
  156.        (setq year 3 month 2 day 1 time 4 zone 5))
  157.       ((string-match
  158. "\\([^ ,]+\\) +\\([0-9]+\\) \\([0-9]+:[0-9:]+\\) \\([0-9]+\\)" date)
  159.        ;; Styles: (3) without timezone
  160.        (setq year 4 month 1 day 2 time 3 zone nil))
  161.       ((string-match
  162. "\\([^ ,]+\\) +\\([0-9]+\\) \\([0-9]+:[0-9:]+\\) \\([-+a-zA-Z0-9]+\\) \\([0-9]+\\)" date)
  163.        ;; Styles: (3) with timezoen
  164.        (setq year 5 month 1 day 2 time 3 zone 4))
  165.       ((string-match
  166. "\\([0-9]+\\) \\([^ ,]+\\) \\([0-9]+\\) \\([0-9]+\\)[ ]*\\([-+a-zA-Z0-9]+\\)" date)
  167.        ;; Styles: (4) with timezone
  168.        (setq year 3 month 2 day 1 time 4 zone 5))
  169.       )
  170.     (if year
  171.     (progn
  172.       (setq year
  173.         (substring date (match-beginning year) (match-end year)))
  174.       ;; It is now Dec 1992.  8 years before the end of the World.
  175.       (if (< (length year) 4)
  176.           (setq year (concat "19" (substring year -2 nil))))
  177.       (setq month
  178.         (int-to-string
  179.          (cdr
  180.           (assoc
  181.            (upcase
  182.             ;; Don't use `match-end' in order to take 3
  183.             ;; letters from the beginning.
  184.             (substring date
  185.                    (match-beginning month)
  186.                    (+ (match-beginning month) 3)))
  187.            timezone-months-assoc))))
  188.       (setq day
  189.         (substring date (match-beginning day) (match-end day)))
  190.       (setq time
  191.         (substring date (match-beginning time) (match-end time)))))
  192.     (if zone
  193.     (setq zone
  194.           (substring date (match-beginning zone) (match-end zone))))
  195.     ;; Return a vector.
  196.     (if year
  197.     (vector year month day time zone)
  198.       (vector "0" "0" "0" "0" nil))
  199.     ))
  200.  
  201. (defun timezone-parse-time (time)
  202.   "Parse TIME (HH:MM:SS) and return a vector [hour minute second].
  203. Recognize HH:MM:SS, HH:MM, HHMMSS, HHMM."
  204.   (let ((time (or time ""))
  205.     (hour nil)
  206.     (minute nil)
  207.     (second nil))
  208.     (cond ((string-match "\\`\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)\\'" time)
  209.        ;; HH:MM:SS
  210.        (setq hour 1 minute 2 second 3))
  211.       ((string-match "\\`\\([0-9]+\\):\\([0-9]+\\)\\'" time)
  212.        ;; HH:MM
  213.        (setq hour 1 minute 2 second nil))
  214.       ((string-match "\\`\\([0-9][0-9]\\)\\([0-9][0-9]\\)\\([0-9][0-9]\\)\\'" time)
  215.        ;; HHMMSS
  216.        (setq hour 1 minute 2 second 3))
  217.       ((string-match "\\`\\([0-9][0-9]\\)\\([0-9][0-9]\\)\\'" time)
  218.        ;; HHMM
  219.        (setq hour 1 minute 2 second nil))
  220.       )
  221.     ;; Return [hour minute second]
  222.     (vector
  223.      (if hour
  224.      (substring time (match-beginning hour) (match-end hour)) "0")
  225.      (if minute
  226.      (substring time (match-beginning minute) (match-end minute)) "0")
  227.      (if second
  228.      (substring time (match-beginning second) (match-end second)) "0"))
  229.     ))
  230.  
  231.  
  232. ;; Miscellaneous
  233.  
  234. (defun timezone-zone-to-minute (timezone)
  235.   "Translate TIMEZONE (in zone name or integer) to integer minute."
  236.   (if timezone
  237.       (progn
  238.     (setq timezone
  239.           (or (cdr (assoc (upcase timezone) timezone-world-timezones))
  240.           ;; +900
  241.           timezone))
  242.     (if (stringp timezone)
  243.         (setq timezone (string-to-int timezone)))
  244.     ;; Taking account of minute in timezone.
  245.     ;; HHMM -> MM
  246.     (+ (* 60 (/ timezone 100)) (% timezone 100)))
  247.     0))
  248.  
  249. (defun timezone-fix-time (year month day hour minute second)
  250.   "Fix date and time."
  251.   ;; MINUTE may be larger than 60 or smaller than -60.
  252.   (let ((hour-fix
  253.      (if (< minute 0)
  254.          (/ (- minute 59) 60) (/ minute 60))))
  255.     (setq hour (+ hour hour-fix))
  256.     (setq minute (- minute (* 60 hour-fix))))
  257.   ;; HOUR may be larger than 24 or smaller than 0.
  258.   (cond ((<= 24 hour)            ;24 -> 00
  259.      (setq hour (- hour 24))
  260.      (setq day  (1+ day))
  261.      (if (< (timezone-last-day-of-month month year) day)
  262.          (progn
  263.            (setq month (1+ month))
  264.            (setq day 1)
  265.            (if (< 12 month)
  266.            (progn
  267.              (setq month 1)
  268.              (setq year (1+ year))
  269.              ))
  270.            )))
  271.     ((> 0 hour)
  272.      (setq hour (+ hour 24))
  273.      (setq day  (1- day))
  274.      (if (> 1 day)
  275.          (progn
  276.            (setq month (1- month))
  277.            (if (> 1 month)
  278.            (progn
  279.              (setq month 12)
  280.              (setq year (1- year))
  281.              ))
  282.            (setq day (timezone-last-day-of-month month year))
  283.            )))
  284.     )
  285.   (vector year month day hour minute second))
  286.  
  287. ;; Partly copied from Calendar program by Edward M. Reingold.
  288. ;; Thanks a lot.
  289.  
  290. (defun timezone-last-day-of-month (month year)
  291.   "The last day in MONTH during YEAR."
  292.   (if (and (= month 2) (timezone-leap-year-p year))
  293.       29
  294.     (aref [31 28 31 30 31 30 31 31 30 31 30 31] (1- month))))
  295.  
  296. (defun timezone-leap-year-p (year)
  297.   "Returns t if YEAR is a Gregorian leap year."
  298.   (or (and (zerop  (mod year 4))
  299.        (not (zerop (mod year 100))))
  300.       (zerop (mod year 400))))
  301.