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