From 7bb65c2e8117c313fb292bff969887315068cbc6 Mon Sep 17 00:00:00 2001 From: ichikawa Date: Sun, 6 Sep 1998 01:42:01 +0000 Subject: [PATCH] Importing pgnus-0.16 --- lisp/ChangeLog | 64 ++++++++++++++++++ lisp/base64.el | 2 + lisp/date.el | 124 ++++++++++++++++++++++++++++++++++ lisp/drums.el | 186 +++++++++++++++++++++++++++++++++++++++++++++++++++ lisp/gnus-agent.el | 6 +- lisp/gnus-art.el | 79 ++++++++-------------- lisp/gnus-demon.el | 3 +- lisp/gnus-group.el | 58 +++++++++------- lisp/gnus-kill.el | 4 +- lisp/gnus-logic.el | 4 +- lisp/gnus-msg.el | 2 +- lisp/gnus-nocem.el | 10 +-- lisp/gnus-score.el | 14 ++-- lisp/gnus-sum.el | 17 ++--- lisp/gnus-util.el | 94 +------------------------- lisp/gnus.el | 10 +-- lisp/lpath.el | 6 +- lisp/message.el | 3 +- lisp/messagexmas.el | 4 +- lisp/mm-bodies.el | 16 +++-- lisp/mm-util.el | 4 ++ lisp/nndb.el | 3 +- lisp/nnmail.el | 50 ++------------ lisp/nnml.el | 5 +- lisp/nntp.el | 2 +- lisp/rfc2047.el | 56 +++++++++------- make.bat | 114 +++++++++++++++---------------- texi/ChangeLog | 8 +++ texi/gnus.texi | 47 +++++++++---- texi/message.texi | 6 +- 30 files changed, 637 insertions(+), 364 deletions(-) create mode 100644 lisp/date.el create mode 100644 lisp/drums.el diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 66181a3..79e9169 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,67 @@ +Sat Sep 5 21:55:01 1998 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.16 is released. + +1998-09-05 17:30:11 Lars Magne Ingebrigtsen + + * nnmail.el (nnmail-expired-article-p): Use predicate. + + * date.el (time-less-p): Renamed. + + * gnus-art.el (gnus-article-decode-charset): Really fetch headers + from the headers. + + * rfc2047.el (rfc2047-decode-region): Use the mm decoding + functions. + + * gnus-group.el (gnus-group-sort-selected-flat): Didn't work at + all. + (gnus-group-sort-selected-groups-by-alphabet): Changed interface + to all functions. + +Sat Sep 5 01:45:52 1998 Lars Magne Ingebrigtsen + + * gnus.el: Pterodactyl Gnus v0.15 is released. + +1998-09-05 00:21:22 Lars Magne Ingebrigtsen + + * 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 + + * 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 + + * 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 * gnus.el: Pterodactyl Gnus v0.14 is released. diff --git a/lisp/base64.el b/lisp/base64.el index 92ef2af..4b55dd5 100644 --- a/lisp/base64.el +++ b/lisp/base64.el @@ -25,6 +25,8 @@ ;;; Boston, MA 02111-1307, USA. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(require 'mm-util) + ;; For non-MULE (if (not (fboundp 'char-int)) (fset 'char-int 'identity)) diff --git a/lisp/date.el b/lisp/date.el new file mode 100644 index 0000000..b593e1c --- /dev/null +++ b/lisp/date.el @@ -0,0 +1,124 @@ +;;; date.el --- Date and time handling functions +;; Copyright (C) 1998 Free Software Foundation, Inc. + +;; Author: Lars Magne Ingebrigtsen +;; Masanobu Umeda +;; 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-p (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 diff --git a/lisp/drums.el b/lisp/drums.el new file mode 100644 index 0000000..db982b7 --- /dev/null +++ b/lisp/drums.el @@ -0,0 +1,186 @@ +;;; drums.el --- Functions for parsing RFC822bis headers +;; Copyright (C) 1998 Free Software Foundation, Inc. + +;; Author: Lars Magne Ingebrigtsen +;; 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 diff --git a/lisp/gnus-agent.el b/lisp/gnus-agent.el index 65bc02b..dbbff13 100644 --- a/lisp/gnus-agent.el +++ b/lisp/gnus-agent.el @@ -654,7 +654,7 @@ the actual number of articles toggled is returned." (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) @@ -775,7 +775,7 @@ the actual number of articles toggled is returned." (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) @@ -1258,7 +1258,7 @@ The following commands are available: "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) diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el index 48ab6bf..935d001 100644 --- a/lisp/gnus-art.el +++ b/lisp/gnus-art.el @@ -273,7 +273,6 @@ be fed to `format-time-string'." :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 @@ -769,7 +768,7 @@ always hide." ((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) @@ -961,21 +960,22 @@ If PROMPT (the prefix), prompt for a coding system to use." (interactive "P") (save-excursion (set-buffer gnus-article-buffer) - (let* ((inhibit-point-motion-hooks t) - (ct (message-fetch-field "Content-Type" t)) - (cte (message-fetch-field "Content-Transfer-Encoding" t)) - (charset (cond - (prompt - (mm-read-coding-system "Charset to decode: ")) - (ct - (mm-content-type-charset ct)) - (gnus-newsgroup-name - (gnus-group-find-parameter - gnus-newsgroup-name 'charset)))) - buffer-read-only) - (save-restriction - (goto-char (point-min)) - (search-forward "\n\n" nil 'move) + (save-restriction + (message-narrow-to-head) + (let* ((inhibit-point-motion-hooks t) + (ct (message-fetch-field "Content-Type" t)) + (cte (message-fetch-field "Content-Transfer-Encoding" t)) + (charset (cond + (prompt + (mm-read-coding-system "Charset to decode: ")) + (ct + (mm-content-type-charset ct)) + (gnus-newsgroup-name + (gnus-group-find-parameter + gnus-newsgroup-name 'charset)))) + buffer-read-only) + (goto-char (point-max)) + (widen) (narrow-to-region (point) (point-max)) (mm-decode-body charset (and cte (intern (downcase (gnus-strip-whitespace cte))))))))) @@ -1343,58 +1343,35 @@ how much time has lapsed since DATE." ;; 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)))) @@ -1664,7 +1641,7 @@ Directory to save to is default to `gnus-article-save-directory'." (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) @@ -1681,7 +1658,7 @@ Directory to save to is default to `gnus-article-save-directory'." (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) diff --git a/lisp/gnus-demon.el b/lisp/gnus-demon.el index 0015a90..4311941 100644 --- a/lisp/gnus-demon.el +++ b/lisp/gnus-demon.el @@ -268,8 +268,7 @@ minutes, the connection is closed." (defun gnus-demon-nntp-close-connection () (save-window-excursion - (when (nnmail-time-less '(0 300) - (nnmail-time-since nntp-last-command-time)) + (when (time-less-p '(0 300) (time-since nntp-last-command-time)) (nntp-close-server)))) (defun gnus-demon-add-scanmail () diff --git a/lisp/gnus-group.el b/lisp/gnus-group.el index 6eddfca..736ad53 100644 --- a/lisp/gnus-group.el +++ b/lisp/gnus-group.el @@ -2300,46 +2300,52 @@ If REVERSE, sort in reverse order." ;; Go through all the infos and replace the old entries ;; with the new infos. (while infos - (setcar entries (pop infos)) + (setcar (car entries) (pop infos)) (pop entries)) ;; Update the hashtable. (gnus-make-hashtable-from-newsrc-alist))) -(defun gnus-group-sort-selected-groups-by-alphabet (&optional reverse) +(defun gnus-group-sort-selected-groups-by-alphabet (&optional n reverse) "Sort the group buffer alphabetically by group name. -If REVERSE, sort in reverse order." - (interactive "P") - (gnus-group-sort-selected-groups 'gnus-group-sort-by-alphabet reverse)) +Obeys the process/prefix convention. If REVERSE (the symbolic prefix), +sort in reverse order." + (interactive (gnus-interactive "P\ny")) + (gnus-group-sort-selected-groups n 'gnus-group-sort-by-alphabet reverse)) -(defun gnus-group-sort-selected-groups-by-unread (&optional reverse) +(defun gnus-group-sort-selected-groups-by-unread (&optional n reverse) "Sort the group buffer by number of unread articles. -If REVERSE, sort in reverse order." - (interactive "P") - (gnus-group-sort-selected-groups 'gnus-group-sort-by-unread reverse)) +Obeys the process/prefix convention. If REVERSE (the symbolic prefix), +sort in reverse order." + (interactive (gnus-interactive "P\ny")) + (gnus-group-sort-selected-groups n 'gnus-group-sort-by-unread reverse)) -(defun gnus-group-sort-selected-groups-by-level (&optional reverse) +(defun gnus-group-sort-selected-groups-by-level (&optional n reverse) "Sort the group buffer by group level. -If REVERSE, sort in reverse order." - (interactive "P") - (gnus-group-sort-selected-groups 'gnus-group-sort-by-level reverse)) +Obeys the process/prefix convention. If REVERSE (the symbolic prefix), +sort in reverse order." + (interactive (gnus-interactive "P\ny")) + (gnus-group-sort-selected-groups n 'gnus-group-sort-by-level reverse)) -(defun gnus-group-sort-selected-groups-by-score (&optional reverse) +(defun gnus-group-sort-selected-groups-by-score (&optional n reverse) "Sort the group buffer by group score. -If REVERSE, sort in reverse order." - (interactive "P") - (gnus-group-sort-selected-groups 'gnus-group-sort-by-score reverse)) +Obeys the process/prefix convention. If REVERSE (the symbolic prefix), +sort in reverse order." + (interactive (gnus-interactive "P\ny")) + (gnus-group-sort-selected-groups n 'gnus-group-sort-by-score reverse)) -(defun gnus-group-sort-selected-groups-by-rank (&optional reverse) +(defun gnus-group-sort-selected-groups-by-rank (&optional n reverse) "Sort the group buffer by group rank. -If REVERSE, sort in reverse order." - (interactive "P") - (gnus-group-sort-selected-groups 'gnus-group-sort-by-rank reverse)) +Obeys the process/prefix convention. If REVERSE (the symbolic prefix), +sort in reverse order." + (interactive (gnus-interactive "P\ny")) + (gnus-group-sort-selected-groups n 'gnus-group-sort-by-rank reverse)) -(defun gnus-group-sort-selected-groups-by-method (&optional reverse) +(defun gnus-group-sort-selected-groups-by-method (&optional n reverse) "Sort the group buffer alphabetically by backend name. -If REVERSE, sort in reverse order." - (interactive "P") - (gnus-group-sort-selected-groups 'gnus-group-sort-by-method reverse)) +Obeys the process/prefix convention. If REVERSE (the symbolic prefix), +sort in reverse order." + (interactive (gnus-interactive "P\ny")) + (gnus-group-sort-selected-groups n 'gnus-group-sort-by-method reverse)) ;;; Sorting predicates. @@ -3373,7 +3379,7 @@ or `gnus-group-catchup-group-hook'." "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)))) diff --git a/lisp/gnus-kill.el b/lisp/gnus-kill.el index abcc401..02ee66e 100644 --- a/lisp/gnus-kill.el +++ b/lisp/gnus-kill.el @@ -524,7 +524,7 @@ COMMAND must be a lisp expression or a string representing a key sequence." ;; 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)) @@ -535,7 +535,7 @@ COMMAND must be a lisp expression or a string representing a key sequence." (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. diff --git a/lisp/gnus-logic.el b/lisp/gnus-logic.el index f2913f1..58dfb09 100644 --- a/lisp/gnus-logic.el +++ b/lisp/gnus-logic.el @@ -171,9 +171,9 @@ ((eq type 'at) (equal date match)) ((eq type 'before) - (gnus-time-less match date)) + (time-less-p match date)) ((eq type 'after) - (gnus-time-less date match)) + (time-less-p date match)) (t (error "No such date score type: %s" type))))) diff --git a/lisp/gnus-msg.el b/lisp/gnus-msg.el index 8c21772..9976616 100644 --- a/lisp/gnus-msg.el +++ b/lisp/gnus-msg.el @@ -495,7 +495,7 @@ If SILENT, don't prompt the user." (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) diff --git a/lisp/gnus-nocem.el b/lisp/gnus-nocem.el index 66974ee..7535a25 100644 --- a/lisp/gnus-nocem.el +++ b/lisp/gnus-nocem.el @@ -190,9 +190,9 @@ matches an previously scanned and verified nocem message." (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-p + (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) @@ -316,11 +316,11 @@ matches an previously scanned and verified nocem message." (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 (time-less-p (time-since (car entry)) expiry)) ;; This entry has expired, so we remove it. (setcdr prev (cdr alist)) (setq prev alist) diff --git a/lisp/gnus-score.el b/lisp/gnus-score.el index f2c3b3a..2d1c93f 100644 --- a/lisp/gnus-score.el +++ b/lisp/gnus-score.el @@ -794,9 +794,9 @@ If optional argument `SILENT' is nil, show effect of score entry." (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. @@ -1121,7 +1121,7 @@ SCORE is the score to add." (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)) @@ -1290,7 +1290,7 @@ SCORE is the score to add." (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))) @@ -1385,7 +1385,7 @@ SCORE is the score to add." (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) @@ -2211,7 +2211,7 @@ SCORE is the score to add." (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) @@ -2837,7 +2837,7 @@ If ADAPT, return the home adaptive file instead." (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)) diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el index a28a99b..7c5b55e 100644 --- a/lisp/gnus-sum.el +++ b/lisp/gnus-sum.el @@ -3483,7 +3483,7 @@ If LINE, insert the rebuilt thread starting on line LINE." (defsubst gnus-article-sort-by-date (h1 h2) "Sort articles by root article date." - (gnus-time-less + (time-less-p (gnus-date-get-time (mail-header-date h1)) (gnus-date-get-time (mail-header-date h2)))) @@ -4529,9 +4529,10 @@ list of headers that match SEQUENCE (see `nntp-retrieve-headers')." 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 -- @@ -5928,13 +5929,13 @@ articles that are younger than AGE days." (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 (time-less-p + (time-since (date-to-time date)) cutoff)) (when (if younger-p is-younger @@ -8487,7 +8488,7 @@ If N is a negative number, save the N previous articles. 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) diff --git a/lisp/gnus-util.el b/lisp/gnus-util.el index 6624762..ff0dc6e 100644 --- a/lisp/gnus-util.el +++ b/lisp/gnus-util.el @@ -33,11 +33,10 @@ (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")) @@ -218,43 +217,6 @@ ;;; 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)) @@ -353,7 +315,7 @@ Cache the result as a text property stored in 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))))) @@ -702,58 +664,6 @@ with potentially long computations." ;;; 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)) diff --git a/lisp/gnus.el b/lisp/gnus.el index f609c82..96bc400 100644 --- a/lisp/gnus.el +++ b/lisp/gnus.el @@ -250,7 +250,7 @@ is restarted, and sometimes reloaded." :link '(custom-manual "(gnus)Exiting Gnus") :group 'gnus) -(defconst gnus-version-number "0.14" +(defconst gnus-version-number "0.16" "Version number for this version of Gnus.") (defconst gnus-version (format "Pterodactyl Gnus v%s" gnus-version-number) @@ -1581,13 +1581,13 @@ gnus-newsrc-hashtb should be kept so that both hold the same information.") ("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 @@ -2009,8 +2009,8 @@ If ARG, insert string at point." "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)))))) diff --git a/lisp/lpath.el b/lisp/lpath.el index 4172f10..cfee844 100644 --- a/lisp/lpath.el +++ b/lisp/lpath.el @@ -25,7 +25,7 @@ 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 @@ -34,7 +34,7 @@ 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 @@ -62,7 +62,7 @@ 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) diff --git a/lisp/message.el b/lisp/message.el index 260246d..b572ceb 100644 --- a/lisp/message.el +++ b/lisp/message.el @@ -4050,7 +4050,8 @@ regexp varstr." (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) diff --git a/lisp/messagexmas.el b/lisp/messagexmas.el index 7e3edd3..52619dd 100644 --- a/lisp/messagexmas.el +++ b/lisp/messagexmas.el @@ -100,8 +100,8 @@ If it is non-nil, it must be a toolbar. The five legal values are "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 diff --git a/lisp/mm-bodies.el b/lisp/mm-bodies.el index 511d437..9de7f36 100644 --- a/lisp/mm-bodies.el +++ b/lisp/mm-bodies.el @@ -53,8 +53,10 @@ If no encoding was done, nil is returned." (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 @@ -80,7 +82,7 @@ If no encoding was done, nil is returned." (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)))) @@ -94,6 +96,7 @@ If no encoding was done, nil is returned." (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 @@ -105,6 +108,8 @@ The characters in CHARSET should then be decoded." (error nil))) ((memq encoding '(7bit 8bit binary)) ) + ((null encoding) + ) (t (error "Can't decode encoding %s" encoding)))) (when (featurep 'mule) @@ -112,8 +117,9 @@ The characters in CHARSET should then be decoded." (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) diff --git a/lisp/mm-util.el b/lisp/mm-util.el index 9ae62a7..c3fab98 100644 --- a/lisp/mm-util.el +++ b/lisp/mm-util.el @@ -83,6 +83,10 @@ (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)) diff --git a/lisp/nndb.el b/lisp/nndb.el index 0a0f3ef..9a3efba 100644 --- a/lisp/nndb.el +++ b/lisp/nndb.el @@ -181,8 +181,7 @@ article was posted to nndb") 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))) diff --git a/lisp/nnmail.el b/lisp/nnmail.el index c4165d3..383b472 100644 --- a/lisp/nnmail.el +++ b/lisp/nnmail.el @@ -482,7 +482,7 @@ parameter. It should return nil, `warn' or `delete'." (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) @@ -493,7 +493,7 @@ parameter. It should return nil, `warn' or `delete'." (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)))) @@ -519,48 +519,6 @@ parameter. It should return nil, `warn' or `delete'." "/"))) (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'." @@ -1671,9 +1629,9 @@ See the documentation for the variable `nnmail-split-fancy' for documentation." ;; 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))))))) + (time-less-p days (time-since time))))))) (defvar nnmail-read-passwd nil) (defun nnmail-read-passwd (prompt &rest args) diff --git a/lisp/nnml.el b/lisp/nnml.el index f4da479..42581c0 100644 --- a/lisp/nnml.el +++ b/lisp/nnml.el @@ -249,9 +249,8 @@ all. This may very well take some time.") (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)) diff --git a/lisp/nntp.el b/lisp/nntp.el index 863b655..4828187 100644 --- a/lisp/nntp.el +++ b/lisp/nntp.el @@ -728,7 +728,7 @@ If this variable is nil, which is the default, no timers are set.") (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) diff --git a/lisp/rfc2047.el b/lisp/rfc2047.el index 69e4f27..f15fa98 100644 --- a/lisp/rfc2047.el +++ b/lisp/rfc2047.el @@ -30,8 +30,8 @@ (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) @@ -130,8 +130,10 @@ Should be called narrowed to the head of the message." (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) @@ -225,24 +227,30 @@ Should be called narrowed to the head of the message." (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))))) + (mm-decode-coding-region b e rfc2047-default-charset) + (setq b (point))) + (mm-decode-coding-region b (point-max) rfc2047-default-charset))))) ;;;###autoload (defun rfc2047-decode-string (string) @@ -277,7 +285,9 @@ If your Emacs implementation can't decode CHARSET, it returns nil." (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 ?_ ? ))) diff --git a/make.bat b/make.bat index 4a6b8a0..d183af9 100755 --- a/make.bat +++ b/make.bat @@ -1,57 +1,57 @@ -@echo off - -rem Written by David Charlap - -rem There are two catches, however. The emacs.bat batch file may not exist -rem in all distributions. It is part of the Voelker build of Emacs 19.34 -rem (http://www.cs.washington.edu/homes/voelker/ntemacs.html). If the user -rem installs Gnus with some other build, he may have to replace calls to -rem %1\emacs.bat with something else. -rem -rem Also, the emacs.bat file that Voelker ships does not accept more than 9 -rem parameters, so the attempts to compile the .texi files will fail. To -rem fix that (at least on NT. I don't know about Win95), the following -rem change should be made to emacs.bat: -rem -rem %emacs_dir%\bin\emacs.exe %1 %2 %3 %4 %5 %6 %7 %8 %9 -rem -rem should become -rem -rem %emacs_dir%\bin\emacs.exe %* -rem -rem which will allow the batch file to accept an unlimited number of -rem parameters. - -if "%1" == "" goto usage - -cd lisp -call %1\bin\emacs.bat -batch -q -no-site-file -l ./dgnushack.el -f dgnushack-compile -if not "%2" == "copy" goto info -copy *.el* %1\lisp - -:info -cd ..\texi -call %1\bin\emacs.bat -batch -q -no-site-file gnus.texi -l texinfmt -f texinfo-every-node-update -f texinfo-format-buffer -f save-buffer -call %1\bin\emacs.bat -batch -q -no-site-file message.texi -l texinfmt -f texinfo-every-node-update -f texinfo-format-buffer -f save-buffer -if not "%2" == "copy" goto done -copy gnus %1\info -copy gnus-?? %1\info -copy message %1\info - -:etc -cd ..\etc -copy gnus-tut.txt %1\etc - -:done -cd .. -goto end - -:usage -echo Usage: make ^ [copy] -echo. -echo where: ^ is the directory you installed emacs in -echo eg. d:\emacs\19.34 -echo copy indicates that the compiled files should be copied to your -echo emacs lisp, info, and etc directories - -:end +@echo off + +rem Written by David Charlap + +rem There are two catches, however. The emacs.bat batch file may not exist +rem in all distributions. It is part of the Voelker build of Emacs 19.34 +rem (http://www.cs.washington.edu/homes/voelker/ntemacs.html). If the user +rem installs Gnus with some other build, he may have to replace calls to +rem %1\emacs.bat with something else. +rem +rem Also, the emacs.bat file that Voelker ships does not accept more than 9 +rem parameters, so the attempts to compile the .texi files will fail. To +rem fix that (at least on NT. I don't know about Win95), the following +rem change should be made to emacs.bat: +rem +rem %emacs_dir%\bin\emacs.exe %1 %2 %3 %4 %5 %6 %7 %8 %9 +rem +rem should become +rem +rem %emacs_dir%\bin\emacs.exe %* +rem +rem which will allow the batch file to accept an unlimited number of +rem parameters. + +if "%1" == "" goto usage + +cd lisp +call %1\bin\emacs.bat -batch -q -no-site-file -l ./dgnushack.el -f dgnushack-compile +if not "%2" == "copy" goto info +copy *.el* %1\lisp + +:info +cd ..\texi +call %1\bin\emacs.bat -batch -q -no-site-file gnus.texi -l texinfmt -f texinfo-every-node-update -f texinfo-format-buffer -f save-buffer +call %1\bin\emacs.bat -batch -q -no-site-file message.texi -l texinfmt -f texinfo-every-node-update -f texinfo-format-buffer -f save-buffer +if not "%2" == "copy" goto done +copy gnus %1\info +copy gnus-?? %1\info +copy message %1\info + +:etc +cd ..\etc +copy gnus-tut.txt %1\etc + +:done +cd .. +goto end + +:usage +echo Usage: make ^ [copy] +echo. +echo where: ^ is the directory you installed emacs in +echo eg. d:\emacs\19.34 +echo copy indicates that the compiled files should be copied to your +echo emacs lisp, info, and etc directories + +:end diff --git a/texi/ChangeLog b/texi/ChangeLog index 14c5a15..7a45cce 100644 --- a/texi/ChangeLog +++ b/texi/ChangeLog @@ -1,3 +1,11 @@ +1998-09-05 17:36:14 Lars Magne Ingebrigtsen + + * gnus.texi (Sorting Groups): Change. + +1998-09-04 00:40:07 David S. Goldberg + + * gnus.texi (Article Hiding): Verify. + 1998-08-31 11:46:57 Lars Magne Ingebrigtsen * gnus.texi (Mail Folders): Addition. diff --git a/texi/gnus.texi b/texi/gnus.texi index cb36fdd..4d76d76 100644 --- a/texi/gnus.texi +++ b/texi/gnus.texi @@ -1,7 +1,7 @@ \input texinfo @c -*-texinfo-*- @setfilename gnus -@settitle Pterodactyl Gnus 0.14 Manual +@settitle Pterodactyl Gnus 0.16 Manual @synindex fn cp @synindex vr cp @synindex pg cp @@ -318,7 +318,7 @@ into another language, under the above conditions for modified versions. @tex @titlepage -@title Pterodactyl Gnus 0.14 Manual +@title Pterodactyl Gnus 0.16 Manual @author by Lars Magne Ingebrigtsen @page @@ -354,7 +354,7 @@ can be gotten by any nefarious means you can think of---@sc{nntp}, local 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.16. @end ifinfo @@ -2340,7 +2340,11 @@ Sort the group buffer alphabetically by backend name @end table -When given a prefix, all these commands will sort in reverse order. +All the commands below obeys the process/prefix convention +(@pxref{Process/Prefix}). + +When given a symbolic prefix (@pxref{Symbolic Prefixes}), all these +commands will sort in reverse order. You can also sort a subset of the groups: @@ -2348,38 +2352,38 @@ You can also sort a subset of the groups: @item G P a @kindex G P a (Group) @findex gnus-group-sort-selected-groups-by-alphabet -Sort the process/prefixed groups in the group buffer alphabetically by -group name (@code{gnus-group-sort-selected-groups-by-alphabet}). +Sort the groups alphabetically by group name +(@code{gnus-group-sort-selected-groups-by-alphabet}). @item G P u @kindex G P u (Group) @findex gnus-group-sort-selected-groups-by-unread -Sort the process/prefixed groups in the group buffer by the number of -unread articles (@code{gnus-group-sort-selected-groups-by-unread}). +Sort the groups by the number of unread articles +(@code{gnus-group-sort-selected-groups-by-unread}). @item G P l @kindex G P l (Group) @findex gnus-group-sort-selected-groups-by-level -Sort the process/prefixed groups in the group buffer by group level +Sort the groups by group level (@code{gnus-group-sort-selected-groups-by-level}). @item G P v @kindex G P v (Group) @findex gnus-group-sort-selected-groups-by-score -Sort the process/prefixed groups in the group buffer by group score +Sort the groups by group score (@code{gnus-group-sort-selected-groups-by-score}). @xref{Group Score}. @item G P r @kindex G P r (Group) @findex gnus-group-sort-selected-groups-by-rank -Sort the process/prefixed groups in the group buffer by group rank +Sort the groups by group rank (@code{gnus-group-sort-selected-groups-by-rank}). @xref{Group Score}. @item G P m @kindex G P m (Group) @findex gnus-group-sort-selected-groups-by-method -Sort the process/prefixed groups in the group buffer alphabetically by -backend name (@code{gnus-group-sort-selected-groups-by-method}). +Sort the groups alphabetically by backend name +(@code{gnus-group-sort-selected-groups-by-method}). @end table @@ -6295,7 +6299,22 @@ Signature}. @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) diff --git a/texi/message.texi b/texi/message.texi index b011b53..ce36433 100644 --- a/texi/message.texi +++ b/texi/message.texi @@ -1,7 +1,7 @@ \input texinfo @c -*-texinfo-*- @setfilename message -@settitle Pterodactyl Message 0.14 Manual +@settitle Pterodactyl Message 0.16 Manual @synindex fn cp @synindex vr cp @synindex pg cp @@ -42,7 +42,7 @@ into another language, under the above conditions for modified versions. @tex @titlepage -@title Pterodactyl Message 0.14 Manual +@title Pterodactyl Message 0.16 Manual @author by Lars Magne Ingebrigtsen @page @@ -83,7 +83,7 @@ Message mode buffers. * 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.16. Message is distributed with the Gnus distribution bearing the same version number as this manual has. -- 1.7.10.4