diff options
| author | Richard M. Stallman | 1993-05-19 21:11:06 +0000 |
|---|---|---|
| committer | Richard M. Stallman | 1993-05-19 21:11:06 +0000 |
| commit | a47a5be5e7a7c87783c799a67c1ae2c7b019ea88 (patch) | |
| tree | ccbd3d88b22653421e5ca7e9bb5962bbbc96283b | |
| parent | f629b14cc120323e1225869cbaf9c950cef42b2e (diff) | |
| download | emacs-a47a5be5e7a7c87783c799a67c1ae2c7b019ea88.tar.gz emacs-a47a5be5e7a7c87783c799a67c1ae2c7b019ea88.zip | |
Initial revision
| -rw-r--r-- | lisp/tcp.el | 68 | ||||
| -rw-r--r-- | lisp/timezone.el | 306 |
2 files changed, 374 insertions, 0 deletions
diff --git a/lisp/tcp.el b/lisp/tcp.el new file mode 100644 index 00000000000..f9bd6e211a3 --- /dev/null +++ b/lisp/tcp.el | |||
| @@ -0,0 +1,68 @@ | |||
| 1 | ;;; TCP/IP stream emulation for GNU Emacs | ||
| 2 | ;; Copyright (C) 1988, 1989, 1993 Free Software Foundation, Inc. | ||
| 3 | |||
| 4 | ;;; Author: Masanobu Umeda | ||
| 5 | ;;; Maintainer: umerin@mse.kyutech.ac.jp | ||
| 6 | |||
| 7 | ;; This file is part of GNU Emacs. | ||
| 8 | |||
| 9 | ;; GNU Emacs is distributed in the hope that it will be useful, | ||
| 10 | ;; but WITHOUT ANY WARRANTY. No author or distributor | ||
| 11 | ;; accepts responsibility to anyone for the consequences of using it | ||
| 12 | ;; or for whether it serves any particular purpose or works at all, | ||
| 13 | ;; unless he says so in writing. Refer to the GNU Emacs General Public | ||
| 14 | ;; License for full details. | ||
| 15 | |||
| 16 | ;; Everyone is granted permission to copy, modify and redistribute | ||
| 17 | ;; GNU Emacs, but only under the conditions described in the | ||
| 18 | ;; GNU Emacs General Public License. A copy of this license is | ||
| 19 | ;; supposed to have been given to you along with GNU Emacs so you | ||
| 20 | ;; can know your rights and responsibilities. It should be in a | ||
| 21 | ;; file named COPYING. Among other things, the copyright notice | ||
| 22 | ;; and this notice must be preserved on all copies. | ||
| 23 | |||
| 24 | ;; Notes on TCP package: | ||
| 25 | ;; | ||
| 26 | ;; This package provides a TCP/IP stream emulation for GNU Emacs. If | ||
| 27 | ;; the function `open-network-stream' is not defined in Emacs, but | ||
| 28 | ;; your operating system has a capability of network stream | ||
| 29 | ;; connection, this tcp package can be used for communicating with | ||
| 30 | ;; NNTP server. | ||
| 31 | ;; | ||
| 32 | ;; The tcp package runs inferior process which actually does the role | ||
| 33 | ;; of `open-network-stream'. The program `tcp' provided with this | ||
| 34 | ;; package can be used for such purpose. Before loading the package, | ||
| 35 | ;; compile `tcp.c' and install it as `tcp' in a directory in the emacs | ||
| 36 | ;; search path. If you modify `tcp.c', please send diffs to the author | ||
| 37 | ;; of GNUS. I'll include some of them in the next releases. | ||
| 38 | |||
| 39 | (provide 'tcp) | ||
| 40 | |||
| 41 | (defvar tcp-program-name "tcp" | ||
| 42 | "*The name of the program emulating open-network-stream function.") | ||
| 43 | |||
| 44 | (defun open-network-stream (name buffer host service) | ||
| 45 | "Open a TCP connection for a service to a host. | ||
| 46 | Returns a subprocess-object to represent the connection. | ||
| 47 | Input and output work as for subprocesses; `delete-process' closes it. | ||
| 48 | Args are NAME BUFFER HOST SERVICE. | ||
| 49 | NAME is name for process. It is modified if necessary to make it unique. | ||
| 50 | BUFFER is the buffer (or buffer-name) to associate with the process. | ||
| 51 | Process output goes at end of that buffer, unless you specify | ||
| 52 | an output stream or filter function to handle the output. | ||
| 53 | BUFFER may be also nil, meaning that this process is not associated | ||
| 54 | with any buffer | ||
| 55 | Third arg is name of the host to connect to. | ||
| 56 | Fourth arg SERVICE is name of the service desired, or an integer | ||
| 57 | specifying a port number to connect to." | ||
| 58 | (let ((proc (start-process name buffer | ||
| 59 | tcp-program-name | ||
| 60 | host | ||
| 61 | (if (stringp service) | ||
| 62 | service | ||
| 63 | (int-to-string service)) | ||
| 64 | ))) | ||
| 65 | (process-kill-without-query proc) | ||
| 66 | ;; Return process | ||
| 67 | proc | ||
| 68 | )) | ||
diff --git a/lisp/timezone.el b/lisp/timezone.el new file mode 100644 index 00000000000..ac6997f8603 --- /dev/null +++ b/lisp/timezone.el | |||
| @@ -0,0 +1,306 @@ | |||
| 1 | ;;; Timezone package for GNU Emacs | ||
| 2 | |||
| 3 | ;; Copyright(C) 1990, 1991, 1992 Free Software Foundation, Inc. | ||
| 4 | |||
| 5 | ;; This file is part of GNU Emacs. | ||
| 6 | |||
| 7 | ;; GNU Emacs is free software; you can redistribute it and/or modify | ||
| 8 | ;; it under the terms of the GNU General Public License as published by | ||
| 9 | ;; the Free Software Foundation; either version 2, or (at your option) | ||
| 10 | ;; any later version. | ||
| 11 | |||
| 12 | ;; GNU Emacs is distributed in the hope that it will be useful, | ||
| 13 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 14 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 15 | ;; GNU General Public License for more details. | ||
| 16 | |||
| 17 | ;; You should have received a copy of the GNU General Public License | ||
| 18 | ;; along with GNU Emacs; see the file COPYING. If not, write to | ||
| 19 | ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. | ||
| 20 | |||
| 21 | ;;; Code: | ||
| 22 | |||
| 23 | (provide 'timezone) | ||
| 24 | |||
| 25 | (defvar timezone-world-timezones | ||
| 26 | '(("PST" . -800) | ||
| 27 | ("PDT" . -700) | ||
| 28 | ("MST" . -700) | ||
| 29 | ("MDT" . -600) | ||
| 30 | ("CST" . -600) | ||
| 31 | ("CDT" . -500) | ||
| 32 | ("EST" . -500) | ||
| 33 | ("EDT" . -400) | ||
| 34 | ("AST" . -400) ;by <clamen@CS.CMU.EDU> | ||
| 35 | ("NST" . -330) ;by <clamen@CS.CMU.EDU> | ||
| 36 | ("GMT" . +000) | ||
| 37 | ("BST" . +100) | ||
| 38 | ("MET" . +100) | ||
| 39 | ("EET" . +200) | ||
| 40 | ("JST" . +900) | ||
| 41 | ("GMT+1" . +100) ("GMT+2" . +200) ("GMT+3" . +300) | ||
| 42 | ("GMT+4" . +400) ("GMT+5" . +500) ("GMT+6" . +600) | ||
| 43 | ("GMT+7" . +700) ("GMT+8" . +800) ("GMT+9" . +900) | ||
| 44 | ("GMT+10" . +1000) ("GMT+11" . +1100) ("GMT+12" . +1200) ("GMT+13" . +1300) | ||
| 45 | ("GMT-1" . -100) ("GMT-2" . -200) ("GMT-3" . -300) | ||
| 46 | ("GMT-4" . -400) ("GMT-5" . -500) ("GMT-6" . -600) | ||
| 47 | ("GMT-7" . -700) ("GMT-8" . -800) ("GMT-9" . -900) | ||
| 48 | ("GMT-10" . -1000) ("GMT-11" . -1100) ("GMT-12" . -1200)) | ||
| 49 | "*Time differentials of timezone from GMT in hour.") | ||
| 50 | |||
| 51 | (defvar timezone-months-assoc | ||
| 52 | '(("JAN" . 1)("FEB" . 2)("MAR" . 3) | ||
| 53 | ("APR" . 4)("MAY" . 5)("JUN" . 6) | ||
| 54 | ("JUL" . 7)("AUG" . 8)("SEP" . 9) | ||
| 55 | ("OCT" . 10)("NOV" . 11)("DEC" . 12)) | ||
| 56 | "Alist of first three letters of a month and its numerical representation.") | ||
| 57 | |||
| 58 | (defun timezone-make-date-arpa-standard (date &optional local timezone) | ||
| 59 | "Convert DATE to an arpanet standard date. | ||
| 60 | Optional 1st argumetn LOCAL specifies the default local timezone of the DATE. | ||
| 61 | Optional 2nd argument TIMEZONE specifies a timezone to be represented in." | ||
| 62 | (let* ((date (timezone-parse-date date)) | ||
| 63 | (year (string-to-int (aref date 0))) | ||
| 64 | (month (string-to-int (aref date 1))) | ||
| 65 | (day (string-to-int (aref date 2))) | ||
| 66 | (time (timezone-parse-time (aref date 3))) | ||
| 67 | (hour (string-to-int (aref time 0))) | ||
| 68 | (minute (string-to-int (aref time 1))) | ||
| 69 | (second (string-to-int (aref time 2))) | ||
| 70 | (local (or (aref date 4) local)) ;Use original if defined | ||
| 71 | (timezone (or timezone local)) | ||
| 72 | (diff (- (timezone-zone-to-minute timezone) | ||
| 73 | (timezone-zone-to-minute local))) | ||
| 74 | (new (timezone-fix-time year month day | ||
| 75 | hour (+ minute diff) second))) | ||
| 76 | (timezone-make-arpa-date (aref new 0) (aref new 1) (aref new 2) | ||
| 77 | (timezone-make-time-string | ||
| 78 | (aref new 3) (aref new 4) (aref new 5)) | ||
| 79 | timezone) | ||
| 80 | )) | ||
| 81 | |||
| 82 | (defun timezone-make-date-sortable (date &optional local timezone) | ||
| 83 | "Convert DATE to a sortable date string. | ||
| 84 | Optional 1st argumetn LOCAL specifies the default local timezone of the DATE. | ||
| 85 | Optional 2nd argument TIMEZONE specifies a timezone to be represented in." | ||
| 86 | (let* ((date (timezone-parse-date date)) | ||
| 87 | (year (string-to-int (aref date 0))) | ||
| 88 | (month (string-to-int (aref date 1))) | ||
| 89 | (day (string-to-int (aref date 2))) | ||
| 90 | (time (timezone-parse-time (aref date 3))) | ||
| 91 | (hour (string-to-int (aref time 0))) | ||
| 92 | (minute (string-to-int (aref time 1))) | ||
| 93 | (second (string-to-int (aref time 2))) | ||
| 94 | (local (or (aref date 4) local)) ;Use original if defined | ||
| 95 | (timezone (or timezone local)) | ||
| 96 | (diff (- (timezone-zone-to-minute timezone) | ||
| 97 | (timezone-zone-to-minute local))) | ||
| 98 | (new (timezone-fix-time year month day | ||
| 99 | hour (+ minute diff) second))) | ||
| 100 | (timezone-make-sortable-date (aref new 0) (aref new 1) (aref new 2) | ||
| 101 | (timezone-make-time-string | ||
| 102 | (aref new 3) (aref new 4) (aref new 5))) | ||
| 103 | )) | ||
| 104 | |||
| 105 | |||
| 106 | ;; | ||
| 107 | ;; Parsers and Constructors of Date and Time | ||
| 108 | ;; | ||
| 109 | |||
| 110 | (defun timezone-make-arpa-date (year month day time &optional timezone) | ||
| 111 | "Make arpanet standard date string from YEAR, MONTH, DAY, and TIME. | ||
| 112 | Optional argument TIMEZONE specifies a time zone." | ||
| 113 | (format "%02d %s %4d %s%s" | ||
| 114 | day | ||
| 115 | (capitalize (car (rassq month timezone-months-assoc))) | ||
| 116 | ;;(- year (* (/ year 100) 100)) ;1990 -> 90 | ||
| 117 | (if (< year 100) (+ year 1900) year) ;90->1990 | ||
| 118 | time | ||
| 119 | (if timezone (concat " " timezone) "") | ||
| 120 | )) | ||
| 121 | |||
| 122 | (defun timezone-make-sortable-date (year month day time) | ||
| 123 | "Make sortable date string from YEAR, MONTH, DAY, and TIME." | ||
| 124 | (format "%4d%02d%02d%s" | ||
| 125 | ;;(- year (* (/ year 100) 100)) ;1990 -> 90 | ||
| 126 | (if (< year 100) (+ year 1900) year) ;90->1990 | ||
| 127 | month day time)) | ||
| 128 | |||
| 129 | (defun timezone-make-time-string (hour minute second) | ||
| 130 | "Make time string from HOUR, MINUTE, and SECOND." | ||
| 131 | (format "%02d:%02d:%02d" hour minute second)) | ||
| 132 | |||
| 133 | (defun timezone-parse-date (date) | ||
| 134 | "Parse DATE and return a vector [year month day time timezone]. | ||
| 135 | 19 is prepended to year if necessary. Timezone may be NIL if nothing. | ||
| 136 | Understand the following styles: | ||
| 137 | (1) 14 Apr 89 03:20[:12] [GMT] | ||
| 138 | (2) Fri, 17 Mar 89 4:01[:33] [GMT] | ||
| 139 | (3) Mon Jan 16 16:12[:37] [GMT] 1989 | ||
| 140 | (4) 6 May 1992 1641-JST (Wednesday)" | ||
| 141 | (let ((date (or date "")) | ||
| 142 | (year nil) | ||
| 143 | (month nil) | ||
| 144 | (day nil) | ||
| 145 | (time nil) | ||
| 146 | (zone nil)) ;This may be nil. | ||
| 147 | (cond ((string-match | ||
| 148 | "\\([0-9]+\\)[ \t]+\\([^ \t,]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+:[0-9:]+\\)[ \t]*\\'" date) | ||
| 149 | ;; Styles: (1) and (2) without timezone | ||
| 150 | (setq year 3 month 2 day 1 time 4 zone nil)) | ||
| 151 | ((string-match | ||
| 152 | "\\([0-9]+\\)[ \t]+\\([^ \t,]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+:[0-9:]+\\)[ \t]*\\([-+a-zA-Z0-9]+\\)" date) | ||
| 153 | ;; Styles: (1) and (2) with timezone and buggy timezone | ||
| 154 | (setq year 3 month 2 day 1 time 4 zone 5)) | ||
| 155 | ((string-match | ||
| 156 | "\\([^ \t,]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+:[0-9:]+\\)[ \t]+\\([0-9]+\\)" date) | ||
| 157 | ;; Styles: (3) without timezone | ||
| 158 | (setq year 4 month 1 day 2 time 3 zone nil)) | ||
| 159 | ((string-match | ||
| 160 | "\\([^ \t,]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+:[0-9:]+\\)[ \t]+\\([-+a-zA-Z0-9]+\\)[ \t]+\\([0-9]+\\)" date) | ||
| 161 | ;; Styles: (3) with timezoen | ||
| 162 | (setq year 5 month 1 day 2 time 3 zone 4)) | ||
| 163 | ((string-match | ||
| 164 | "\\([0-9]+\\)[ \t]+\\([^ \t,]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+\\)[ \t]*\\([-+a-zA-Z0-9]+\\)" date) | ||
| 165 | ;; Styles: (4) with timezone | ||
| 166 | (setq year 3 month 2 day 1 time 4 zone 5)) | ||
| 167 | ) | ||
| 168 | (if year | ||
| 169 | (progn | ||
| 170 | (setq year | ||
| 171 | (substring date (match-beginning year) (match-end year))) | ||
| 172 | ;; It is now Dec 1992. 8 years before the end of the World. | ||
| 173 | (if (< (length year) 4) | ||
| 174 | (setq year (concat "19" (substring year -2 nil)))) | ||
| 175 | (setq month | ||
| 176 | (int-to-string | ||
| 177 | (cdr | ||
| 178 | (assoc | ||
| 179 | (upcase | ||
| 180 | ;; Don't use `match-end' in order to take 3 | ||
| 181 | ;; letters from the beginning. | ||
| 182 | (substring date | ||
| 183 | (match-beginning month) | ||
| 184 | (+ (match-beginning month) 3))) | ||
| 185 | timezone-months-assoc)))) | ||
| 186 | (setq day | ||
| 187 | (substring date (match-beginning day) (match-end day))) | ||
| 188 | (setq time | ||
| 189 | (substring date (match-beginning time) (match-end time))))) | ||
| 190 | (if zone | ||
| 191 | (setq zone | ||
| 192 | (substring date (match-beginning zone) (match-end zone)))) | ||
| 193 | ;; Return a vector. | ||
| 194 | (if year | ||
| 195 | (vector year month day time zone) | ||
| 196 | (vector "0" "0" "0" "0" nil)) | ||
| 197 | )) | ||
| 198 | |||
| 199 | (defun timezone-parse-time (time) | ||
| 200 | "Parse TIME (HH:MM:SS) and return a vector [hour minute second]. | ||
| 201 | Recognize HH:MM:SS, HH:MM, HHMMSS, HHMM." | ||
| 202 | (let ((time (or time "")) | ||
| 203 | (hour nil) | ||
| 204 | (minute nil) | ||
| 205 | (second nil)) | ||
| 206 | (cond ((string-match "\\`\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)\\'" time) | ||
| 207 | ;; HH:MM:SS | ||
| 208 | (setq hour 1 minute 2 second 3)) | ||
| 209 | ((string-match "\\`\\([0-9]+\\):\\([0-9]+\\)\\'" time) | ||
| 210 | ;; HH:MM | ||
| 211 | (setq hour 1 minute 2 second nil)) | ||
| 212 | ((string-match "\\`\\([0-9][0-9]\\)\\([0-9][0-9]\\)\\([0-9][0-9]\\)\\'" time) | ||
| 213 | ;; HHMMSS | ||
| 214 | (setq hour 1 minute 2 second 3)) | ||
| 215 | ((string-match "\\`\\([0-9][0-9]\\)\\([0-9][0-9]\\)\\'" time) | ||
| 216 | ;; HHMM | ||
| 217 | (setq hour 1 minute 2 second nil)) | ||
| 218 | ) | ||
| 219 | ;; Return [hour minute second] | ||
| 220 | (vector | ||
| 221 | (if hour | ||
| 222 | (substring time (match-beginning hour) (match-end hour)) "0") | ||
| 223 | (if minute | ||
| 224 | (substring time (match-beginning minute) (match-end minute)) "0") | ||
| 225 | (if second | ||
| 226 | (substring time (match-beginning second) (match-end second)) "0")) | ||
| 227 | )) | ||
| 228 | |||
| 229 | |||
| 230 | ;; Miscellaneous | ||
| 231 | |||
| 232 | (defun timezone-zone-to-minute (timezone) | ||
| 233 | "Translate TIMEZONE (in zone name or integer) to integer minute." | ||
| 234 | (if timezone | ||
| 235 | (progn | ||
| 236 | (setq timezone | ||
| 237 | (or (cdr (assoc (upcase timezone) timezone-world-timezones)) | ||
| 238 | ;; +900 | ||
| 239 | timezone)) | ||
| 240 | (if (stringp timezone) | ||
| 241 | (setq timezone (string-to-int timezone))) | ||
| 242 | ;; Taking account of minute in timezone. | ||
| 243 | ;; HHMM -> MM | ||
| 244 | ;;(+ (* 60 (/ timezone 100)) (% timezone 100)) | ||
| 245 | ;; ANSI C compliance about truncation of integer division | ||
| 246 | ;; by eggert@twinsun.com (Paul Eggert) | ||
| 247 | (let* ((abszone (max timezone (- timezone))) | ||
| 248 | (minutes (+ (* 60 (/ abszone 100)) (% abszone 100)))) | ||
| 249 | (if (< timezone 0) (- minutes) minutes))) | ||
| 250 | 0)) | ||
| 251 | |||
| 252 | (defun timezone-fix-time (year month day hour minute second) | ||
| 253 | "Fix date and time." | ||
| 254 | ;; MINUTE may be larger than 60 or smaller than -60. | ||
| 255 | (let ((hour-fix | ||
| 256 | (if (< minute 0) | ||
| 257 | ;;(/ (- minute 59) 60) (/ minute 60) | ||
| 258 | ;; ANSI C compliance about truncation of integer division | ||
| 259 | ;; by eggert@twinsun.com (Paul Eggert) | ||
| 260 | (- (/ (- 59 minute) 60)) (/ minute 60)))) | ||
| 261 | (setq hour (+ hour hour-fix)) | ||
| 262 | (setq minute (- minute (* 60 hour-fix)))) | ||
| 263 | ;; HOUR may be larger than 24 or smaller than 0. | ||
| 264 | (cond ((<= 24 hour) ;24 -> 00 | ||
| 265 | (setq hour (- hour 24)) | ||
| 266 | (setq day (1+ day)) | ||
| 267 | (if (< (timezone-last-day-of-month month year) day) | ||
| 268 | (progn | ||
| 269 | (setq month (1+ month)) | ||
| 270 | (setq day 1) | ||
| 271 | (if (< 12 month) | ||
| 272 | (progn | ||
| 273 | (setq month 1) | ||
| 274 | (setq year (1+ year)) | ||
| 275 | )) | ||
| 276 | ))) | ||
| 277 | ((> 0 hour) | ||
| 278 | (setq hour (+ hour 24)) | ||
| 279 | (setq day (1- day)) | ||
| 280 | (if (> 1 day) | ||
| 281 | (progn | ||
| 282 | (setq month (1- month)) | ||
| 283 | (if (> 1 month) | ||
| 284 | (progn | ||
| 285 | (setq month 12) | ||
| 286 | (setq year (1- year)) | ||
| 287 | )) | ||
| 288 | (setq day (timezone-last-day-of-month month year)) | ||
| 289 | ))) | ||
| 290 | ) | ||
| 291 | (vector year month day hour minute second)) | ||
| 292 | |||
| 293 | ;; Partly copied from Calendar program by Edward M. Reingold. | ||
| 294 | ;; Thanks a lot. | ||
| 295 | |||
| 296 | (defun timezone-last-day-of-month (month year) | ||
| 297 | "The last day in MONTH during YEAR." | ||
| 298 | (if (and (= month 2) (timezone-leap-year-p year)) | ||
| 299 | 29 | ||
| 300 | (aref [31 28 31 30 31 30 31 31 30 31 30 31] (1- month)))) | ||
| 301 | |||
| 302 | (defun timezone-leap-year-p (year) | ||
| 303 | "Returns t if YEAR is a Gregorian leap year." | ||
| 304 | (or (and (zerop (% year 4)) | ||
| 305 | (not (zerop (% year 100)))) | ||
| 306 | (zerop (% year 400)))) | ||