From 42170dbfbfb98a97f24fea2f98e13c33351f106c Mon Sep 17 00:00:00 2001 From: yamaoka Date: Wed, 10 Jan 2001 00:01:19 +0000 Subject: [PATCH] Synch with Oort Gnus. --- lisp/ChangeLog | 166 ++++++++++++++++++++++++++++------------------------ lisp/dgnushack.el | 8 ++- lisp/gnus-agent.el | 18 +++++- lisp/gnus-art.el | 157 +++++++++++++++++++++++++------------------------ lisp/gnus-group.el | 63 +++++++++++--------- lisp/gnus-salt.el | 14 ++++- lisp/gnus-sum.el | 25 +++++--- lisp/gnus-topic.el | 61 ++++++++++--------- lisp/gnus-xmas.el | 39 +++--------- 9 files changed, 297 insertions(+), 254 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index f5b1034..5741f9f 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,19 @@ +2001-01-09 Didier Verna + + * dgnushack.el (dgnushack-compile): give a dummy value to + `gnus-xmas-glyph-directory' for the time of compilation. + * gnus-agent.el: moved some XEmacs specific hook add-ons from + `gnus-xmas-[re]define' to avoid loosing user custom settings. + * gnus-art.el: ditto. + * gnus-group.el: ditto. + * gnus-salt.el: ditto. + * gnus-sum.el: ditto. + * gnus-topic.el: ditto. + * gnus-xmas.el (gnus-xmas-define): see above. + * gnus-xmas.el (gnus-xmas-redefine): see above. + * gnus-xmas.el (gnus-xmas-glyph-directory): generate a + non-continuable error when the directory can't be found. + 2001-01-09 01:00:00 ShengHuo ZHU * mm-decode.el (mm-interactively-view-part): Don't copy-sequence @@ -16,8 +32,8 @@ 2001-01-08 22:00:00 ShengHuo ZHU - * gnus-xmas.el (gnus-xmas-modeline-glyph): - (gnus-xmas-group-startup-message): + * gnus-xmas.el (gnus-xmas-modeline-glyph): + (gnus-xmas-group-startup-message): Detect gnus-xmas-glyph-directory when it is nil. 2001-01-08 09:00:00 ShengHuo ZHU @@ -34,7 +50,7 @@ 2001-01-04 11:06:14 Gregory Chernov * nnslashdot.el (nnslashdot-request-list): Always get the right - sid. + sid. 2001-01-05 00:00:00 ShengHuo ZHU @@ -54,7 +70,7 @@ 2001-01-02 06:28:28 Lars Magne Ingebrigtsen * gnus-sum.el (gnus-summary-expire-articles): Don't save - excursion. + excursion. * nnslashdot.el (nnslashdot-request-list): Get the right year. @@ -78,7 +94,7 @@ (gnus-summary-setup-buffer): Use it. * gnus-draft.el: Set things up with the right post method and - stuff. + stuff. * message.el (message-ignored-news-headers): Remove X-Draft-From. @@ -93,7 +109,7 @@ * mm-uu.el (mm-uu-pgp-signed-extract-1): Unquote "- " quotes. - * dgnushack.el (dgnushack-compile): Message whether there is w3. + * dgnushack.el (dgnushack-compile): Message whether there is w3. Don't (push "/usr/share/emacs/site-lisp" load-path). * gnus-cite.el (gnus-article-fill-cited-article): Don't add space @@ -123,7 +139,7 @@ * nnmail.el (nnmail-expiry-wait): Not an integer. * message.el (message-goto-body): Only expand abbrev when called - interactively. + interactively. (message-make-lines): Use it. 2000-12-29 20:00:00 ShengHuo ZHU @@ -154,7 +170,7 @@ after the fill prefix. * gnus-sum.el (gnus-summary-make-menu-bar): Removed "Enter - score...". + score...". * gnus-art.el (gnus-ignored-headers): Hide more headers. @@ -166,7 +182,7 @@ * mm-bodies.el (mm-long-lines-p): New function. (mm-body-encoding): Use it. (mm-body-encoding): Encode articles with lines longer than 1000 - characters. + characters. 2000-12-29 01:00:00 ShengHuo ZHU @@ -184,7 +200,7 @@ * nnheader.el (nnheader-string-as-multibyte): New alias. - * mm-view.el (mm-inline-text): Warn when bugging out in w3. + * mm-view.el (mm-inline-text): Warn when bugging out in w3. * gnus-uu.el (gnus-message-process-mark): New function. (gnus-uu-mark-by-regexp): Use it. @@ -197,7 +213,7 @@ 2000-11-01 01:12:29 Lars Magne Ingebrigtsen * nnwfm.el (nnwfm-create-mapping): Remove quote marks and - backslashes. + backslashes. 2000-12-26 Katsumi Yamaoka @@ -260,19 +276,19 @@ * gnus-vm.el (gnus-summary-save-article-vm): Require gnus-art before binding gnus-default-article-saver. - * gnus-sum.el (gnus-summary-save-article): - (gnus-summary-pipe-output): - (gnus-summary-save-article-mail): - (gnus-summary-save-article-rmail): - (gnus-summary-save-article-file): - (gnus-summary-write-article-file): + * gnus-sum.el (gnus-summary-save-article): + (gnus-summary-pipe-output): + (gnus-summary-save-article-mail): + (gnus-summary-save-article-rmail): + (gnus-summary-save-article-file): + (gnus-summary-write-article-file): (gnus-summary-save-article-body-file): Ditto. * gnus-mh.el (gnus-summary-save-article-folder): Ditto. 2000-12-22 10:00:00 ShengHuo ZHU - * gnus-art.el (gnus-mime-security-button-map): + * gnus-art.el (gnus-mime-security-button-map): (gnus-mime-button-map): Add parent. 2000-12-22 09:00:00 ShengHuo ZHU @@ -295,9 +311,9 @@ * mm-util.el (mm-image-load-path): New function. * gnus-group.el (gnus-group-make-tool-bar): Use it. - + * gnus-sum.el (gnus-summary-make-tool-bar): Use it. - + * message.el (message-tool-bar-map): Use it. * Makefile.in (install-el): New. @@ -413,7 +429,7 @@ * mml.el (gnus-ems): Require it. * gnus-msg.el (gnus-summary-mail-forward): - + * message.el (message-forward): Move mime-to-mml here. 2000-12-20 02:00:00 ShengHuo ZHU @@ -495,7 +511,7 @@ * smiley-ems.el (smiley-regexp-alist): Make regexps match at the end of the buffer. (smiley-region): In the loop, move to the end of the submatch - matching the smiley instead of using the end of the match + matching the smiley instead of using the end of the match of the whole regexp. 2000-12-12 Eli Zaretskii @@ -505,7 +521,7 @@ 2000-12-12 Gerd Moellmann * smiley-ems.el (smiley-region): Doc fix. - + 2000-12-11 Miles Bader * gnus-sum.el (gnus-summary-recenter): When trying to keep the @@ -580,7 +596,7 @@ * gnus-art.el (gnus-mime-button-map): Don't inherit from gnus-article-mode-map. ; (gnus-mime-button-menu): Use mouse-set-point. - (gnus-insert-mime-button, gnus-mime-display-alternative) + (gnus-insert-mime-button, gnus-mime-display-alternative) (gnus-mime-display-alternative): Don't use local-map property. 2000-11-17 Dave Love @@ -610,25 +626,25 @@ * gnus-start.el (gnus-read-newsrc-file): Add :version. - * gnus-art.el (gnus-article-banner-alist) - (gnus-emphasize-whitespace-regexp, gnus-ignored-mime-types) - (gnus-article-date-lapsed-new-header) - (gnus-article-mime-match-handle-function, gnus-mime-action-alist) - (gnus-treat-strip-list-identifiers, gnus-treat-date-iso8601) - (gnus-treat-strip-headers-in-body) - (gnus-treat-capitalize-sentences, gnus-treat-play-sounds) + * gnus-art.el (gnus-article-banner-alist) + (gnus-emphasize-whitespace-regexp, gnus-ignored-mime-types) + (gnus-article-date-lapsed-new-header) + (gnus-article-mime-match-handle-function, gnus-mime-action-alist) + (gnus-treat-strip-list-identifiers, gnus-treat-date-iso8601) + (gnus-treat-strip-headers-in-body) + (gnus-treat-capitalize-sentences, gnus-treat-play-sounds) (gnus-treat-translate): Add :version. (gnus-article-mime-part-function): Fix defcustom. - * nnmail.el (nnmail-expiry-target) - (nnmail-scan-directory-mail-source-once, nnmail-extra-headers) + * nnmail.el (nnmail-expiry-target) + (nnmail-scan-directory-mail-source-once, nnmail-extra-headers) (nnmail-split-header-length-limit): Add :version. - * gnus-sum.el (gnus-auto-expirable-marks) - (gnus-inhibit-user-auto-expire, gnus-list-identifiers) - (gnus-extra-headers, gnus-ignored-from-addresses) - (gnus-newsgroup-ignored-charsets) - (gnus-group-highlight-words-alist) + * gnus-sum.el (gnus-auto-expirable-marks) + (gnus-inhibit-user-auto-expire, gnus-list-identifiers) + (gnus-extra-headers, gnus-ignored-from-addresses) + (gnus-newsgroup-ignored-charsets) + (gnus-group-highlight-words-alist) (gnus-summary-show-article-charset-alist): Add :version. * catchup.pbm, describe-group.pbm, exit-gnus.pbm, get-news.pbm: @@ -646,8 +662,8 @@ ; * message.el (message-mode) : ; : Use [:alnum:] in regexp range. ; (message-newline-and-reformat): Likewise. - (message-forward-as-mime, message-forward-ignored-headers) - (message-buffer-naming-style, message-default-charset) + (message-forward-as-mime, message-forward-ignored-headers) + (message-buffer-naming-style, message-default-charset) (message-dont-reply-to-names, message-send-mail-partially-limit): Add :version. @@ -666,7 +682,7 @@ 2000-11-09 Dave Love - * gnus-group.el (gnus-group-make-directory-group) + * gnus-group.el (gnus-group-make-directory-group) (gnus-group-fetch-faq): Use expand-file-name. (gnus-group-fetch-faq): Simplify completing-read form. @@ -679,7 +695,7 @@ (gnus-tm-lisp-directory): Deleted. (gnus-use-installed-mailcrypt, gnus-emacs-lisp-directory): Use (featurep 'xemacs). - (gnus-gnus-lisp-directory, gnus-mailcrypt-lisp-directory) + (gnus-gnus-lisp-directory, gnus-mailcrypt-lisp-directory) (gnus-mailcrypt-lisp-directory, gnus-bbdb-lisp-directory): Remove version numbers from file names. @@ -836,7 +852,7 @@ of the `gnus-xemacs' variable, as the latter has been removed. * gnus-start.el (gnus-1, gnus-read-descriptions-file): Likewise. * gnus-art.el (gnus-treat-display-xface) - (gnus-treat-display-smileys, gnus-treat-display-picons) + (gnus-treat-display-smileys, gnus-treat-display-picons) (gnus-article-read-summary-keys): Likewise. 2000-10-26 Dave Love @@ -970,7 +986,7 @@ 2000-09-14 Dave Love - * gnus.el (gnus-charset): + * gnus.el (gnus-charset): * mm-decode.el (mime-display): * imap.el (imap) : Add :version. @@ -1001,7 +1017,7 @@ * mml.el (mml-mode-map): Change mml prefix from `M-m' to `C-c C-m' to avoid conflict with the standard `back-to-indentation' - binding. + binding. 2000-12-17 10:00:00 ShengHuo ZHU @@ -1071,7 +1087,7 @@ Also do some repair work, if we find articles that are missing the appropriate X-Gnus-Newsgroup lines in the header. We can usually reconstruct these from Xref info. - + 2000-12-04 18:00:00 ShengHuo ZHU * mail-source.el (mail-source-report-new-mail): Use @@ -1084,7 +1100,7 @@ (mail-source-check-pop): Ditto. (mail-source-start-idle-timer): Prevent multiple pop checks running if the check takes a long time. - + 2000-12-04 14:00:00 ShengHuo ZHU * gnus-msg.el (gnus-msg-mail): COMPOSEFUNC should return t if @@ -1147,7 +1163,7 @@ * gnus-cite.el (gnus-article-hide-citation): Use them. (gnus-article-toggle-cited-text): Use them. - + * gnus-art.el (gnus-signature-toggle): Use them. (gnus-article-show-hidden-text): Ditto. (gnus-article-hide-text): Ditto. @@ -1168,9 +1184,9 @@ 2000-11-29 20:00:00 ShengHuo ZHU * nnfolder.el (nnfolder-request-expire-articles): expiry-target. - + * nnbabyl.el (nnbabyl-request-expire-articles): Ditto. - + * nnmbox.el (nnmbox-request-expire-articles): Ditto. 2000-11-22 Jan Nieuwenhuizen @@ -1350,10 +1366,10 @@ (mml-smime-encrypt-buffer): Use mml-smime-encrypt. * mml-smime.el (mml-smime-sign): New function. - (mml-smime-encrypt): - (mml-smime-sign-query): - (mml-smime-get-file-cert): - (mml-smime-get-dns-cert): + (mml-smime-encrypt): + (mml-smime-sign-query): + (mml-smime-get-file-cert): + (mml-smime-get-dns-cert): (mml-smime-encrypt-query): Moved from mml-sec.el. 2000-11-16 Simon Josefsson @@ -1486,7 +1502,7 @@ * rfc2231.el (rfc2231-encode-string): Insert semi-colon and leading space. - * mm-extern.el (mm-inline-external-body): Report error when no + * mm-extern.el (mm-inline-external-body): Report error when no access-type. 2000-11-12 19:48:30 ShengHuo ZHU @@ -1503,7 +1519,7 @@ as multipart/mixed. 2000-11-12 David Edmondson - + * message.el (message-cite-prefix-regexp): moved from gnus-cite.el and replace `.' with `\w' to allow for different syntax tables (from Vladimir Volovich). @@ -1529,9 +1545,9 @@ * mml2015.el (mml2015-gpg-verify): Set "OK" security status. * smime.el (smime-details-buffer): New variable. - (smime-sign-region): - (smime-encrypt-region): - (smime-verify-region): + (smime-sign-region): + (smime-encrypt-region): + (smime-verify-region): (smime-decrypt-region): Copy OpenSSL output to the buffer. * mml-smime.el (mml-smime-verify): Support security info. @@ -1554,7 +1570,7 @@ names. (Report from Nevin Kapur) 2000-11-10 01:23:20 ShengHuo ZHU - + * mm-partial.el (mm-inline-partial): Insert MIME-Version. 2000-11-09 17:02:50 ShengHuo ZHU @@ -1575,7 +1591,7 @@ 2000-11-08 19:58:58 ShengHuo ZHU - * mml2015.el (mml2015-gpg-decrypt-1): + * mml2015.el (mml2015-gpg-decrypt-1): (mml2015-gpg-verify): buffer-string has no argument in Emacs. 2000-11-08 16:37:02 ShengHuo ZHU @@ -1586,7 +1602,7 @@ * pop3.el (pop3-munge-message-separator): A message may have an empty body. - + 2000-11-07 18:02:26 ShengHuo ZHU * mm-uu.el (mm-uu-type-alist): Don't test pgp stuff. @@ -1610,10 +1626,10 @@ 2000-02-02 Alexandre Oliva * gnus-mlspl.el: Documentation tweaks. - + 2000-11-06 22:06:44 ShengHuo ZHU - * mm-decode.el (mm-possibly-verify-or-decrypt): Fix. + * mm-decode.el (mm-possibly-verify-or-decrypt): Fix. * gnus-art.el (gnus-article-encrypt-body): Rename and support prefix argument. @@ -1688,7 +1704,7 @@ * mm-decode.el (mml-smime-verify): Autoload mml-smime. Verify S/MIME signature support. - + * mm-decode.el (mm-inline-media-tests): Add application/{x-,}pkcs7-signature. (mm-inlined-types): Ditto. @@ -1749,7 +1765,7 @@ * message.el (message-font-lock-keywords): Match a final newline to help font-lock's multiline support. - + 2000-11-04 09:11:44 ShengHuo ZHU * nnoo.el (nnoo-set): New function. @@ -1815,19 +1831,19 @@ * message.el (message-get-reply-headers): Better handling when Mail-Followup-To is very large. - + 2000-11-02 13:27:56 ShengHuo ZHU - * gnus-uu.el (gnus-uu-post-news): Comment out the redundancy. - * gnus-art.el (gnus-article-edit-done): - * gnus-sum.el (gnus-summary-edit-article-done): Move line + * gnus-uu.el (gnus-uu-post-news): Comment out the redundancy. + * gnus-art.el (gnus-article-edit-done): + * gnus-sum.el (gnus-summary-edit-article-done): Move line counting code here. * gnus-msg.el (gnus-setup-message): Remove a hack. 2000-11-02 09:33:01 ShengHuo ZHU * gnus-sum.el (gnus-newsgroup-variables): New variable. - (gnus-summary-mode): Make them local variables. + (gnus-summary-mode): Make them local variables. (gnus-set-global-variables): Globalize them. (gnus-summary-exit): Kill them. @@ -1864,7 +1880,7 @@ 2000-11-01 01:12:29 Lars Magne Ingebrigtsen - * nnultimate.el (nnultimate-create-mapping): Use nreverse. + * nnultimate.el (nnultimate-create-mapping): Use nreverse. 2000-10-31 23:45:31 Lars Magne Ingebrigtsen @@ -1917,7 +1933,7 @@ 2000-10-16 11:36:52 Lars Magne Ingebrigtsen * nnultimate.el (nnultimate-forum-table-p): Be a bit more - restrictive. + restrictive. (nnultimate-table-regexp): New variable. (nnultimate-forum-table-p): Use it. @@ -2039,7 +2055,7 @@ (gnus-request-accept-article): Ditto. * mml.el (mml-preview): Use them. * gnus-sum.el (gnus-summary-edit-article): Use them. - + * message.el (message-options-get): New function. (message-options-get): New function. * rfc2047.el (rfc2047-encode-message-header): Use them. @@ -2047,7 +2063,7 @@ 2000-10-28 Simon Josefsson - * nnimap.el (nnimap-retrieve-which-headers): + * nnimap.el (nnimap-retrieve-which-headers): (nnimap-request-article-part): Quote message-id. * smime.el (smime-CA-directory): Rename from `smime-CAs'. diff --git a/lisp/dgnushack.el b/lisp/dgnushack.el index 6016405..b0e050c 100644 --- a/lisp/dgnushack.el +++ b/lisp/dgnushack.el @@ -335,9 +335,13 @@ Modify to suit your needs.")) (file-newer-than-file-p file elc)) (delete-file elc))) - (let (;;(byte-compile-generate-call-tree t) - (files dgnushack-exporting-files) + (let ((files dgnushack-exporting-files) + ;;(byte-compile-generate-call-tree t) file elc) + ;; Avoid barfing (from gnus-xmas) because the etc directory is not yet + ;; installed. + (when (featurep 'xemacs) + (setq gnus-xmas-glyph-directory "dummy")) (while (setq file (pop files)) (setq file (expand-file-name file srcdir)) (when (or (not (file-exists-p diff --git a/lisp/gnus-agent.el b/lisp/gnus-agent.el index 0d59ee0..6cfba01 100644 --- a/lisp/gnus-agent.el +++ b/lisp/gnus-agent.el @@ -74,16 +74,28 @@ If nil, only read articles will be expired." :group 'gnus-agent :type 'hook) +;; Extracted from gnus-xmas-redefine in order to preserve user settings +(when (featurep 'xemacs) + (add-hook 'gnus-agent-group-mode-hook 'gnus-xmas-agent-group-menu-add)) + (defcustom gnus-agent-summary-mode-hook nil "Hook run in Agent summary minor modes." :group 'gnus-agent :type 'hook) +;; Extracted from gnus-xmas-redefine in order to preserve user settings +(when (featurep 'xemacs) + (add-hook 'gnus-agent-summary-mode-hook 'gnus-xmas-agent-summary-menu-add)) + (defcustom gnus-agent-server-mode-hook nil "Hook run in Agent summary minor modes." :group 'gnus-agent :type 'hook) +;; Extracted from gnus-xmas-redefine in order to preserve user settings +(when (featurep 'xemacs) + (add-hook 'gnus-agent-server-mode-hook 'gnus-xmas-agent-server-menu-add)) + (defcustom gnus-agent-confirmation-function 'y-or-n-p "Function to confirm when error happens." :version "21.1" @@ -1107,7 +1119,7 @@ the actual number of articles toggled is returned." (unless (funcall gnus-agent-confirmation-function (format "Error (%s). Continue? " err)) (error "Cannot fetch articles into the Gnus agent."))) - (quit + (quit (unless (funcall gnus-agent-confirmation-function (format "Quit fetching session (%s). Continue? " err)) @@ -1552,8 +1564,8 @@ The following commands are available: (if (numberp fetch-date) (> fetch-date day) ;; History file is corrupted. - (gnus-message - 5 + (gnus-message + 5 (format "File %s is corrupted!" (gnus-agent-lib-file "history"))) (sit-for 1) diff --git a/lisp/gnus-art.el b/lisp/gnus-art.el index 1430aa9..f8e0c4a 100644 --- a/lisp/gnus-art.el +++ b/lisp/gnus-art.el @@ -249,25 +249,25 @@ asynchronously. The compressed face will be piped to this command." (defcustom gnus-article-banner-alist nil "Banner alist for stripping. -For example, +For example, ((egroups . \"^[ \\t\\n]*-------------------+\\\\( eGroups Sponsor -+\\\\)?....\\n\\\\(.+\\n\\\\)+\"))" :version "21.1" :type '(repeat (cons symbol regexp)) :group 'gnus-article-washing) -(gnus-define-group-parameter +(gnus-define-group-parameter banner :variable-document "Alist of regexps (to match group names) and banner." :variable-group gnus-article-washing - :parameter-type + :parameter-type '(choice :tag "Banner" :value nil (const :tag "Remove signature" signature) (symbol :tag "Item in `gnus-article-banner-alist'" none) regexp (const :tag "None" nil)) - :parameter-document + :parameter-document "If non-nil, specify how to remove `banners' from articles. Symbol `signature' means to remove signatures delimited by @@ -506,6 +506,13 @@ The following additional specs are available: :type 'hook :group 'gnus-article-various) +(when (featurep 'xemacs) + ;; Extracted from gnus-xmas-define in order to preserve user settings + (when (fboundp 'turn-off-scroll-in-place) + (add-hook 'gnus-article-mode-hook 'turn-off-scroll-in-place)) + ;; Extracted from gnus-xmas-redefine in order to preserve user settings + (add-hook 'gnus-article-mode-hook 'gnus-xmas-article-menu-add)) + (defcustom gnus-article-menu-hook nil "*Hook run after the creation of the article mode menu." :type 'hook @@ -712,17 +719,17 @@ be added below it (otherwise)." (defcustom gnus-article-mime-match-handle-function 'undisplayed-alternative "Function called with a MIME handle as the argument. This is meant for people who want to view first matched part. -For `undisplayed-alternative' (default), the first undisplayed -part or alternative part is used. For `undisplayed', the first -undisplayed part is used. For a function, the first part which +For `undisplayed-alternative' (default), the first undisplayed +part or alternative part is used. For `undisplayed', the first +undisplayed part is used. For a function, the first part which the function return `t' is used. For `nil', the first part is used." :version "21.1" :group 'gnus-article-mime - :type '(choice + :type '(choice (item :tag "first" :value nil) (item :tag "undisplayed" :value undisplayed) - (item :tag "undisplayed or alternative" + (item :tag "undisplayed or alternative" :value undisplayed-alternative) (function))) @@ -1172,7 +1179,7 @@ It is a string, such as \"PGP\". If nil, ask user." (defvar gnus-article-mode-syntax-table (let ((table (copy-syntax-table text-mode-syntax-table))) ;; This causes the citation match run O(2^n). - ;; (modify-syntax-entry ?- "w" table) + ;; (modify-syntax-entry ?- "w" table) (modify-syntax-entry ?> ")" table) (modify-syntax-entry ?< "(" table) table) @@ -1742,7 +1749,7 @@ MAP is an alist where the elements are on the form (\"from\" \"to\")." (let ((inhibit-point-motion-hooks t) buffer-read-only (mail-parse-charset gnus-newsgroup-charset) - (mail-parse-ignored-charsets + (mail-parse-ignored-charsets (save-excursion (set-buffer gnus-summary-buffer) gnus-newsgroup-ignored-charsets))) (mail-decode-encoded-word-region (point-min) (point-max))))) @@ -1754,7 +1761,7 @@ If PROMPT (the prefix), prompt for a coding system to use." (let ((inhibit-point-motion-hooks t) (case-fold-search t) buffer-read-only (mail-parse-charset gnus-newsgroup-charset) - (mail-parse-ignored-charsets + (mail-parse-ignored-charsets (save-excursion (condition-case nil (set-buffer gnus-summary-buffer) (error)) @@ -1775,7 +1782,7 @@ If PROMPT (the prefix), prompt for a coding system to use." format (and ctl (mail-content-type-get ctl 'format))) (when cte (setq cte (mail-header-strip cte))) - (if (and ctl (not (string-match "/" (car ctl)))) + (if (and ctl (not (string-match "/" (car ctl)))) (setq ctl nil)) (goto-char (point-max))) (forward-line 1) @@ -1814,14 +1821,14 @@ or not." (setq type (gnus-fetch-field "content-transfer-encoding")) (let* ((ct (gnus-fetch-field "content-type")) - (ctl (and ct + (ctl (and ct (ignore-errors (mail-header-parse-content-type ct))))) (setq charset (and ctl (mail-content-type-get ctl 'charset))) (if (stringp charset) (setq charset (intern (downcase charset))))))) - (unless charset + (unless charset (setq charset gnus-newsgroup-charset)) (when (or force (and type (let ((case-fold-search t)) @@ -1841,14 +1848,14 @@ If FORCE, decode the article whether it is marked as base64 not." (setq type (gnus-fetch-field "content-transfer-encoding")) (let* ((ct (gnus-fetch-field "content-type")) - (ctl (and ct + (ctl (and ct (ignore-errors (mail-header-parse-content-type ct))))) (setq charset (and ctl (mail-content-type-get ctl 'charset))) (if (stringp charset) (setq charset (intern (downcase charset))))))) - (unless charset + (unless charset (setq charset gnus-newsgroup-charset)) (when (or force (and type (let ((case-fold-search t)) @@ -1880,14 +1887,14 @@ If FORCE, decode the article whether it is marked as base64 not." (if (gnus-buffer-live-p gnus-original-article-buffer) (with-current-buffer gnus-original-article-buffer (let* ((ct (gnus-fetch-field "content-type")) - (ctl (and ct + (ctl (and ct (ignore-errors (mail-header-parse-content-type ct))))) (setq charset (and ctl (mail-content-type-get ctl 'charset))) (if (stringp charset) (setq charset (intern (downcase charset))))))) - (unless charset + (unless charset (setq charset gnus-newsgroup-charset)) (article-goto-body) (save-window-excursion @@ -1914,7 +1921,7 @@ The `gnus-list-identifiers' variable specifies what to do." (when regexp (goto-char (point-min)) (when (re-search-forward - (concat "^Subject: +\\(\\(\\(Re: +\\)?\\(" regexp + (concat "^Subject: +\\(\\(\\(Re: +\\)?\\(" regexp " *\\)\\)+\\(Re: +\\)?\\)") nil t) (let ((s (or (match-string 3) (match-string 5)))) @@ -2242,9 +2249,9 @@ means show, 0 means toggle." Originally it is hide instead of DUMMY." (let ((buffer-read-only nil) (inhibit-point-motion-hooks t)) - (gnus-remove-text-properties-when + (gnus-remove-text-properties-when 'article-type type - (point-min) (point-max) + (point-min) (point-max) (cons 'article-type (cons type gnus-hidden-properties))))) @@ -2348,7 +2355,7 @@ should replace the \"Date:\" one, or should be added below it." ((eq type 'local) (let ((tz (car (current-time-zone time)))) (format "Date: %s %s%02d%02d" (current-time-string time) - (if (> tz 0) "+" "-") (/ (abs tz) 3600) + (if (> tz 0) "+" "-") (/ (abs tz) 3600) (/ (% (abs tz) 3600) 60)))) ;; Convert to Universal Time. ((eq type 'ut) @@ -2381,7 +2388,7 @@ should replace the \"Date:\" one, or should be added below it." "Date: " (format-time-string "%Y%m%dT%H%M%S" time) (format "%s%02d%02d" - (if (> tz 0) "+" "-") (/ (abs tz) 3600) + (if (> tz 0) "+" "-") (/ (abs tz) 3600) (/ (% (abs tz) 3600) 60))))) ;; Do an X-Sent lapsed format. ((eq type 'lapsed) @@ -2539,10 +2546,10 @@ This format is defined by the `gnus-article-time-format' variable." (interactive (gnus-article-hidden-arg)) (unless (gnus-article-check-hidden-text 'emphasis arg) (save-excursion - (let ((alist (or + (let ((alist (or (condition-case nil - (with-current-buffer gnus-summary-buffer - gnus-article-emphasis-alist) + (with-current-buffer gnus-summary-buffer + gnus-article-emphasis-alist) (error)) gnus-emphasis-alist)) (buffer-read-only nil) @@ -2874,7 +2881,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is (let ((sig (with-current-buffer gnus-original-article-buffer (gnus-fetch-field "X-PGP-Sig"))) items info headers) - (when (and sig + (when (and sig mml2015-use (mml2015-clear-verify-function)) (with-temp-buffer @@ -2885,7 +2892,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is (case-fold-search t)) ;; Don't verify multiple headers. (setq headers (mapconcat (lambda (header) - (concat header ": " + (concat header ": " (mail-fetch-field header) "\n")) (split-string (nth 1 items) ",") ""))) (delete-region (point-min) (point-max)) @@ -2907,10 +2914,10 @@ If variable `gnus-use-long-file-name' is non-nil, it is (let ((coding-system-for-write (or gnus-newsgroup-charset 'iso-8859-1))) (funcall (mml2015-clear-verify-function))) - (setq info - (or (mm-handle-multipart-ctl-parameter + (setq info + (or (mm-handle-multipart-ctl-parameter mm-security-handle 'gnus-details) - (mm-handle-multipart-ctl-parameter + (mm-handle-multipart-ctl-parameter mm-security-handle 'gnus-info))))) (when info (let (buffer-read-only bface eface) @@ -3055,7 +3062,7 @@ If variable `gnus-use-long-file-name' is non-nil, it is (decf c)) keys)))) -(eval-when-compile +(eval-when-compile (defvar gnus-article-commands-menu)) (defun gnus-article-make-menu-bar () @@ -3562,7 +3569,7 @@ value of the variable `gnus-show-mime' is non-nil." (set-buffer gnus-article-buffer) (let ((handles (or handles gnus-article-mime-handles)) (mail-parse-charset gnus-newsgroup-charset) - (mail-parse-ignored-charsets + (mail-parse-ignored-charsets (with-current-buffer gnus-summary-buffer gnus-newsgroup-ignored-charsets))) (when handles @@ -3577,7 +3584,7 @@ value of the variable `gnus-show-mime' is non-nil." "Save the MIME part under point then replace it with an external body." (interactive) (gnus-article-check-buffer) - (let* ((data (get-text-property (point) 'gnus-data)) + (let* ((data (get-text-property (point) 'gnus-data)) (file (and data (mm-save-part data))) param) (when file @@ -3591,17 +3598,17 @@ value of the variable `gnus-show-mime' is non-nil." (insert "Content-Transfer-Encoding: binary\n") (insert "\n")) (setcdr data - (cdr (mm-make-handle nil + (cdr (mm-make-handle nil `("message/external-body" (access-type . "LOCAL-FILE") (name . ,file))))) (set-buffer gnus-summary-buffer) (gnus-article-edit-article - `(lambda () + `(lambda () (erase-buffer) - (let ((mail-parse-charset (or gnus-article-charset + (let ((mail-parse-charset (or gnus-article-charset ',gnus-newsgroup-charset)) - (mail-parse-ignored-charsets + (mail-parse-ignored-charsets (or gnus-article-ignored-charsets ',gnus-newsgroup-ignored-charsets)) (mbl mml-buffer-list)) @@ -3619,17 +3626,17 @@ value of the variable `gnus-show-mime' is non-nil." ',gnus-newsgroup-charset)) (message-options message-options) (message-options-set-recipient) - (mail-parse-ignored-charsets + (mail-parse-ignored-charsets (or gnus-article-ignored-charsets ',gnus-newsgroup-ignored-charsets))) (mml-to-mime) (mml-destroy-buffers) - (remove-hook 'kill-buffer-hook + (remove-hook 'kill-buffer-hook 'mml-destroy-buffers t) (kill-local-variable 'mml-buffer-list)) (gnus-summary-edit-article-done ,(or (mail-header-references gnus-current-headers) "") - ,(gnus-group-read-only-p) + ,(gnus-group-read-only-p) ,gnus-summary-buffer no-highlight)))))) (defun gnus-mime-save-part () @@ -3695,7 +3702,7 @@ value of the variable `gnus-show-mime' is non-nil." (gnus-article-check-buffer) (let* ((handle (or handle (get-text-property (point) 'gnus-data))) (contents (and handle (mm-get-part handle))) - (base (and handle + (base (and handle (file-name-nondirectory (or (mail-content-type-get (mm-handle-type handle) 'name) @@ -3735,13 +3742,13 @@ value of the variable `gnus-show-mime' is non-nil." (if (mm-handle-undisplayer handle) (mm-remove-part handle)) (setq charset - (or (cdr (assq arg + (or (cdr (assq arg gnus-summary-show-article-charset-alist)) (read-coding-system "Charset: "))))) (forward-line 2) (mm-insert-inline handle - (if (and charset - (setq charset (mm-charset-to-coding-system + (if (and charset + (setq charset (mm-charset-to-coding-system charset)) (not (eq charset 'ascii))) (mm-decode-coding-string contents charset) @@ -3760,7 +3767,7 @@ value of the variable `gnus-show-mime' is non-nil." (if (mm-handle-undisplayer handle) (mm-remove-part handle)) (let ((gnus-newsgroup-charset - (or (cdr (assq arg + (or (cdr (assq arg gnus-summary-show-article-charset-alist)) (read-coding-system "Charset: "))) (gnus-newsgroup-ignored-charsets 'gnus-all)) @@ -3774,7 +3781,7 @@ value of the variable `gnus-show-mime' is non-nil." (mm-user-display-methods nil) (mm-inlined-types nil) (mail-parse-charset gnus-newsgroup-charset) - (mail-parse-ignored-charsets + (mail-parse-ignored-charsets (save-excursion (set-buffer gnus-summary-buffer) gnus-newsgroup-ignored-charsets))) (when handle @@ -3791,7 +3798,7 @@ In no internal viewer is available, use an external viewer." (mm-inlined-types '(".*")) (mm-inline-large-images t) (mail-parse-charset gnus-newsgroup-charset) - (mail-parse-ignored-charsets + (mail-parse-ignored-charsets (save-excursion (set-buffer gnus-summary-buffer) gnus-newsgroup-ignored-charsets))) (when handle @@ -3856,10 +3863,10 @@ In no internal viewer is available, use an external viewer." (if condition (let ((alist gnus-article-mime-handle-alist) ihandle n) (while (setq ihandle (pop alist)) - (if (and (cond + (if (and (cond ((functionp condition) (funcall condition (cdr ihandle))) - ((eq condition 'undisplayed) + ((eq condition 'undisplayed) (not (or (mm-handle-undisplayer (cdr ihandle)) (equal (mm-handle-media-type (cdr ihandle)) "multipart/alternative")))) @@ -3877,7 +3884,7 @@ In no internal viewer is available, use an external viewer." (interactive "P") (save-current-buffer (set-buffer gnus-article-buffer) - (or (numberp n) (setq n (gnus-article-mime-match-handle-first + (or (numberp n) (setq n (gnus-article-mime-match-handle-first gnus-article-mime-match-handle-function))) (when (> n (length gnus-article-mime-handle-alist)) (error "No such part")) @@ -3902,7 +3909,7 @@ In no internal viewer is available, use an external viewer." (prog1 (let ((window (selected-window)) (mail-parse-charset gnus-newsgroup-charset) - (mail-parse-ignored-charsets + (mail-parse-ignored-charsets (save-excursion (set-buffer gnus-summary-buffer) gnus-newsgroup-ignored-charsets))) (save-excursion @@ -3975,7 +3982,7 @@ In no internal viewer is available, use an external viewer." gnus-mime-button-line-format gnus-mime-button-line-format-alist `(keymap ,gnus-mime-button-map ,@(if (>= (string-to-number emacs-version) 21) - nil + nil (list 'local-map gnus-mime-button-map)) gnus-callback gnus-mm-display-part gnus-part ,gnus-tmp-id @@ -4084,7 +4091,7 @@ In no internal viewer is available, use an external viewer." ;;;!!!to the first part. ;;(gnus-mime-display-part (cadr handle)) ;;;!!! Most multipart/related is an HTML message plus images. - ;;;!!! Unfortunately we are unable to let W3 display those + ;;;!!! Unfortunately we are unable to let W3 display those ;;;!!! included images, so we just display it as a mixed multipart. ;;(gnus-mime-display-mixed (cdr handle)) ;;;!!! No, w3 can display everything just fine. @@ -4140,8 +4147,8 @@ In no internal viewer is available, use an external viewer." ;(gnus-article-insert-newline) (gnus-insert-mime-button handle id (list (or display (and not-attachment text)))) - (gnus-article-insert-newline) - ;(gnus-article-insert-newline) + (gnus-article-insert-newline) + ;(gnus-article-insert-newline) ;; Remember modify the number of forward lines. (setq move t)) (setq beg (point)) @@ -4151,7 +4158,7 @@ In no internal viewer is available, use an external viewer." (forward-line -1) (setq beg (point))) (let ((mail-parse-charset gnus-newsgroup-charset) - (mail-parse-ignored-charsets + (mail-parse-ignored-charsets (save-excursion (condition-case () (set-buffer gnus-summary-buffer) (error)) @@ -4170,7 +4177,7 @@ In no internal viewer is available, use an external viewer." (save-restriction (narrow-to-region beg (point)) (gnus-treat-article - nil id + nil id (gnus-article-mime-total-parts) (mm-handle-media-type handle))))))))) @@ -4268,7 +4275,7 @@ In no internal viewer is available, use an external viewer." (if (stringp (car preferred)) (gnus-display-mime preferred) (let ((mail-parse-charset gnus-newsgroup-charset) - (mail-parse-ignored-charsets + (mail-parse-ignored-charsets (save-excursion (set-buffer gnus-summary-buffer) gnus-newsgroup-ignored-charsets))) (mm-display-part preferred) @@ -4712,7 +4719,7 @@ If given a prefix, show the hidden text instead." ((or (stringp article) (numberp article)) (let ((gnus-override-method gnus-override-method) - (methods (and (stringp article) + (methods (and (stringp article) gnus-refer-article-method)) result (buffer-read-only nil)) @@ -4732,7 +4739,7 @@ If given a prefix, show the hidden text instead." (gnus-check-group-server)) (when (gnus-request-article article group (current-buffer)) (when (numberp article) - (gnus-async-prefetch-next group article + (gnus-async-prefetch-next group article gnus-summary-buffer) (when gnus-keep-backlog (gnus-backlog-enter-article @@ -5738,11 +5745,11 @@ For example: (defun gnus-article-encrypt-body (protocol &optional n) "Encrypt the article body." - (interactive + (interactive (list (or gnus-article-encrypt-protocol (completing-read "Encrypt protocol: " - gnus-article-encrypt-protocol-alist + gnus-article-encrypt-protocol-alist nil t)) current-prefix-arg)) (let ((func (cdr (assoc protocol gnus-article-encrypt-protocol-alist)))) @@ -5769,7 +5776,7 @@ For example: (let* ((buffer-read-only nil) (headers (mapcar (lambda (field) - (and (save-restriction + (and (save-restriction (message-narrow-to-head) (goto-char (point-min)) (search-forward field nil t)) @@ -5847,7 +5854,7 @@ For example: (mm-remove-parts (cdr handle)) (let ((region (mm-handle-multipart-ctl-parameter handle 'gnus-region)) buffer-read-only) - (when region + (when region (delete-region (car region) (cdr region)) (set-marker (car region) nil) (set-marker (cdr region) nil))) @@ -5868,7 +5875,7 @@ For example: (if details (if gnus-mime-security-show-details-inline (let ((gnus-mime-security-button-pressed t) - (gnus-mime-security-button-line-format + (gnus-mime-security-button-line-format (get-text-property (point) 'gnus-line-format)) buffer-read-only) (forward-char -1) @@ -5877,9 +5884,9 @@ For example: (forward-char -1)) (forward-char) (delete-region (point) - (or (text-property-not-all + (or (text-property-not-all (point) (point-max) - 'gnus-line-format + 'gnus-line-format gnus-mime-security-button-line-format) (point-max))) (gnus-insert-mime-security-button handle)) @@ -5903,7 +5910,7 @@ For example: (defun gnus-insert-mime-security-button (handle &optional displayed) (let* ((protocol (mm-handle-multipart-ctl-parameter handle 'protocol)) (gnus-tmp-type - (concat + (concat (or (nth 2 (assoc protocol mm-verify-function-alist)) (nth 2 (assoc protocol mm-decrypt-function-alist)) "Unknown") @@ -5920,20 +5927,20 @@ For example: (setq gnus-tmp-details (if gnus-tmp-details (concat "\n" gnus-tmp-details) "")) - (setq gnus-tmp-pressed-details + (setq gnus-tmp-pressed-details (if gnus-mime-security-button-pressed gnus-tmp-details "")) (unless (bolp) (insert "\n")) (setq b (point)) (gnus-eval-format - gnus-mime-security-button-line-format + gnus-mime-security-button-line-format gnus-mime-security-button-line-format-alist `(keymap ,gnus-mime-security-button-map ,@(if (>= (string-to-number emacs-version) 21) nil ;; XEmacs doesn't care (list 'local-map gnus-mime-security-button-map)) gnus-callback gnus-mime-security-press-button - gnus-line-format ,gnus-mime-security-button-line-format + gnus-line-format ,gnus-mime-security-button-line-format article-type annotation gnus-data ,handle)) (setq e (point)) @@ -5959,11 +5966,11 @@ For example: (gnus-mime-display-mixed (cdr handle)) (unless (bolp) (insert "\n")) - (let ((gnus-mime-security-button-line-format + (let ((gnus-mime-security-button-line-format gnus-mime-security-button-end-line-format)) (gnus-insert-mime-security-button handle)) (mm-set-handle-multipart-parameter - handle 'gnus-region + handle 'gnus-region (cons (set-marker (make-marker) (point-min)) (set-marker (make-marker) (point-max)))))) diff --git a/lisp/gnus-group.el b/lisp/gnus-group.el index f10f27d..7e6f7ba 100644 --- a/lisp/gnus-group.el +++ b/lisp/gnus-group.el @@ -207,6 +207,11 @@ with some simple extensions: :options '(gnus-topic-mode) :type 'hook) +;; Extracted from gnus-xmas-redefine in order to preserve user settings +(when (featurep 'xemacs) + (add-hook 'gnus-group-mode-hook 'gnus-xmas-group-menu-add) + (add-hook 'gnus-group-mode-hook 'gnus-xmas-setup-group-toolbar)) + (defcustom gnus-group-menu-hook nil "Hook run after the creation of the group mode menu." :group 'gnus-group-various @@ -1002,7 +1007,7 @@ The following commands are available: (let ((item (assoc method gnus-group-name-charset-method-alist)) (alist gnus-group-name-charset-group-alist) result) - (if item + (if item (cdr item) (while (setq item (pop alist)) (if (string-match (car item) group) @@ -1096,7 +1101,7 @@ If ALL (the prefix), also list groups that have no unread articles." (or (and gnus-group-listed-groups (null gnus-group-list-option) (member group gnus-group-listed-groups)) - (cond + (cond ((null gnus-group-listed-groups) test) ((null gnus-group-list-option) test) (t (and (member group gnus-group-listed-groups) @@ -1128,10 +1133,10 @@ if it is a string, only list groups matching REGEXP." params (gnus-info-params info) newsrc (cdr newsrc) unread (car (gnus-gethash group gnus-newsrc-hashtb))) - (if not-in-list + (if not-in-list (setq not-in-list (delete group not-in-list))) - (and - (gnus-group-prepare-logic + (and + (gnus-group-prepare-logic group (and unread ; This group might be unchecked (or (not (stringp regexp)) @@ -1145,9 +1150,9 @@ if it is a string, only list groups matching REGEXP." (t (or (if (eq unread t) ; Unactivated? - gnus-group-list-inactive-groups + gnus-group-list-inactive-groups ; We list unactivated - (> unread 0)) + (> unread 0)) ; We list groups with unread articles (and gnus-list-groups-with-ticked-articles (cdr (assq 'tick (gnus-info-marks info)))) @@ -1160,22 +1165,22 @@ if it is a string, only list groups matching REGEXP." (gnus-group-insert-group-line group (gnus-info-level info) (gnus-info-marks info) unread (gnus-info-method info))))) - + ;; List dead groups. (if (or gnus-group-listed-groups - (and (>= level gnus-level-zombie) + (and (>= level gnus-level-zombie) (<= lowest gnus-level-zombie))) (gnus-group-prepare-flat-list-dead (setq gnus-zombie-list (sort gnus-zombie-list 'string<)) gnus-level-zombie ?Z regexp)) - (if not-in-list + (if not-in-list (dolist (group gnus-zombie-list) (setq not-in-list (delete group not-in-list)))) (if (or gnus-group-listed-groups (and (>= level gnus-level-killed) (<= lowest gnus-level-killed))) (gnus-group-prepare-flat-list-dead - (gnus-union + (gnus-union not-in-list (setq gnus-killed-list (sort gnus-killed-list 'string<))) gnus-level-killed ?K regexp)) @@ -1192,7 +1197,7 @@ if it is a string, only list groups matching REGEXP." (let (group) (while groups (setq group (pop groups)) - (when (gnus-group-prepare-logic + (when (gnus-group-prepare-logic group (or (not regexp) (and (stringp regexp) (string-match regexp group)) @@ -1200,14 +1205,14 @@ if it is a string, only list groups matching REGEXP." ;;; (gnus-add-text-properties ;;; (point) (prog1 (1+ (point)) ;;; (insert " " mark " *: " -;;; (gnus-group-name-decode group +;;; (gnus-group-name-decode group ;;; (gnus-group-name-charset -;;; nil group)) +;;; nil group)) ;;; "\n")) ;;; (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb) ;;; 'gnus-unread t ;;; 'gnus-level level)) - (gnus-group-insert-group-line + (gnus-group-insert-group-line group level nil (let ((active (gnus-active group))) (if active @@ -1265,7 +1270,7 @@ if it is a string, only list groups matching REGEXP." gnus-tmp-method) "Insert a group line in the group buffer." (let* ((gnus-tmp-method - (gnus-server-get-method gnus-tmp-group gnus-tmp-method)) + (gnus-server-get-method gnus-tmp-group gnus-tmp-method)) (group-name-charset (gnus-group-name-charset gnus-tmp-method gnus-tmp-group)) (gnus-tmp-active (gnus-active gnus-tmp-group)) @@ -1285,13 +1290,13 @@ if it is a string, only list groups matching REGEXP." ((<= gnus-tmp-level gnus-level-unsubscribed) ?U) ((= gnus-tmp-level gnus-level-zombie) ?Z) (t ?K))) - (gnus-tmp-qualified-group + (gnus-tmp-qualified-group (gnus-group-name-decode (gnus-group-real-name gnus-tmp-group) group-name-charset)) (gnus-tmp-newsgroup-description (if gnus-description-hashtb (or (gnus-group-name-decode - (gnus-gethash gnus-tmp-group gnus-description-hashtb) + (gnus-gethash gnus-tmp-group gnus-description-hashtb) group-name-charset) "") "")) (gnus-tmp-moderated @@ -1937,11 +1942,11 @@ If TEST-MARKED, the line must be marked." (test-marked (goto-char (point-min)) (let (found) - (while (and (not found) + (while (and (not found) (gnus-goto-char (text-property-any (point) (point-max) - 'gnus-group + 'gnus-group (gnus-intern-safe group gnus-active-hashtb)))) (if (gnus-group-mark-line-p) (setq found t) @@ -2405,7 +2410,7 @@ If SOLID (the prefix), create a solid group." default-login 'gnus-group-warchive-login-history) user-mail-address)) (method - `(nnwarchive ,address + `(nnwarchive ,address (nnwarchive-type ,(intern type)) (nnwarchive-login ,login)))) (gnus-group-make-group group method))) @@ -3313,7 +3318,7 @@ entail asking the server for the groups." (gnus-add-text-properties (point) (prog1 (1+ (point)) (insert " *: " - (gnus-group-name-decode group + (gnus-group-name-decode group (gnus-group-name-charset nil group)) "\n")) @@ -3479,7 +3484,7 @@ to use." (lambda (group) (setq b (point)) (let ((charset (gnus-group-name-charset nil (symbol-name group)))) - (insert (format " *: %-20s %s\n" + (insert (format " *: %-20s %s\n" (gnus-group-name-decode (symbol-name group) charset) (gnus-group-name-decode @@ -3873,18 +3878,18 @@ This command may read the active file." (setq level (prefix-numeric-value level))) (when (or (not level) (>= level gnus-level-zombie)) (gnus-cache-open)) - (funcall gnus-group-prepare-function + (funcall gnus-group-prepare-function (or level gnus-level-subscribed) #'(lambda (info) (let ((marks (gnus-info-marks info))) (assq 'cache marks))) lowest #'(lambda (group) - (or (gnus-gethash group + (or (gnus-gethash group gnus-cache-active-hashtb) - ;; Cache active file might use "." + ;; Cache active file might use "." ;; instead of ":". - (gnus-gethash + (gnus-gethash (mapconcat 'identity (split-string group ":") ".") @@ -3904,7 +3909,7 @@ This command may read the active file." (setq level (prefix-numeric-value level))) (when (or (not level) (>= level gnus-level-zombie)) (gnus-cache-open)) - (funcall gnus-group-prepare-function + (funcall gnus-group-prepare-function (or level gnus-level-subscribed) #'(lambda (info) (let ((marks (gnus-info-marks info))) @@ -3918,7 +3923,7 @@ This command may read the active file." "Return a list of listed groups." (let (point groups) (goto-char (point-min)) - (while (setq point (text-property-not-all (point) (point-max) + (while (setq point (text-property-not-all (point) (point-max) 'gnus-group nil)) (goto-char point) (push (symbol-name (get-text-property point 'gnus-group)) groups) diff --git a/lisp/gnus-salt.el b/lisp/gnus-salt.el index dd2aa1f..2a6acc9 100644 --- a/lisp/gnus-salt.el +++ b/lisp/gnus-salt.el @@ -36,7 +36,8 @@ ;;; (defvar gnus-pick-mode nil - "Minor mode for providing a pick-and-read interface in Gnus summary buffers.") + "Minor mode for providing a pick-and-read interface in Gnus +summary buffers.") (defcustom gnus-pick-display-summary nil "*Display summary while reading." @@ -48,13 +49,17 @@ :type 'hook :group 'gnus-summary-pick) +(when (featurep 'xemacs) + (add-hook 'gnus-pick-mode-hook 'gnus-xmas-pick-menu-add)) + (defcustom gnus-mark-unpicked-articles-as-read nil "*If non-nil, mark all unpicked articles as read." :type 'boolean :group 'gnus-summary-pick) (defcustom gnus-pick-elegant-flow t - "If non-nil, `gnus-pick-start-reading' runs `gnus-summary-next-group' when no articles have been picked." + "If non-nil, `gnus-pick-start-reading' runs + `gnus-summary-next-group' when no articles have been picked." :type 'boolean :group 'gnus-summary-pick) @@ -418,6 +423,11 @@ Two predefined functions are available: :type 'hook :group 'gnus-summary-tree) +(when (featurep 'xemacs) + (add-hook 'gnus-tree-mode-hook 'gnus-xmas-tree-menu-add) + (add-hook 'gnus-tree-mode-hook 'gnus-xmas-switch-horizontal-scrollbar-off)) + + ;;; Internal variables. (defvar gnus-tree-line-format-alist diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el index 86366ae..e929794 100644 --- a/lisp/gnus-sum.el +++ b/lisp/gnus-sum.el @@ -678,6 +678,13 @@ This hook is run before any variables are set in the summary buffer." :group 'gnus-summary-various :type 'hook) +;; Extracted from gnus-xmas-redefine in order to preserve user settings +(when (featurep 'xemacs) + (add-hook 'gnus-summary-mode-hook 'gnus-xmas-summary-menu-add) + (add-hook 'gnus-summary-mode-hook 'gnus-xmas-setup-summary-toolbar) + (add-hook 'gnus-summary-mode-hook + 'gnus-xmas-switch-horizontal-scrollbar-off)) + (defcustom gnus-summary-menu-hook nil "*Hook run after the creation of the summary mode menu." :group 'gnus-summary-visual @@ -3840,8 +3847,8 @@ If LINE, insert the rebuilt thread starting on line LINE." threads (gnus-message 8 "Sorting threads...") (prog1 - (gnus-sort-threads-1 - threads + (gnus-sort-threads-1 + threads (gnus-make-sort-function gnus-thread-sort-functions)) (gnus-message 8 "Sorting threads...done")))) @@ -7144,8 +7151,8 @@ to guess what the document format is." ;; the parent article. (when (setq to-address (or (message-fetch-field "reply-to") (message-fetch-field "from"))) - (setq params (append - (list (cons 'to-address + (setq params (append + (list (cons 'to-address (funcall gnus-decode-encoded-word-function to-address)))))) (setq dig (nnheader-set-temp-buffer " *gnus digest buffer*")) @@ -8219,7 +8226,7 @@ groups." (let ((buf (current-buffer))) (with-temp-buffer (insert-buffer-substring buf) - + (if (and (not read-only) (not (gnus-request-replace-article (cdr gnus-article-current) (car gnus-article-current) @@ -8427,7 +8434,7 @@ the actual number of articles unmarked is returned." ;;; !!! This is bobus. We should find out what primary ;;; !!! mark we want to set. (gnus-summary-update-mark gnus-del-mark 'unread))))) - + (defun gnus-summary-mark-as-expirable (n) "Mark N articles forward as expirable. If N is negative, mark backward instead. The difference between N and @@ -9588,12 +9595,12 @@ save those articles instead." "Save parts matching TYPE to DIR. If REVERSE, save parts that do not match TYPE." (interactive - (list (read-string "Save parts of type: " + (list (read-string "Save parts of type: " (or (car gnus-summary-save-parts-type-history) gnus-summary-save-parts-default-mime) 'gnus-summary-save-parts-type-history) (setq gnus-summary-save-parts-last-directory - (read-file-name "Save to directory: " + (read-file-name "Save to directory: " gnus-summary-save-parts-last-directory nil t)) current-prefix-arg)) @@ -9936,7 +9943,7 @@ If REVERSE, save parts that do not match TYPE." `(progn (gnus-info-set-marks ',info ',(gnus-info-marks info) t) (gnus-info-set-read ',info ',(gnus-info-read info)) - (gnus-get-unread-articles-in-group ',info + (gnus-get-unread-articles-in-group ',info (gnus-active ,group)) (gnus-group-update-group ,group t) ,setmarkundo)))) diff --git a/lisp/gnus-topic.el b/lisp/gnus-topic.el index 7420265..3294b22 100644 --- a/lisp/gnus-topic.el +++ b/lisp/gnus-topic.el @@ -47,6 +47,9 @@ :type 'hook :group 'gnus-topic) +(when (featurep 'xemacs) + (add-hook 'gnus-topic-mode-hook 'gnus-xmas-topic-menu-add)) + (defcustom gnus-topic-line-format "%i[ %(%{%n%}%) -- %A ]%v\n" "Format of topic lines. It works along the same lines as a normal formatting string, @@ -164,7 +167,7 @@ with some simple extensions. (dolist (topic (gnus-current-topics topic)) (gnus-topic-fold t)) (gnus-topic-goto-topic topic)) - + (defun gnus-current-topic () "Return the name of the current topic." (let ((result @@ -234,14 +237,14 @@ If RECURSIVE is t, return groups in its subtopics too." ;; Add this group to the list of visible groups. (push (or entry group) visible-groups))) (setq visible-groups (nreverse visible-groups)) - (when recursive + (when recursive (if (eq recursive t) (setq recursive (cdr (gnus-topic-find-topology topic)))) (mapcar (lambda (topic-topology) - (setq visible-groups - (nconc visible-groups + (setq visible-groups + (nconc visible-groups (gnus-topic-find-groups - (caar topic-topology) + (caar topic-topology) level all lowest topic-topology)))) (cdr recursive))) visible-groups)) @@ -395,7 +398,7 @@ If LOWEST is non-nil, list all newsgroups of level LOWEST or higher." (set-buffer gnus-group-buffer) (let ((buffer-read-only nil) (lowest (or lowest 1)) - (not-in-list + (not-in-list (and gnus-group-listed-groups (copy-sequence gnus-group-listed-groups)))) @@ -416,11 +419,11 @@ If LOWEST is non-nil, list all newsgroups of level LOWEST or higher." regexp)) (when (or gnus-group-listed-groups - (and (>= level gnus-level-killed) + (and (>= level gnus-level-killed) (<= lowest gnus-level-killed))) (gnus-group-prepare-flat-list-dead (gnus-union - (and not-in-list + (and not-in-list (gnus-delete-if (lambda (group) (< (gnus-group-level group) gnus-level-killed)) not-in-list)) @@ -444,7 +447,7 @@ If LOWEST is non-nil, list all newsgroups of level LOWEST or higher." (setq gnus-group-list-mode (cons level predicate)) (gnus-run-hooks 'gnus-group-prepare-hook)))) -(defun gnus-topic-prepare-topic (topicl level &optional list-level +(defun gnus-topic-prepare-topic (topicl level &optional list-level predicate silent lowest regexp) "Insert TOPIC into the group buffer. @@ -452,8 +455,8 @@ If SILENT, don't insert anything. Return the number of unread articles in the topic and its subtopics." (let* ((type (pop topicl)) (entries (gnus-topic-find-groups - (car type) - (if gnus-group-listed-groups + (car type) + (if gnus-group-listed-groups gnus-level-killed list-level) (or predicate gnus-group-listed-groups @@ -482,7 +485,7 @@ articles in the topic and its subtopics." ;; Insert all the groups that belong in this topic. (while (setq entry (pop entries)) (when (if (stringp entry) - (gnus-group-prepare-logic + (gnus-group-prepare-logic entry (and (or (not gnus-group-listed-groups) @@ -492,7 +495,7 @@ articles in the topic and its subtopics." gnus-level-zombie gnus-level-killed))) (and (<= entry-level list-level) (>= entry-level lowest))))) - (cond + (cond ((stringp regexp) (string-match regexp entry)) ((functionp regexp) @@ -500,7 +503,7 @@ articles in the topic and its subtopics." ((null regexp) t) (t nil)))) (setq info (nth 2 entry)) - (gnus-group-prepare-logic + (gnus-group-prepare-logic (gnus-info-group info) (and (or (not gnus-group-listed-groups) (let ((entry-level (gnus-info-level info))) @@ -1192,10 +1195,10 @@ When used interactively, PARENT will be the topic under point." (gnus-group-list-groups) (gnus-topic-goto-topic topic)) -;; FIXME: -;; 1. When the marked groups are overlapped with the process +;; FIXME: +;; 1. When the marked groups are overlapped with the process ;; region, the behavior of move or remove is not right. -;; 2. Can't process on several marked groups with a same name, +;; 2. Can't process on several marked groups with a same name, ;; because gnus-group-marked only keeps one copy. (defun gnus-topic-move-group (n topic &optional copyp) @@ -1204,7 +1207,7 @@ If COPYP, copy the groups instead." (interactive (list current-prefix-arg (completing-read "Move to topic: " gnus-topic-alist nil t))) - (let ((use-marked (and (not n) (not (gnus-region-active-p)) + (let ((use-marked (and (not n) (not (gnus-region-active-p)) gnus-group-marked t)) (groups (gnus-group-process-prefix n)) (topicl (assoc topic gnus-topic-alist)) @@ -1231,7 +1234,7 @@ If COPYP, copy the groups instead." (defun gnus-topic-remove-group (&optional n) "Remove the current group from the topic." (interactive "P") - (let ((use-marked (and (not n) (not (gnus-region-active-p)) + (let ((use-marked (and (not n) (not (gnus-region-active-p)) gnus-group-marked t)) (groups (gnus-group-process-prefix n))) (mapcar @@ -1329,7 +1332,7 @@ If PERMANENT, make it stay hidden in subsequent sessions as well." (when (gnus-current-topic) (gnus-topic-goto-topic (gnus-current-topic)) (if permanent - (setcar (cddr + (setcar (cddr (cadr (gnus-topic-find-topology (gnus-current-topic)))) 'hidden)) @@ -1342,8 +1345,8 @@ If PERMANENT, make it stay shown in subsequent sessions as well." (when (gnus-group-topic-p) (if (not permanent) (gnus-topic-remove-topic t nil) - (let ((topic - (gnus-topic-find-topology + (let ((topic + (gnus-topic-find-topology (completing-read "Show topic: " gnus-topic-alist nil t)))) (setcar (cddr (cadr topic)) nil) (setcar (cdr (cadr topic)) 'visible) @@ -1358,7 +1361,7 @@ If RECURSIVE is t, mark its subtopics too." (if (not topic) (call-interactively 'gnus-group-mark-group) (save-excursion - (let ((groups (gnus-topic-find-groups topic gnus-level-killed t nil + (let ((groups (gnus-topic-find-groups topic gnus-level-killed t nil recursive))) (while groups (funcall (if unmark 'gnus-group-remove-mark 'gnus-group-set-mark) @@ -1604,7 +1607,7 @@ If REVERSE, sort in reverse order." (mapcar `(lambda (top) (gnus-topic-sort-topics-1 top ,reverse)) (sort (cdr top) - '(lambda (t1 t2) + '(lambda (t1 t2) (string-lessp (caar t1) (caar t2))))))) (setcdr top (if reverse (reverse subtop) subtop)))) top) @@ -1612,8 +1615,8 @@ If REVERSE, sort in reverse order." (defun gnus-topic-sort-topics (&optional topic reverse) "Sort topics in TOPIC alphabeticaly by topic name. If REVERSE, reverse the sorting order." - (interactive - (list (completing-read "Sort topics in : " gnus-topic-alist nil t + (interactive + (list (completing-read "Sort topics in : " gnus-topic-alist nil t (gnus-current-topic)) current-prefix-arg)) (let ((topic-topology (or (and topic (cdr (gnus-topic-find-topology topic))) @@ -1625,8 +1628,8 @@ If REVERSE, reverse the sorting order." (defun gnus-topic-move (current to) "Move the CURRENT topic to TO." - (interactive - (list + (interactive + (list (gnus-group-topic-name) (completing-read "Move to topic: " gnus-topic-alist nil t))) (unless (and current to) @@ -1659,7 +1662,7 @@ If REVERSE, reverse the sorting order." ;; Add the group to the topic. (nconc (assoc topic gnus-topic-alist) (list newsgroup)) (throw 'end t)))))) - + (provide 'gnus-topic) ;;; gnus-topic.el ends here diff --git a/lisp/gnus-xmas.el b/lisp/gnus-xmas.el index aeafe0d..c6d584f 100644 --- a/lisp/gnus-xmas.el +++ b/lisp/gnus-xmas.el @@ -46,9 +46,10 @@ automatically." :group 'gnus-xmas) (unless gnus-xmas-glyph-directory - (unless (setq gnus-xmas-glyph-directory + (unless (setq gnus-xmas-glyph-directory (message-xmas-find-glyph-directory "gnus")) - (gnus-error 1 "Can't find glyph directory. Possibly the `etc' directory is not installed."))) + (error "Can't find glyph directory. \ +Possibly the `etc' directory has not been installed."))) ;;(format "%02x%02x%02x" 114 66 20) "724214" @@ -95,10 +96,6 @@ asynchronously. The compressed face will be piped to this command." ;; Don't warn about these undefined variables. -(defvar gnus-group-mode-hook) -(defvar gnus-summary-mode-hook) -(defvar gnus-article-mode-hook) - ;;defined in gnus.el (defvar gnus-active-hashtb) (defvar gnus-article-buffer) @@ -203,7 +200,7 @@ displayed, no centering will be performed." ;; whichever is the least. ;; NOFORCE parameter suggested by Daniel Pittman . (set-window-start - window (min bottom (save-excursion (forward-line (- top)) (point))) + window (min bottom (save-excursion (forward-line (- top)) (point))) t)) ;; Do horizontal recentering while we're at it. (when (and (get-buffer-window (current-buffer) t) @@ -437,9 +434,6 @@ call it with the value of the `gnus-data' text property." (< emacs-minor-version 14)) (defalias 'gnus-set-text-properties 'gnus-xmas-set-text-properties)) - (when (fboundp 'turn-off-scroll-in-place) - (add-hook 'gnus-article-mode-hook 'turn-off-scroll-in-place)) - (unless (boundp 'standard-display-table) (setq standard-display-table nil)) @@ -481,30 +475,17 @@ call it with the value of the `gnus-data' text property." (defalias 'gnus-annotation-in-region-p 'gnus-xmas-annotation-in-region-p) (defalias 'gnus-mime-button-menu 'gnus-xmas-mime-button-menu) - (add-hook 'gnus-group-mode-hook 'gnus-xmas-group-menu-add) - (add-hook 'gnus-summary-mode-hook 'gnus-xmas-summary-menu-add) - (add-hook 'gnus-article-mode-hook 'gnus-xmas-article-menu-add) + ;; These ones are not defcutom'ed, sometimes not even defvar'ed. They + ;; probably should. If that is done, the code below should then be moved + ;; where each variable is defined, in order not to mess with user settings. + ;; -- didier (add-hook 'gnus-score-mode-hook 'gnus-xmas-score-menu-add) - - (add-hook 'gnus-pick-mode-hook 'gnus-xmas-pick-menu-add) - (add-hook 'gnus-topic-mode-hook 'gnus-xmas-topic-menu-add) - (add-hook 'gnus-tree-mode-hook 'gnus-xmas-tree-menu-add) (add-hook 'gnus-binary-mode-hook 'gnus-xmas-binary-menu-add) (add-hook 'gnus-grouplens-mode-hook 'gnus-xmas-grouplens-menu-add) (add-hook 'gnus-server-mode-hook 'gnus-xmas-server-menu-add) (add-hook 'gnus-browse-mode-hook 'gnus-xmas-browse-menu-add) - - (add-hook 'gnus-group-mode-hook 'gnus-xmas-setup-group-toolbar) - (add-hook 'gnus-summary-mode-hook 'gnus-xmas-setup-summary-toolbar) - - (add-hook 'gnus-agent-summary-mode-hook 'gnus-xmas-agent-summary-menu-add) - (add-hook 'gnus-agent-group-mode-hook 'gnus-xmas-agent-group-menu-add) - (add-hook 'gnus-agent-server-mode-hook 'gnus-xmas-agent-server-menu-add) - (add-hook 'gnus-draft-mode-hook 'gnus-xmas-draft-menu-add) - (add-hook 'gnus-summary-mode-hook - 'gnus-xmas-switch-horizontal-scrollbar-off) - (add-hook 'gnus-tree-mode-hook 'gnus-xmas-switch-horizontal-scrollbar-off) + (add-hook 'gnus-mailing-list-mode-hook 'gnus-xmas-mailing-list-menu-add) (when (featurep 'mule) (defun gnus-truncate-string (str end-column &optional start-column padding) @@ -973,8 +954,6 @@ XEmacs compatibility workaround." (gnus-xmas-menu-add mailing-list gnus-mailing-list-menu)) -(add-hook 'gnus-mailing-list-mode-hook 'gnus-xmas-mailing-list-menu-add) - (provide 'gnus-xmas) ;;; gnus-xmas.el ends here -- 1.7.10.4