+Sat Sep 5 01:45:52 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
+
+ * gnus.el: Pterodactyl Gnus v0.15 is released.
+
+1998-09-05 00:21:22 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * date.el: New file.
+
+ * gnus-util.el (gnus-encode-date): Removed.
+ (gnus-time-less): Ditto.
+
+ * nnmail.el (nnmail-date-to-time): Removed.
+ (nnmail-time-less): Ditto.
+ (nnmail-days-to-time): Ditto.
+ (nnmail-time-since): Ditto.
+
+ * drums.el: New file.
+
+1998-09-04 00:25:52 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * message.el (message-encode-message-body): Encode headers with
+ body encoding.
+
+ * rfc2047.el (rfc2047-default-charset): Renamed.
+ (rfc2047-encodable-p): Use it.
+
+ * base64.el (mm-util): Required.
+
+1998-09-03 16:28:30 Lars Magne Ingebrigtsen <larsi@gnus.org>
+
+ * gnus-msg.el (gnus-post-method): Peel off real info from opened
+ servers.
+
+ * gnus-util.el (gnus-output-to-rmail): Removed.
+
+ * gnus-art.el (gnus-summary-save-in-rmail): Use
+ gnus-output-to-rmailrmail-output-to-rmail-file.
+
+ * rfc2047.el (rfc2047-decode-region): Fold case.
+ (rfc2047-decode): Use decode-string.
+
+ * mm-util.el: Provide mm-char-int.
+
Thu Sep 3 15:23:22 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
* gnus.el: Pterodactyl Gnus v0.14 is released.
--- /dev/null
+;;; date.el --- Date and time handling functions
+;; Copyright (C) 1998 Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
+;; Masanobu Umeda <umerin@mse.kyutech.ac.jp>
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'timezone)
+
+(defun parse-time-string (date)
+ "Convert DATE into time."
+ (decode-time
+ (condition-case ()
+ (let* ((d1 (timezone-parse-date date))
+ (t1 (timezone-parse-time (aref d1 3))))
+ (apply 'encode-time
+ (mapcar (lambda (el)
+ (and el (string-to-number el)))
+ (list
+ (aref t1 2) (aref t1 1) (aref t1 0)
+ (aref d1 2) (aref d1 1) (aref d1 0)
+ (number-to-string
+ (* 60 (timezone-zone-to-minute (aref d1 4))))))))
+ ;; If we get an error, then we just return a 0 time.
+ (error (list 0 0)))))
+
+(defun date-to-time (date)
+ "Convert DATE into time."
+ (apply 'encode-time (parse-time-string date)))
+
+(defun time-less (t1 t2)
+ "Say whether time T1 is less than time T2."
+ (or (< (car t1) (car t2))
+ (and (= (car t1) (car t2))
+ (< (nth 1 t1) (nth 1 t2)))))
+
+(defun days-to-time (days)
+ "Convert DAYS into time."
+ (let* ((seconds (* 1.0 days 60 60 24))
+ (rest (expt 2 16))
+ (ms (condition-case nil (floor (/ seconds rest))
+ (range-error (expt 2 16)))))
+ (list ms (condition-case nil (round (- seconds (* ms rest)))
+ (range-error (expt 2 16))))))
+
+(defun time-since (time)
+ "Return the time since TIME, which is either an internal time or a date."
+ (when (stringp time)
+ ;; Convert date strings to internal time.
+ (setq time (date-to-time time)))
+ (let* ((current (current-time))
+ (rest (when (< (nth 1 current) (nth 1 time))
+ (expt 2 16))))
+ (list (- (+ (car current) (if rest -1 0)) (car time))
+ (- (+ (or rest 0) (nth 1 current)) (nth 1 time)))))
+
+(defun subtract-time (t1 t2)
+ "Subtract two internal times."
+ (let ((borrow (< (cadr t1) (cadr t2))))
+ (list (- (car t1) (car t2) (if borrow 1 0))
+ (- (+ (if borrow 65536 0) (cadr t1)) (cadr t2)))))
+
+(defun date-to-day (date)
+ "Return the number of days between year 1 and DATE."
+ (time-to-day (date-to-time date)))
+
+(defun days-between (date1 date2)
+ "Return the number of days between DATE1 and DATE2."
+ (- (date-to-day date1) (date-to-day date2)))
+
+(defun date-leap-year-p (year)
+ "Return t if YEAR is a leap year."
+ (or (and (zerop (% year 4))
+ (not (zerop (% year 100))))
+ (zerop (% year 400))))
+
+(defun time-to-day-in-year (time)
+ "Return the day number within the year of the date month/day/year."
+ (let* ((tim (decode-time time))
+ (month (nth 4 tim))
+ (day (nth 3 tim))
+ (year (nth 5 tim))
+ (day-of-year (+ day (* 31 (1- month)))))
+ (when (> month 2)
+ (setq day-of-year (- day-of-year (/ (+ 23 (* 4 month)) 10)))
+ (when (date-leap-year-p year)
+ (setq day-of-year (1+ day-of-year))))
+ day-of-year))
+
+(defun time-to-day (time)
+ "The number of days between the Gregorian date 0001-12-31bce and TIME.
+The Gregorian date Sunday, December 31, 1bce is imaginary."
+ (let* ((tim (decode-time time))
+ (month (nth 4 tim))
+ (day (nth 3 tim))
+ (year (nth 5 tim)))
+ (+ (time-to-day-in-year time) ; Days this year
+ (* 365 (1- year)) ; + Days in prior years
+ (/ (1- year) 4) ; + Julian leap years
+ (- (/ (1- year) 100)) ; - century years
+ (/ (1- year) 400)))) ; + Gregorian leap years
+
+(provide 'date)
+
+;;; date.el ends here
--- /dev/null
+;;; drums.el --- Functions for parsing RFC822bis headers
+;; Copyright (C) 1998 Free Software Foundation, Inc.
+
+;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; DRUMS is and IETF Working Group that works (or worked) on the
+;; successor to RFC822, "Standard For The Format Of Arpa Internet Text
+;; Messages". This library is based on
+;; draft-ietf-drums-msg-fmt-05.txt, released on 1998-08-05.
+
+;;; Code:
+
+(require 'date)
+
+(defvar drums-no-ws-ctl-token "\001-\010\013\014\016-\037\177"
+ "US-ASCII control characters excluding CR, LF and white space.")
+(defvar drums-text-token "\001-\011\013\014\016-\177"
+ "US-ASCII characters exlcuding CR and LF.")
+(defvar drums-specials-token "()<>[]:;@\\,.\""
+ "Special characters.")
+(defvar drums-quote-token "\\"
+ "Quote character.")
+(defvar drums-wsp-token " \t"
+ "White space.")
+(defvar drums-fws-regexp
+ (concat "[" drums-wsp-token "]*\n[" drums-wsp-token "]+")
+ "Folding white space.")
+(defvar drums-atext-token "-^a-zA-Z0-9!#$%&'*+/=?_`{|}~"
+ "Textual token.")
+(defvar drums-dot-atext-token "-^a-zA-Z0-9!#$%&'*+/=?_`{|}~."
+ "Textual token including full stop.")
+(defvar drums-qtext-token
+ (concat drums-no-ws-ctl-token "\041\043-\133\135-\177")
+ "Non-white-space control characaters, plus the rest of ASCII excluding backslash and doublequote.")
+
+(defvar drums-syntax-table
+ (let ((table (copy-syntax-table emacs-lisp-mode-syntax-table)))
+ (modify-syntax-entry ?\\ "/" table)
+ (modify-syntax-entry ?< "(" table)
+ (modify-syntax-entry ?> ")" table)
+ table))
+
+(defsubst drums-init (string)
+ (set-syntax-table drums-syntax-table)
+ (insert string)
+ (drums-unfold-fws)
+ (goto-char (point-min)))
+
+(defun drums-remove-comments (string)
+ "Remove comments from STRING."
+ (with-temp-buffer
+ (let (c)
+ (drums-init string)
+ (while (not (eobp))
+ (setq c (following-char))
+ (cond
+ ((eq c ?\")
+ (forward-sexp 1))
+ ((eq c ?\()
+ (delete-region (point) (progn (forward-sexp 1) (point))))
+ (t
+ (forward-char 1))))
+ (buffer-string))))
+
+(defun drums-remove-whitespace (string)
+ "Remove comments from STRING."
+ (with-temp-buffer
+ (drums-init string)
+ (let (c)
+ (while (not (eobp))
+ (setq c (following-char))
+ (cond
+ ((eq c ?\")
+ (forward-sexp 1))
+ ((memq c '(? ?\t))
+ (delete-char 1))
+ (t
+ (forward-char 1))))
+ (buffer-string))))
+
+(defun drums-get-comment (string)
+ "Return the first comment in STRING."
+ (with-temp-buffer
+ (drums-init string)
+ (let (result c)
+ (while (not (eobp))
+ (setq c (following-char))
+ (cond
+ ((eq c ?\")
+ (forward-sexp 1))
+ ((eq c ?\()
+ (setq result
+ (buffer-substring
+ (1+ (point))
+ (progn (forward-sexp 1) (1- (point)))))
+ (goto-char (point-max)))
+ (t
+ (forward-char 1))))
+ result)))
+
+(defun drums-parse-address (string)
+ "Parse STRING and return a MAILBOX / DISPLAY-NAME pair."
+ (with-temp-buffer
+ (let (display-name mailbox c)
+ (drums-init string)
+ (while (not (eobp))
+ (setq c (following-char))
+ (cond
+ ((or (eq c ? )
+ (eq c ?\t))
+ (forward-char 1))
+ ((eq c ?\()
+ (forward-sexp 1))
+ ((eq c ?\")
+ (push (buffer-substring
+ (1+ (point)) (progn (forward-sexp 1) (1- (point))))
+ display-name))
+ ((looking-at (concat "[" drums-atext-token "]"))
+ (push (buffer-substring (point) (progn (forward-word 1) (point)))
+ display-name))
+ ((eq c ?<)
+ (setq mailbox
+ (drums-remove-whitespace
+ (drums-remove-comments
+ (buffer-substring
+ (1+ (point))
+ (progn (forward-sexp 1) (1- (point))))))))
+ (t (error "Unknown symbol: %c" c))))
+ ;; If we found no display-name, then we look for comments.
+ (if display-name
+ (setq display-name (mapconcat 'identity (nreverse display-name) " "))
+ (setq display-name (drums-get-comment string)))
+ (when mailbox
+ (cons mailbox display-name)))))
+
+(defun drums-parse-addresses (string)
+ "Parse STRING and return a list of MAILBOX / DISPLAY-NAME pairs."
+ (with-temp-buffer
+ (drums-init string)
+ (let ((beg (point))
+ pairs c)
+ (while (not (eobp))
+ (setq c (following-char))
+ (cond
+ ((memq c '(?\" ?< ?\())
+ (forward-sexp 1))
+ ((eq c ?,)
+ (push (drums-parse-address (buffer-substring beg (1- (point))))
+ pairs)
+ (setq beg (point)))
+ (t
+ (forward-char 1))))
+ (nreverse pairs))))
+
+(defun drums-unfold-fws ()
+ "Unfold folding white space in the current buffer."
+ (goto-char (point-min))
+ (while (re-search-forward drums-fws-regexp nil t)
+ (replace-match " " t t))
+ (goto-char (point-min)))
+
+(defun drums-parse-date (string)
+ "Return an Emacs time spec from STRING."
+ (encode-time (parse-time-string string)))
+
+(provide 'drums)
+
+;;; drums.el ends here
(let ((dir (concat
(gnus-agent-directory)
(gnus-agent-group-path group) "/"))
- (date (gnus-time-to-day (current-time)))
+ (date (time-to-day (current-time)))
(case-fold-search t)
pos crosses id elem)
(gnus-make-directory dir)
(gnus-agent-enter-history
"last-header-fetched-for-session"
(list (cons group (nth (- (length articles) 1) articles)))
- (gnus-time-to-day (current-time)))
+ (time-to-day (current-time)))
articles))))))
(defsubst gnus-agent-copy-nov-line (article)
"Expire all old articles."
(interactive)
(let ((methods gnus-agent-covered-methods)
- (day (- (gnus-time-to-day (current-time)) gnus-agent-expire-days))
+ (day (- (time-to-day (current-time)) gnus-agent-expire-days))
gnus-command-method sym group articles
history overview file histories elem art nov-file low info
unreads marked article)
:group 'gnus-article-washing)
(eval-and-compile
- (autoload 'timezone-make-date-arpa-standard "timezone")
(autoload 'mail-extract-address-components "mail-extr"))
(defcustom gnus-save-all-headers t
((eq elem 'date)
(let ((date (message-fetch-field "date")))
(when (and date
- (< (gnus-days-between (current-time-string) date)
+ (< (days-between (current-time-string) date)
4))
(gnus-article-hide-header "date"))))
((eq elem 'long-to)
;; functions since they aren't particularly resistant to
;; buggy dates.
((eq type 'local)
- (concat "Date: " (condition-case ()
- (timezone-make-date-arpa-standard date)
- (error date))))
+ (concat "Date: " (current-time-string (date-to-time date))))
;; Convert to Universal Time.
((eq type 'ut)
(concat "Date: "
- (condition-case ()
- (timezone-make-date-arpa-standard date nil "UT")
- (error date))))
+ (current-time-string
+ (let ((e (parse-time-string date)))
+ (setcar (last e) 0)
+ (encode-time e)))))
;; Get the original date from the article.
((eq type 'original)
(concat "Date: " date))
;; Let the user define the format.
((eq type 'user)
(if (gnus-functionp gnus-article-time-format)
- (funcall
- gnus-article-time-format
- (ignore-errors
- (gnus-encode-date
- (timezone-make-date-arpa-standard
- date nil "UT"))))
+ (funcall gnus-article-time-format (date-to-time date))
(concat
"Date: "
- (format-time-string gnus-article-time-format
- (ignore-errors
- (gnus-encode-date
- (timezone-make-date-arpa-standard
- date nil "UT")))))))
+ (format-time-string gnus-article-time-format (date-to-time date)))))
;; ISO 8601.
((eq type 'iso8601)
(concat
"Date: "
- (format-time-string "%Y%M%DT%h%m%s"
- (ignore-errors
- (gnus-encode-date
- (timezone-make-date-arpa-standard
- date nil "UT"))))))
+ (format-time-string "%Y%M%DT%h%m%s" (date-to-time date))))
;; Do an X-Sent lapsed format.
((eq type 'lapsed)
;; If the date is seriously mangled, the timezone functions are
;; liable to bug out, so we ignore all errors.
(let* ((now (current-time))
- (real-time
- (ignore-errors
- (gnus-time-minus
- (gnus-encode-date
- (timezone-make-date-arpa-standard
- (current-time-string now)
- (current-time-zone now) "UT"))
- (gnus-encode-date
- (timezone-make-date-arpa-standard
- date nil "UT")))))
+ (real-time (subtract-time now (date-to-time date)))
(real-sec (and real-time
(+ (* (float (car real-time)) 65536)
(cadr real-time))))
(save-excursion
(save-restriction
(widen)
- (gnus-output-to-rmail filename))))
+ (rmail-output-to-rmail-file filename))))
filename)
(defun gnus-summary-save-in-mail (&optional filename)
(widen)
(if (and (file-readable-p filename)
(mail-file-babyl-p filename))
- (gnus-output-to-rmail filename t)
+ (rmail-output-to-rmail-file filename t)
(gnus-output-to-mail filename)))))
filename)
(defun gnus-demon-nntp-close-connection ()
(save-window-excursion
- (when (nnmail-time-less '(0 300)
- (nnmail-time-since nntp-last-command-time))
+ (when (subtract-time '(0 300) (time-since nntp-last-command-time))
(nntp-close-server))))
(defun gnus-demon-add-scanmail ()
"Return the offset in seconds from the timestamp for GROUP to the current time, as a floating point number."
(let* ((time (or (gnus-group-timestamp group)
(list 0 0)))
- (delta (gnus-time-minus (current-time) time)))
+ (delta (subtract-time (current-time) time)))
(+ (* (nth 0 delta) 65536.0)
(nth 1 delta))))
;; It's on the form (regexp . date).
(if (zerop (gnus-execute field (car kill-list)
command nil (not all)))
- (when (> (gnus-days-between date (cdr kill-list))
+ (when (> (days-between date (cdr kill-list))
gnus-kill-expiry-days)
(setq regexp nil))
(setcdr kill-list date))
(setq kdate (cdr kill))
(if (zerop (gnus-execute
field (car kill) command nil (not all)))
- (when (> (gnus-days-between date kdate)
+ (when (> (days-between date kdate)
gnus-kill-expiry-days)
;; Time limit has been exceeded, so we
;; remove the match.
((eq type 'at)
(equal date match))
((eq type 'before)
- (gnus-time-less match date))
+ (time-less match date))
((eq type 'after)
- (gnus-time-less date match))
+ (time-less date match))
(t
(error "No such date score type: %s" type)))))
(list gnus-post-method)))
gnus-secondary-select-methods
(mapcar 'cdr gnus-server-alist)
- gnus-opened-servers
+ (mapcar 'car gnus-opened-servers)
(list gnus-select-method)
(list group-method)))
method-alist post-methods method)
(let ((date (mail-header-date header))
issuer b e type)
(when (or (not date)
- (nnmail-time-less
- (nnmail-time-since (nnmail-date-to-time date))
- (nnmail-days-to-time gnus-nocem-expiry-wait)))
+ (time-less
+ (time-since (date-to-time date))
+ (days-to-time gnus-nocem-expiry-wait)))
(gnus-request-article-this-buffer (mail-header-number header) group)
(goto-char (point-min))
(when (re-search-forward "-----BEGIN PGP MESSAGE-----" nil t)
(let* ((alist gnus-nocem-alist)
(pprev (cons nil alist))
(prev pprev)
- (expiry (nnmail-days-to-time gnus-nocem-expiry-wait))
+ (expiry (days-to-time gnus-nocem-expiry-wait))
entry)
(setq gnus-nocem-hashtb (gnus-make-hashtable (* (length alist) 51)))
(while (setq entry (car alist))
- (if (not (nnmail-time-less (nnmail-time-since (car entry)) expiry))
+ (if (not (subtract-time (time-since (car entry)) expiry))
;; This entry has expired, so we remove it.
(setcdr prev (cdr alist))
(setq prev alist)
(type
(list match score
(and date (if (numberp date) date
- (gnus-day-number date)))
+ (date-to-day date)))
type))
- (date (list match score (gnus-day-number date)))
+ (date (list match score (date-to-day date)))
(score (list match score))
(t (list match))))
;; We see whether we can collapse some score entries.
(or (not decay)
(gnus-decay-scores alist decay)))
(gnus-score-set 'touched '(t) alist)
- (gnus-score-set 'decay (list (gnus-time-to-day (current-time))) alist))
+ (gnus-score-set 'decay (list (time-to-day (current-time))) alist))
;; We do not respect eval and files atoms from global score
;; files.
(when (and files (not global))
(setcar scor
(list (caar scor) (nth 2 (car scor))
(and (nth 3 (car scor))
- (gnus-day-number (nth 3 (car scor))))
+ (date-to-day (nth 3 (car scor))))
(if (nth 1 (car scor)) 'r 's)))
(setq scor (cdr scor))))
(push (if (not (listp (cdr entry)))
(when (and gnus-summary-default-score
scores)
(let* ((entries gnus-header-index)
- (now (gnus-day-number (current-time-string)))
+ (now (date-to-day (current-time-string)))
(expire (and gnus-score-expiry-days
(- now gnus-score-expiry-days)))
(headers gnus-newsgroup-headers)
(memq 'word gnus-newsgroup-adaptive))
(with-temp-buffer
(let* ((hashtb (gnus-make-hashtable 1000))
- (date (gnus-day-number (current-time-string)))
+ (date (date-to-day (current-time-string)))
(data gnus-newsgroup-data)
(syntab (syntax-table))
word d score val)
(defun gnus-decay-scores (alist day)
"Decay non-permanent scores in ALIST."
- (let ((times (- (gnus-time-to-day (current-time)) day))
+ (let ((times (- (time-to-day (current-time)) day))
kill entry updated score n)
(unless (zerop times) ;Done decays today already?
(while (setq entry (pop alist))
(defsubst gnus-article-sort-by-date (h1 h2)
"Sort articles by root article date."
- (gnus-time-less
+ (time-less
(gnus-date-get-time (mail-header-date h1))
(gnus-date-get-time (mail-header-date h2))))
number dependencies force-new))))
(push header headers))
(forward-line 1))
- (error
- (gnus-error 4 "Strange nov line (%d)"
- (count-lines (point-min) (point)))))
+ ;(error
+ ; (gnus-error 4 "Strange nov line (%d)"
+ ; (count-lines (point-min) (point))))
+ )
(forward-line 1))
;; A common bug in inn is that if you have posted an article and
;; then retrieves the active file, it will answer correctly --
(interactive "nTime in days: \nP")
(prog1
(let ((data gnus-newsgroup-data)
- (cutoff (nnmail-days-to-time age))
+ (cutoff (days-to-time age))
articles d date is-younger)
(while (setq d (pop data))
(when (and (vectorp (gnus-data-header d))
(setq date (mail-header-date (gnus-data-header d))))
- (setq is-younger (nnmail-time-less
- (nnmail-time-since (nnmail-date-to-time date))
+ (setq is-younger (subtract-time
+ (time-since (date-to-time date))
cutoff))
(when (if younger-p
is-younger
If N is nil and any articles have been marked with the process mark,
save those articles instead."
(interactive "P")
- (let ((gnus-default-article-saver 'gnus-summary-save-in-rmail))
+ (let ((gnus-default-article-saver 'rmail-output-to-rmail-file))
(gnus-summary-save-article arg)))
(defun gnus-summary-save-article-file (&optional arg)
(require 'custom)
(eval-when-compile (require 'cl))
(require 'nnheader)
-(require 'timezone)
(require 'message)
+(require 'date)
(eval-and-compile
- (autoload 'nnmail-date-to-time "nnmail")
(autoload 'rmail-insert-rmail-file-header "rmail")
(autoload 'rmail-count-new-messages "rmail")
(autoload 'rmail-show-message "rmail"))
;;; Time functions.
-(defun gnus-days-between (date1 date2)
- ;; Return the number of days between date1 and date2.
- (- (gnus-day-number date1) (gnus-day-number date2)))
-
-(defun gnus-day-number (date)
- (let ((dat (mapcar (lambda (s) (and s (string-to-int s)) )
- (timezone-parse-date date))))
- (timezone-absolute-from-gregorian
- (nth 1 dat) (nth 2 dat) (car dat))))
-
-(defun gnus-time-to-day (time)
- "Convert TIME to day number."
- (let ((tim (decode-time time)))
- (timezone-absolute-from-gregorian
- (nth 4 tim) (nth 3 tim) (nth 5 tim))))
-
-(defun gnus-encode-date (date)
- "Convert DATE to internal time."
- (let* ((parse (timezone-parse-date date))
- (date (mapcar (lambda (d) (and d (string-to-int d))) parse))
- (time (mapcar 'string-to-int (timezone-parse-time (aref parse 3)))))
- (encode-time (caddr time) (cadr time) (car time)
- (caddr date) (cadr date) (car date)
- (* 60 (timezone-zone-to-minute (nth 4 date))))))
-
-(defun gnus-time-minus (t1 t2)
- "Subtract two internal times."
- (let ((borrow (< (cadr t1) (cadr t2))))
- (list (- (car t1) (car t2) (if borrow 1 0))
- (- (+ (if borrow 65536 0) (cadr t1)) (cadr t2)))))
-
-(defun gnus-time-less (t1 t2)
- "Say whether time T1 is less than time T2."
- (or (< (car t1) (car t2))
- (and (= (car t1) (car t2))
- (< (nth 1 t1) (nth 1 t2)))))
-
(defun gnus-file-newer-than (file date)
(let ((fdate (nth 5 (file-attributes file))))
(or (> (car fdate) (car date))
'(0 0)
(or (get-text-property 0 'gnus-time d)
;; or compute the value...
- (let ((time (nnmail-date-to-time d)))
+ (let ((time (date-to-time d)))
;; and store it back in the string.
(put-text-property 0 1 'gnus-time time d)
time)))))
;;; Functions for saving to babyl/mail files.
-(defvar rmail-default-rmail-file)
-(defun gnus-output-to-rmail (filename &optional ask)
- "Append the current article to an Rmail file named FILENAME."
- (require 'rmail)
- ;; Most of these codes are borrowed from rmailout.el.
- (setq filename (expand-file-name filename))
- (setq rmail-default-rmail-file filename)
- (let ((artbuf (current-buffer))
- (tmpbuf (gnus-get-buffer-create " *Gnus-output*")))
- (save-excursion
- (or (get-file-buffer filename)
- (file-exists-p filename)
- (if (or (not ask)
- (gnus-yes-or-no-p
- (concat "\"" filename "\" does not exist, create it? ")))
- (let ((file-buffer (create-file-buffer filename)))
- (save-excursion
- (set-buffer file-buffer)
- (rmail-insert-rmail-file-header)
- (let ((require-final-newline nil))
- (gnus-write-buffer filename)))
- (kill-buffer file-buffer))
- (error "Output file does not exist")))
- (set-buffer tmpbuf)
- (erase-buffer)
- (insert-buffer-substring artbuf)
- (gnus-convert-article-to-rmail)
- ;; Decide whether to append to a file or to an Emacs buffer.
- (let ((outbuf (get-file-buffer filename)))
- (if (not outbuf)
- (append-to-file (point-min) (point-max) filename)
- ;; File has been visited, in buffer OUTBUF.
- (set-buffer outbuf)
- (let ((buffer-read-only nil)
- (msg (and (boundp 'rmail-current-message)
- (symbol-value 'rmail-current-message))))
- ;; If MSG is non-nil, buffer is in RMAIL mode.
- (when msg
- (widen)
- (narrow-to-region (point-max) (point-max)))
- (insert-buffer-substring tmpbuf)
- (when msg
- (goto-char (point-min))
- (widen)
- (search-backward "\^_")
- (narrow-to-region (point) (point-max))
- (goto-char (1+ (point-min)))
- (rmail-count-new-messages t)
- (rmail-show-message msg))
- (save-buffer)))))
- (kill-buffer tmpbuf)))
-
(defun gnus-output-to-mail (filename &optional ask)
"Append the current article to a mail file named FILENAME."
(setq filename (expand-file-name filename))
:link '(custom-manual "(gnus)Exiting Gnus")
:group 'gnus)
-(defconst gnus-version-number "0.14"
+(defconst gnus-version-number "0.15"
"Version number for this version of Gnus.")
(defconst gnus-version (format "Pterodactyl Gnus v%s" gnus-version-number)
("browse-url" browse-url)
("message" :interactive t
message-send-and-exit message-yank-original)
- ("nnmail" nnmail-split-fancy nnmail-article-group nnmail-date-to-time)
+ ("nnmail" nnmail-split-fancy nnmail-article-group)
("nnvirtual" nnvirtual-catchup-group nnvirtual-convert-headers)
("timezone" timezone-make-date-arpa-standard timezone-fix-time
timezone-make-sortable-date timezone-make-time-string)
("rmailout" rmail-output)
("rmail" rmail-insert-rmail-file-header rmail-count-new-messages
- rmail-show-message)
+ rmail-show-message rmail-output-to-rmail-file)
("gnus-audio" :interactive t gnus-audio-play)
("gnus-xmas" gnus-xmas-splash)
("gnus-soup" :interactive t
"4.99"
(+ 5 (* 0.02
(abs
- (- (char-int (aref (downcase alpha) 0))
- (char-int ?t))))
+ (- (mm-char-int (aref (downcase alpha) 0))
+ (mm-char-int ?t))))
-0.01))
minor least)
(format "%d.%02d%02d" major minor least))))))
run-with-idle-timer mouse-minibuffer-check window-edges
event-click-count track-mouse read-event mouse-movement-p
event-end mouse-scroll-subr overlay-lists delete-overlay
- set-face-stipple mail-abbrevs-setup char-int
+ set-face-stipple mail-abbrevs-setup
make-char-table set-char-table-range font-create-object
x-color-values widget-make-intangible error-message-string
w3-form-encode-xwfu gnus-mule-get-coding-system
set-buffer-multibyte
find-non-ascii-charset-region char-charset
mule-write-region-no-coding-system
- find-charset-region))
+ find-charset-region base64-decode-string))
(maybe-bind '(global-face-data
mark-active transient-mark-mode mouse-selection-click-count
mouse-selection-click-count-buffer buffer-display-table
gnus-mule-get-coding-system decode-coding-string
mail-aliases-setup
mm-copy-tree url-view-url w3-prepare-buffer
- char-int mule-write-region-no-coding-system)))
+ mule-write-region-no-coding-system char-int)))
(setq load-path (cons "." load-path))
(require 'custom)
(goto-char (point-max))
(mm-insert-rfc822-headers
(or charset (mm-mule-charset-to-mime-charset 'ascii))
- encoding))))))
+ encoding)
+ (mm-encode-body))))))
(run-hooks 'message-load-hook)
"Create a rot table with offset N."
(let ((i -1)
(table (make-string 256 0))
- (a (char-int ?a))
- (A (char-int ?A)))
+ (a (mm-char-int ?a))
+ (A (mm-char-int ?A)))
(while (< (incf i) 256)
(aset table i i))
(concat
(t
(let ((mime-charset (mm-mule-charset-to-mime-charset (car charsets)))
start)
- (when (not (mm-coding-system-equal
- mime-charset buffer-file-coding-system))
+ (when (or t
+ ;; We always decode.
+ (not (mm-coding-system-equal
+ mime-charset buffer-file-coding-system)))
(while (not (eobp))
(if (eq (char-charset (following-char)) 'ascii)
(when start
(goto-char (point-min))
(while (and (not found)
(not (eobp)))
- (when (> (char-int (following-char)) 127)
+ (when (> (mm-char-int (following-char)) 127)
(setq found t))
(forward-char 1))
(not found))))
(defun mm-decode-body (charset encoding)
"Decode the current article that has been encoded with ENCODING.
The characters in CHARSET should then be decoded."
+ (setq charset (or charset rfc2047-default-charset))
(save-excursion
(when encoding
(cond
(error nil)))
((memq encoding '(7bit 8bit binary))
)
+ ((null encoding)
+ )
(t
(error "Can't decode encoding %s" encoding))))
(when (featurep 'mule)
(when (and charset
(setq mule-charset (mm-charset-to-coding-system charset))
buffer-file-coding-system
- (not (mm-coding-system-equal
- buffer-file-coding-system mule-charset)))
+ ;;(not (mm-coding-system-equal
+ ;; buffer-file-coding-system mule-charset))
+ )
(mm-decode-coding-region (point-min) (point-max) mule-charset))))))
(provide 'mm-bodies)
(fset 'mm-coding-system-list 'coding-system-list)
(fset 'mm-coding-system-list 'ignore))
+ (if (fboundp 'char-int)
+ (fset 'mm-char-int 'char-int)
+ (fset 'mm-char-int 'identity))
+
(if (fboundp 'coding-system-equal)
(fset 'mm-coding-system-equal 'coding-system-equal)
(fset 'mm-coding-system-equal 'equal))
msg))
(if (nnmail-expired-article-p
group
- (gnus-encode-date
- (substring msg (match-beginning 1) (match-end 1)))
+ (date-to-time (substring msg (match-beginning 1) (match-end 1)))
force)
(progn
(setq delete-list (concat delete-list " " (int-to-string art)))
(defun nnmail-request-post (&optional server)
(mail-send-and-exit nil))
-(defvar nnmail-file-coding-system 'raw-text
+(defvar nnmail-file-coding-system 'binary
"Coding system used in nnmail.")
(defun nnmail-find-file (file)
(after-insert-file-functions nil))
(condition-case ()
(let ((coding-system-for-read nnmail-file-coding-system)
- (pathname-coding-system 'binary))
+ (pathname-coding-system nnmail-file-coding-system))
(insert-file-contents file)
t)
(file-error nil))))
"/")))
(or file "")))
-(defun nnmail-date-to-time (date)
- "Convert DATE into time."
- (condition-case ()
- (let* ((d1 (timezone-parse-date date))
- (t1 (timezone-parse-time (aref d1 3))))
- (apply 'encode-time
- (mapcar (lambda (el)
- (and el (string-to-number el)))
- (list
- (aref t1 2) (aref t1 1) (aref t1 0)
- (aref d1 2) (aref d1 1) (aref d1 0)
- (number-to-string
- (* 60 (timezone-zone-to-minute (aref d1 4))))))))
- ;; If we get an error, then we just return a 0 time.
- (error (list 0 0))))
-
-(defun nnmail-time-less (t1 t2)
- "Say whether time T1 is less than time T2."
- (or (< (car t1) (car t2))
- (and (= (car t1) (car t2))
- (< (nth 1 t1) (nth 1 t2)))))
-
-(defun nnmail-days-to-time (days)
- "Convert DAYS into time."
- (let* ((seconds (* 1.0 days 60 60 24))
- (rest (expt 2 16))
- (ms (condition-case nil (floor (/ seconds rest))
- (range-error (expt 2 16)))))
- (list ms (condition-case nil (round (- seconds (* ms rest)))
- (range-error (expt 2 16))))))
-
-(defun nnmail-time-since (time)
- "Return the time since TIME, which is either an internal time or a date."
- (when (stringp time)
- ;; Convert date strings to internal time.
- (setq time (nnmail-date-to-time time)))
- (let* ((current (current-time))
- (rest (when (< (nth 1 current) (nth 1 time))
- (expt 2 16))))
- (list (- (+ (car current) (if rest -1 0)) (car time))
- (- (+ (or rest 0) (nth 1 current)) (nth 1 time)))))
-
;; Function rewritten from rmail.el.
(defun nnmail-move-inbox (inbox)
"Move INBOX to `nnmail-crash-box'."
;; This is an ange-ftp group, and we don't have any dates.
nil)
((numberp days)
- (setq days (nnmail-days-to-time days))
+ (setq days (days-to-time days))
;; Compare the time with the current time.
- (nnmail-time-less days (nnmail-time-since time)))))))
+ (subtract-time days (time-since time)))))))
(defvar nnmail-read-passwd nil)
(defun nnmail-read-passwd (prompt &rest args)
(deffoo nnml-request-list (&optional server)
(save-excursion
(let ((nnmail-file-coding-system nnmail-active-file-coding-system)
- (pathname-coding-system 'binary)) ; for XEmacs/mule
- (nnmail-find-file nnml-active-file)
- )
+ (pathname-coding-system 'binary))
+ (nnmail-find-file nnml-active-file))
(setq nnml-group-alist (nnmail-get-active))
t))
(prog1
(nntp-send-command
"^\\.\r?\n" "NEWGROUPS"
- (format-time-string "%y%m%d %H%M%S" (nnmail-date-to-time date)))
+ (format-time-string "%y%m%d %H%M%S" (date-to-time date)))
(nntp-decode-text))))
(deffoo nntp-request-post (&optional server)
(require 'qp)
(require 'mm-util)
-(defvar rfc2047-unencoded-charsets '(ascii latin-iso8859-1)
- "List of MULE charsets not to encode.")
+(defvar rfc2047-default-charset 'iso-8859-1
+ "Default MIME charset -- does not need encoding.")
(defvar rfc2047-header-encoding-alist
'(("Newsgroups" . nil)
(defun rfc2047-encodable-p ()
"Say whether the current (narrowed) buffer contains characters that need encoding."
- (let ((charsets (find-charset-region (point-min) (point-max)))
- (cs rfc2047-unencoded-charsets)
+ (let ((charsets (mapcar
+ 'mm-mule-charset-to-mime-charset
+ (find-charset-region (point-min) (point-max))))
+ (cs (list 'us-ascii rfc2047-default-charset))
found)
(while charsets
(unless (memq (pop charsets) cs)
(defun rfc2047-decode-region (start end)
"Decode MIME-encoded words in region between START and END."
(interactive "r")
- (save-excursion
- (save-restriction
- (narrow-to-region start end)
- (goto-char (point-min))
- ;; Remove whitespace between encoded words.
- (while (re-search-forward
- (concat "\\(" rfc2047-encoded-word-regexp "\\)"
- "\\(\n?[ \t]\\)+"
- "\\(" rfc2047-encoded-word-regexp "\\)")
- nil t)
- (delete-region (goto-char (match-end 1)) (match-beginning 6)))
- ;; Decode the encoded words.
- (goto-char (point-min))
- (while (re-search-forward rfc2047-encoded-word-regexp nil t)
- (insert (rfc2047-parse-and-decode
- (prog1
- (match-string 0)
- (delete-region (match-beginning 0) (match-end 0)))))))))
+ (let ((case-fold-search t)
+ b e)
+ (save-excursion
+ (save-restriction
+ (narrow-to-region start end)
+ (goto-char (point-min))
+ ;; Remove whitespace between encoded words.
+ (while (re-search-forward
+ (concat "\\(" rfc2047-encoded-word-regexp "\\)"
+ "\\(\n?[ \t]\\)+"
+ "\\(" rfc2047-encoded-word-regexp "\\)")
+ nil t)
+ (delete-region (goto-char (match-end 1)) (match-beginning 6)))
+ ;; Decode the encoded words.
+ (setq b (goto-char (point-min)))
+ (while (re-search-forward rfc2047-encoded-word-regexp nil t)
+ (setq e (match-beginning 0))
+ (insert (rfc2047-parse-and-decode
+ (prog1
+ (match-string 0)
+ (delete-region (match-beginning 0) (match-end 0)))))
+ (decode-coding-region b e rfc2047-default-charset)
+ (setq b (point)))
+ (decode-coding-region b (point-max) rfc2047-default-charset)))))
;;;###autoload
(defun rfc2047-decode-string (string)
(mm-decode-coding-string
(cond
((equal "B" encoding)
- (base64-decode string))
+ (if (fboundp 'base64-decode-string)
+ (base64-decode-string string)
+ (base64-decode string)))
((equal "Q" encoding)
(quoted-printable-decode-string
(mm-replace-chars-in-string string ?_ ? )))
+1998-09-04 00:40:07 David S. Goldberg <dsg@mitre.org>
+
+ * gnus.texi (Article Hiding): Verify.
+
1998-08-31 11:46:57 Lars Magne Ingebrigtsen <larsi@gnus.org>
* gnus.texi (Mail Folders): Addition.
\input texinfo @c -*-texinfo-*-
@setfilename gnus
-@settitle Pterodactyl Gnus 0.14 Manual
+@settitle Pterodactyl Gnus 0.15 Manual
@synindex fn cp
@synindex vr cp
@synindex pg cp
@tex
@titlepage
-@title Pterodactyl Gnus 0.14 Manual
+@title Pterodactyl Gnus 0.15 Manual
@author by Lars Magne Ingebrigtsen
@page
spool or your mbox file. All at the same time, if you want to push your
luck.
-This manual corresponds to Pterodactyl Gnus 0.14.
+This manual corresponds to Pterodactyl Gnus 0.15.
@end ifinfo
@vindex gnus-article-hide-pgp-hook
Hide @sc{pgp} signatures (@code{gnus-article-hide-pgp}). The
@code{gnus-article-hide-pgp-hook} hook will be run after a @sc{pgp}
-signature has been hidden.
+signature has been hidden. For example, to automatically verify
+articles that have signatures in them do:
+@lisp
+;;; Hide pgp cruft if any.
+
+(add-hook 'gnus-article-display-hook 'gnus-article-hide-pgp)
+
+;;; After hiding pgp, verify the message;
+;;; only happens if pgp signature is found.
+
+(add-hook 'gnus-article-hide-pgp-hook
+ (lambda ()
+ (save-excursion
+ (set-buffer gnus-original-article-buffer)
+ (mc-verify))))
+@end lisp
@item W W P
@kindex W W P (Summary)
\input texinfo @c -*-texinfo-*-
@setfilename message
-@settitle Pterodactyl Message 0.14 Manual
+@settitle Pterodactyl Message 0.15 Manual
@synindex fn cp
@synindex vr cp
@synindex pg cp
@tex
@titlepage
-@title Pterodactyl Message 0.14 Manual
+@title Pterodactyl Message 0.15 Manual
@author by Lars Magne Ingebrigtsen
@page
* Key Index:: List of Message mode keys.
@end menu
-This manual corresponds to Pterodactyl Message 0.14. Message is
+This manual corresponds to Pterodactyl Message 0.15. Message is
distributed with the Gnus distribution bearing the same version number
as this manual has.
projects / gnus / commitdiff