From ac6387acdeb004698271e917c8aa82a7a701d764 Mon Sep 17 00:00:00 2001 From: yamaoka Date: Wed, 31 Oct 2001 23:36:03 +0000 Subject: [PATCH] Synch with Oort Gnus. --- lisp/ChangeLog | 36 +++++++++++++++++++ lisp/gnus-cus.el | 5 +++ lisp/gnus-start.el | 57 ++++++++++++++++++------------ lisp/gnus-sum.el | 18 ++++++++++ lisp/gnus.el | 15 ++++++++ lisp/lpath.el | 7 ++-- lisp/mail-source.el | 50 ++++++++++++++------------ lisp/message.el | 97 +++++++++++++++++++++++++++++++++++++++++---------- texi/ChangeLog | 5 +++ texi/gnus-ja.texi | 4 +++ texi/gnus.texi | 6 +++- 11 files changed, 233 insertions(+), 67 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index af8083e..6a51fbd 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,39 @@ +2001-10-31 Simon Josefsson + + * gnus-cus.el (gnus-group-parameters): Support integer `display' + parameter. + + * gnus-sum.el (gnus-select-newsgroup): If group parameter + `display' is a number (and C-u wasn't used to enter group), only + fetch that number of articles. + +2001-10-31 Matt Armstrong + + * gnus.el (gnus-find-subscribed-addresses): Doc fix: + not-subscribed -> subscribed. + +2001-10-31 08:00:00 ShengHuo ZHU + From: Josh Huber + + * message.el (message-subscribed-address-functions): New. + (message-subscribed-addresses): New. + (message-subscribed-regexps): New. + (message-goto-mail-followup-to): New. + (message-send-mail): Mail-Followup-To. + (message-make-mft): New. + + * gnus.el (gnus-find-subscribed-addresses): New. + +2001-10-31 07:00:00 ShengHuo ZHU + + * mail-source.el (mail-source-fetch): If debug, don't regain signals. + (mail-source-fetch-pop): Ditto. + (mail-source-check-pop): Ditto. + + * gnus-start.el (gnus-read-init-file): Ditto. + (gnus-activate-group): Ditto. + (gnus-read-newsrc-el-file): Ditto. + 2001-10-30 23:00:00 ShengHuo ZHU * message.el (message-get-reply-headers): Make sure there is ", ". diff --git a/lisp/gnus-cus.el b/lisp/gnus-cus.el index e0e6088..b95f440 100644 --- a/lisp/gnus-cus.el +++ b/lisp/gnus-cus.el @@ -178,6 +178,7 @@ you to put the admin address somewhere convenient.") (display (choice :tag "Display" :value default (const all) + (integer) (const default) (sexp :tag "Other")) "\ Which articles to display on entering the group. @@ -185,6 +186,10 @@ Which articles to display on entering the group. `all' Display all articles, both read and unread. +`integer' + Display the last NUMBER articles in the group. This is the same as + entering the group with C-u NUMBER. + `default' Display the default visible articles, which normally includes unread and ticked articles. diff --git a/lisp/gnus-start.el b/lisp/gnus-start.el index d8b32e7..4f489e4 100644 --- a/lisp/gnus-start.el +++ b/lisp/gnus-start.el @@ -461,10 +461,12 @@ Can be used to turn version control on or off." (not (file-directory-p file))) (file-exists-p (concat file ".el")) (file-exists-p (concat file ".elc"))) - (condition-case var + (if (or debug-on-error debug-on-quit) (load file nil t) - (error - (error "Error in %s: %s" file var))))))))) + (condition-case var + (load file nil t) + (error + (error "Error in %s: %s" file var)))))))))) ;; For subscribing new newsgroup @@ -1472,12 +1474,14 @@ newsgroup." (gnus-check-backend-function 'request-scan (car method)) (gnus-request-scan group method)) t) - (condition-case () + (if (or debug-on-error debug-on-quit) (inline (gnus-request-group group dont-check method)) - ;;(error nil) - (quit - (message "Quit activating %s" group) - nil)) + (condition-case () + (inline (gnus-request-group group dont-check method)) + ;;(error nil) + (quit + (message "Quit activating %s" group) + nil))) (unless dont-check (setq active (gnus-parse-active)) ;; If there are no articles in the group, the GROUP @@ -1827,13 +1831,15 @@ newsgroup." ;; Only do each method once, in case the methods appear more ;; than once in this list. (unless (member method methods) - (condition-case () + (if (or debug-on-error debug-on-quit) (gnus-read-active-file-1 method force) - ;; We catch C-g so that we can continue past servers - ;; that do not respond. - (quit - (message "Quit reading the active file") - nil))))))) + (condition-case () + (gnus-read-active-file-1 method force) + ;; We catch C-g so that we can continue past servers + ;; that do not respond. + (quit + (message "Quit reading the active file") + nil)))))))) (defun gnus-read-active-file-1 (method force) (let (where mesg) @@ -2080,19 +2086,24 @@ If FORCE is non-nil, the .newsrc file is read." (let (gnus-newsrc-assoc) (when (file-exists-p ding-file) (with-temp-buffer - (condition-case nil + (if (or debug-on-error debug-on-quit) (progn (insert-file-contents-as-coding-system gnus-ding-file-coding-system ding-file) (eval-region (point-min) (point-max))) - (error - (ding) - (or (not (or (zerop (buffer-size)) - (eq 'binary gnus-ding-file-coding-system) - (gnus-re-read-newsrc-el-file ding-file))) - (gnus-yes-or-no-p - (format "Error in %s; continue? " ding-file)) - (error "Error in %s" ding-file))))) + (condition-case nil + (progn + (insert-file-contents-as-coding-system + gnus-ding-file-coding-system ding-file) + (eval-region (point-min) (point-max))) + (error + (ding) + (or (not (or (zerop (buffer-size)) + (eq 'binary gnus-ding-file-coding-system) + (gnus-re-read-newsrc-el-file ding-file))) + (gnus-yes-or-no-p + (format "Error in %s; continue? " ding-file)) + (error "Error in %s" ding-file)))))) (when gnus-newsrc-assoc (setq gnus-newsrc-alist gnus-newsrc-assoc)))) (gnus-make-hashtable-from-newsrc-alist) diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el index b2ebd68..d515562 100644 --- a/lisp/gnus-sum.el +++ b/lisp/gnus-sum.el @@ -4577,6 +4577,24 @@ If SELECT-ARTICLES, only select those articles from GROUP." 'gnus-not-ignore) ((arrayp display) (gnus-summary-display-make-predicate (mapcar 'identity display))) + ((numberp display) + ;; The following is probably the "correct" solution, but + ;; it makes Gnus fetch all headers and then limit the + ;; articles (which is slow), so instead we hack the + ;; select-articles parameter instead. -- Simon Josefsson + ;; + ;; + ;; (gnus-byte-compile + ;; `(lambda () (> number ,(- (cdr (gnus-active group)) + ;; display))))) + (setq select-articles + (gnus-uncompress-range + (cons (let ((tmp (- (cdr (gnus-active group)) display))) + (if (> tmp 0) + tmp + 1)) + (cdr (gnus-active group))))) + nil) (t nil)))) diff --git a/lisp/gnus.el b/lisp/gnus.el index 6079f50..c8e3e24 100644 --- a/lisp/gnus.el +++ b/lisp/gnus.el @@ -2417,6 +2417,21 @@ This restriction may disappear in later versions of Gnus." ;;; Gnus Utility Functions ;;; +(defun gnus-find-subscribed-addresses () + "Return a regexp matching the addresses of all subscribed mail groups. +It consists of the `to-address' or `to-list' parameter of all groups +with a `subscribed' parameter." + (let ((addresses)) + (mapc (lambda (entry) + (let ((group (car entry))) + (when (gnus-group-find-parameter group 'subscribed) + (let ((address (or + (gnus-group-fast-parameter group 'to-address) + (gnus-group-fast-parameter group 'to-list)))) + (when address + (setq addresses (cons address addresses))))))) + (cdr gnus-newsrc-alist)) + (list (mapconcat 'regexp-quote addresses "\\|")))) (defmacro gnus-string-or (&rest strings) "Return the first element of STRINGS that is a non-blank string. diff --git a/lisp/lpath.el b/lisp/lpath.el index 0c7fb4a..1d5ecb5 100644 --- a/lisp/lpath.el +++ b/lisp/lpath.el @@ -48,8 +48,8 @@ url-current-callback-func url-be-asynchronous url-current-callback-data url-working-buffer url-current-mime-headers w3-meta-charset-content-type-regexp - rmail-enable-mime-composing - rmail-insert-mime-forwarded-message-function + rmail-enable-mime-composing + rmail-insert-mime-forwarded-message-function w3-meta-content-type-charset-regexp)) (if (featurep 'xemacs) @@ -117,7 +117,8 @@ '((function-max-args smiley-encode-buffer))) ((boundp 'MULE) '((coding-system-get - compose-mail file-name-extension find-coding-systems-region + coding-system-list compose-mail file-name-extension + find-coding-systems-for-charsets find-coding-systems-region function-max-args get-charset-property shell-command-to-string smiley-encode-buffer))) (t diff --git a/lisp/mail-source.el b/lisp/mail-source.el index 30fab7f..43cf3a0 100644 --- a/lisp/mail-source.el +++ b/lisp/mail-source.el @@ -457,13 +457,15 @@ Return the number of files that were found." (setq found (mail-source-callback callback mail-source-crash-box))) (+ found - (condition-case err + (if (or debug-on-quit debug-on-error) (funcall function source callback) - (error - (unless (yes-or-no-p - (format "Mail source error (%s). Continue? " err)) - (error "Cannot get new mail")) - 0)))))))) + (condition-case err + (funcall function source callback) + (error + (unless (yes-or-no-p + (format "Mail source error (%s). Continue? " err)) + (error "Cannot get new mail")) + 0))))))))) (defun mail-source-make-complex-temp-name (prefix) (let ((newname (make-temp-name prefix)) @@ -682,15 +684,17 @@ If ARGS, PROMPT is used as an argument to `format'." (or leave (and (boundp 'pop3-leave-mail-on-server) pop3-leave-mail-on-server)))) - (condition-case err + (if (or debug-on-quit debug-on-error) (save-excursion (pop3-movemail mail-source-crash-box)) - (error - ;; We nix out the password in case the error - ;; was because of a wrong password being given. - (setq mail-source-password-cache - (delq (assoc from mail-source-password-cache) - mail-source-password-cache)) - (signal (car err) (cdr err)))))))) + (condition-case err + (save-excursion (pop3-movemail mail-source-crash-box)) + (error + ;; We nix out the password in case the error + ;; was because of a wrong password being given. + (setq mail-source-password-cache + (delq (assoc from mail-source-password-cache) + mail-source-password-cache)) + (signal (car err) (cdr err))))))))) (if result (progn (when (eq authentication 'password) @@ -741,15 +745,17 @@ If ARGS, PROMPT is used as an argument to `format'." (pop3-port port) (pop3-authentication-scheme (if (eq authentication 'apop) 'apop 'pass))) - (condition-case err + (if (or debug-on-quit debug-on-error) (save-excursion (pop3-get-message-count)) - (error - ;; We nix out the password in case the error - ;; was because of a wrong password being given. - (setq mail-source-password-cache - (delq (assoc from mail-source-password-cache) - mail-source-password-cache)) - (signal (car err) (cdr err)))))))) + (condition-case err + (save-excursion (pop3-get-message-count)) + (error + ;; We nix out the password in case the error + ;; was because of a wrong password being given. + (setq mail-source-password-cache + (delq (assoc from mail-source-password-cache) + mail-source-password-cache)) + (signal (car err) (cdr err))))))))) (if result ;; Inform display-time that we have new mail. (setq mail-source-new-mail-available (> result 0)) diff --git a/lisp/message.el b/lisp/message.el index 5a3f3df..b3d7570 100644 --- a/lisp/message.el +++ b/lisp/message.el @@ -566,6 +566,32 @@ query the user whether to use the value. If it is t or the symbol (const :tag "always" use) (const :tag "ask" ask))) +(defcustom message-subscribed-address-functions nil + "*Specifies functions for determining list subscription. +If nil, do not attempt to determine list subscribtion with functions. +If non-nil, this variable contains a list of functions which return +regular expressions to match lists. These functions can be used in +conjunction with `message-subscribed-regexps' and +`message-subscribed-addresses'." + :group 'message-interface + :type '(repeat sexp)) + +(defcustom message-subscribed-addresses nil + "*Specifies a list of addresses the user is subscribed to. +If nil, do not use any predefined list subscriptions. This list of +addresses can be used in conjuction with +`message-subscribed-address-functions' and `message-subscribed-regexps'." + :group 'message-interface + :type '(repeat string)) + +(defcustom message-subscribed-regexps nil + "*Specifies a list of addresses the user is subscribed to. +If nil, do not use any predefined list subscriptions. This list of +regular expressions can be used in conjuction with +`message-subscribed-address-functions' and `message-subscribed-addresses'." + :group 'message-interface + :type '(repeat regexp)) + (defcustom message-sendmail-f-is-evil nil "*Non-nil means don't add \"-f username\" to the sendmail command line. Doing so would be even more evil than leaving it out." @@ -1699,6 +1725,7 @@ Point is left at the beginning of the narrowed-to region." (define-key message-mode-map "\C-c\C-f\C-n" 'message-goto-newsgroups) (define-key message-mode-map "\C-c\C-f\C-d" 'message-goto-distribution) (define-key message-mode-map "\C-c\C-f\C-f" 'message-goto-followup-to) + (define-key message-mode-map "\C-c\C-f\C-m" 'message-goto-mail-followup-to) (define-key message-mode-map "\C-c\C-f\C-k" 'message-goto-keywords) (define-key message-mode-map "\C-c\C-f\C-u" 'message-goto-summary) (define-key message-mode-map "\C-c\C-b" 'message-goto-body) @@ -1786,6 +1813,7 @@ Point is left at the beginning of the narrowed-to region." ["Keywords" message-goto-keywords t] ["Newsgroups" message-goto-newsgroups t] ["Followup-To" message-goto-followup-to t] + ["Mail-Followup-To" message-goto-mail-followup-to t] ["Distribution" message-goto-distribution t] ["Body" message-goto-body t] ["Signature" message-goto-signature t])) @@ -1808,8 +1836,8 @@ C-c C-f move to a header field (and create it if there isn't): C-c C-f C-w move to Fcc C-c C-f C-r move to Reply-To C-c C-f C-u move to Summary C-c C-f C-n move to Newsgroups C-c C-f C-k move to Keywords C-c C-f C-d move to Distribution - C-c C-f C-m move to Mail-Followup-To C-c C-f C-f move to Followup-To + C-c C-f C-m move to Mail-Followup-To C-c C-f c move to Mail-Copies-To C-c C-t `message-insert-to' (add a To header to a news followup) C-c C-n `message-insert-newsgroups' (add a Newsgroup header to a news reply) @@ -1950,23 +1978,6 @@ M-RET `message-newline-and-reformat' (break the line and reformat)." (interactive) (message-position-on-field "Mail-Reply-To" "Subject")) -(defun message-goto-mail-followup-to () - "Move point to the Mail-Followup-To header. If the header is newly created -and To field contains only one address, the address is inserted in default." - (interactive) - (unless (message-position-on-field "Mail-Followup-To" "Subject") - (let ((start (point)) - addresses) - (save-restriction - (message-narrow-to-headers) - (setq addresses (split-string (mail-strip-quoted-names - (or (std11-fetch-field "to") "")) - "[ \f\t\n\r\v,]+")) - (when (eq 1 (length addresses)) - (goto-char start) - (insert (car addresses)) - (goto-char start)))))) - (defun message-goto-mail-copies-to () "Move point to the Mail-Copies-To header. If the header is newly created, a string \"never\" is inserted in default." @@ -1990,6 +2001,23 @@ a string \"never\" is inserted in default." (interactive) (message-position-on-field "Followup-To" "Newsgroups")) +(defun message-goto-mail-followup-to () + "Move point to the Mail-Followup-To header. If the header is newly created +and To field contains only one address, the address is inserted in default." + (interactive) + (unless (message-position-on-field "Mail-Followup-To" "Subject") + (let ((start (point)) + addresses) + (save-restriction + (message-narrow-to-headers) + (setq addresses (split-string (mail-strip-quoted-names + (or (std11-fetch-field "to") "")) + "[ \f\t\n\r\v,]+")) + (when (eq 1 (length addresses)) + (goto-char start) + (insert (car addresses)) + (goto-char start)))))) + (defun message-goto-keywords () "Move point to the Keywords header." (interactive) @@ -3044,6 +3072,16 @@ This sub function is for exclusive use of `message-send-mail'." (let ((message-deletable-headers (if news nil message-deletable-headers))) (message-generate-headers message-required-mail-headers)) + ;; Generate the Mail-Followup-To header if the header is not there... + (if (and (or message-subscribed-regexps + message-subscribed-addresses + message-subscribed-address-functions) + (not (mail-fetch-field "mail-followup-to"))) + (message-generate-headers + `(("Mail-Followup-To" . ,(message-make-mft)))) + ;; otherwise, delete the MFT header if the field is empty + (when (equal "" (mail-fetch-field "mail-followup-to")) + (message-remove-header "Mail-Followup-To"))) ;; Let the user do all of the above. (run-hooks 'message-header-hook)) (if (not (message-check-mail-syntax)) @@ -4166,6 +4204,29 @@ give as trustworthy answer as possible." (or mail-host-address (message-make-fqdn))) +(defun message-make-mft () + "Return the Mail-Followup-To header." + (let* ((msg-recipients (message-options-get 'message-recipients)) + (recipients + (mapcar 'mail-strip-quoted-names + (message-tokenize-header msg-recipients))) + (mft-regexps (apply 'append message-subscribed-regexps + (mapcar 'regexp-quote + message-subscribed-addresses) + (mapcar 'funcall + message-subscribed-address-functions)))) + (save-match-data + (when (eval (apply 'append '(or) + (mapcar + (function (lambda (regexp) + (mapcar + (function (lambda (recipient) + `(string-match ,regexp + ,recipient))) + recipients))) + mft-regexps))) + msg-recipients)))) + ;; Dummy to avoid byte-compile warning. (defvar mule-version) (defvar emacs-beta-version) diff --git a/texi/ChangeLog b/texi/ChangeLog index a9a4306..0a81b84 100644 --- a/texi/ChangeLog +++ b/texi/ChangeLog @@ -1,3 +1,8 @@ +2001-10-31 Simon Josefsson + + * gnus.texi (Group Parameters): Add integer `display'. + (IMAP): Fix. + 2001-10-31 Katsumi Yamaoka * gnus.texi (NNTP): Added documentation for diff --git a/texi/gnus-ja.texi b/texi/gnus-ja.texi index 05a8235..73c8504 100644 --- a/texi/gnus-ja.texi +++ b/texi/gnus-ja.texi @@ -2849,6 +2849,10 @@ kiboze $B%0%k!<%W$r:n@.$7$^$9!#%W%m%s%W%H$GL>A0$H!"(Bkiboze $B%0%k!<%W$K!V4^$ @item all $BL$FI!"4{FI5-;v$NN>J}$rA4$FI=<($7$^$9!#(B +@item an integer +$B$=$N%0%k!<%W$N:G8e$N@0?t8D$N5-;v$rI=<($7$^$9!#$3$l$O(B C-u $B@0?t(B $B$G$=$N%0%k!<(B +$B%W$KF~$k$N$HF1$8$G$9!#(B + @item default $B=i4|@_Dj$G$NI=<(5-;v$rI=<($7$^$9!#$3$l$ODL>o$OL$FI5-;v$H0uIU$-5-;v$G$9!#(B diff --git a/texi/gnus.texi b/texi/gnus.texi index 9711151..56889a0 100644 --- a/texi/gnus.texi +++ b/texi/gnus.texi @@ -2763,6 +2763,10 @@ display on entering the group. Valid values are: @item all Display all articles, both read and unread. +@item an integer +Display the last INTEGER articles in the group. This is the same as +entering the group with C-u INTEGER. + @item default Display the default visible articles, which normally includes unread and ticked articles. @@ -14063,7 +14067,7 @@ server name if not specified. @vindex nnimap-server-port Port on server to contact. Defaults to port 143, or 993 for SSL. -Note that this should be a integer, example server specification: +Note that this should be an integer, example server specification: @lisp (nnimap "mail.server.com" -- 1.7.10.4