X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fgnus-sum.el;h=7846ca6da9be4e6e56a0c5cb109f247ff0536f37;hb=36bd162f4f7cd40453b8683e796730836c352b2a;hp=a4f426dfb597eb19a1dd674dd70bd78008218d02;hpb=ff5c531af3b8824765adf0b67d9784b50360287c;p=elisp%2Fgnus.git- diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el index a4f426d..7846ca6 100644 --- a/lisp/gnus-sum.el +++ b/lisp/gnus-sum.el @@ -48,7 +48,6 @@ (require 'static)) (eval-and-compile - (autoload 'gnus-cache-articles-in-group "gnus-cache") (autoload 'pgg-decrypt-region "pgg" nil t) (autoload 'pgg-verify-region "pgg" nil t)) @@ -403,7 +402,7 @@ this variable specifies group names." (cons :value ("" "") regexp (repeat string)) (sexp :value nil)))) -(defcustom gnus-unread-mark ? ;Whitespace +(defcustom gnus-unread-mark ?\ ;;;Whitespace "*Mark used for unread articles." :group 'gnus-summary-marks :type 'character) @@ -463,22 +462,32 @@ this variable specifies group names." :group 'gnus-summary-marks :type 'character) -(defcustom gnus-forwarded-mark ?O +(defcustom gnus-forwarded-mark ?F "*Mark used for articles that have been forwarded." :group 'gnus-summary-marks :type 'character) +(defcustom gnus-recent-mark ?N + "*Mark used for articles that are recent." + :group 'gnus-summary-marks + :type 'character) + (defcustom gnus-cached-mark ?* "*Mark used for articles that are in the cache." :group 'gnus-summary-marks :type 'character) (defcustom gnus-saved-mark ?S - "*Mark used for articles that have been saved to." + "*Mark used for articles that have been saved." + :group 'gnus-summary-marks + :type 'character) + +(defcustom gnus-unseen-mark ?. + "*Mark used for articles that haven't been seen." :group 'gnus-summary-marks :type 'character) -(defcustom gnus-no-mark ? ;Whitespace +(defcustom gnus-no-mark ?\ ;;;Whitespace "*Mark used for articles that have no other secondary mark." :group 'gnus-summary-marks :type 'character) @@ -528,7 +537,7 @@ this variable specifies group names." :group 'gnus-summary-marks :type 'character) -(defcustom gnus-empty-thread-mark ? ;Whitespace +(defcustom gnus-empty-thread-mark ?\ ;;;Whitespace "*There is no thread under the article." :group 'gnus-summary-marks :type 'character) @@ -715,7 +724,7 @@ This variable is local to the summary buffers." (defcustom gnus-summary-mode-hook nil "*A hook for Gnus summary mode. This hook is run before any variables are set in the summary buffer." - :options '(turn-on-gnus-mailing-list-mode) + :options '(turn-on-gnus-mailing-list-mode gnus-pick-mode) :group 'gnus-summary-various :type 'hook) @@ -826,6 +835,14 @@ automatically when it is selected." :group 'gnus-summary :type 'hook) +(defcustom gnus-summary-display-arrow + (and (fboundp 'display-graphic-p) + (display-graphic-p)) + "*If non-nil, display an arrow highlighting the current article." + :version "21.1" + :group 'gnus-summary + :type 'boolean) + (defcustom gnus-summary-selected-face 'gnus-summary-selected-face "Face used for highlighting the current article in the summary buffer." :group 'gnus-summary-visual @@ -858,10 +875,10 @@ automatically when it is selected." ((= mark gnus-unread-mark) . gnus-summary-normal-unread-face) ((and (> score default-high) (memq mark (list gnus-downloadable-mark - gnus-undownloaded-mark))) + gnus-undownloaded-mark))) . gnus-summary-high-unread-face) ((and (< score default-low) (memq mark (list gnus-downloadable-mark - gnus-undownloaded-mark))) + gnus-undownloaded-mark))) . gnus-summary-low-unread-face) ((and (memq mark (list gnus-downloadable-mark gnus-undownloaded-mark)) (memq article gnus-newsgroup-unreads)) @@ -929,7 +946,7 @@ default charset will be used instead." :function-document "Return the ignored charsets of GROUP." :variable gnus-group-ignored-charsets-alist - :variable-default + :variable-default '(("alt\\.chinese\\.text" iso-8859-1)) :variable-document "Alist of regexps (to match group names) and charsets that should be ignored. @@ -938,7 +955,7 @@ default charset will be used instead." :variable-group gnus-charset :variable-type '(repeat (cons (regexp :tag "Group") (repeat symbol))) - :parameter-type '(choice :tag "Ignored charsets" + :parameter-type '(choice :tag "Ignored charsets" :value nil (repeat (symbol))) :parameter-document "\ @@ -1029,8 +1046,14 @@ that were fetched. Say, for nnultimate groups." :group 'gnus-summary :type '(choice boolean regexp)) +(defcustom gnus-summary-muttprint-program "muttprint" + "Command (and optional arguments) used to run Muttprint." + :group 'gnus-summary + :type 'string) + ;;; Internal variables +(defvar gnus-summary-display-cache nil) (defvar gnus-article-mime-handles nil) (defvar gnus-article-decoded-p nil) (defvar gnus-article-charset nil) @@ -1063,6 +1086,7 @@ that were fetched. Say, for nnultimate groups." (defvar gnus-current-move-group nil) (defvar gnus-current-copy-group nil) (defvar gnus-current-crosspost-group nil) +(defvar gnus-newsgroup-display nil) (defvar gnus-newsgroup-dependencies nil) (defvar gnus-newsgroup-adaptive nil) @@ -1101,7 +1125,8 @@ that were fetched. Say, for nnultimate groups." (?l (bbb-grouplens-score gnus-tmp-header) ?s) (?V (gnus-thread-total-score (and (boundp 'thread) (car thread))) ?d) (?U gnus-tmp-unread ?c) - (?f (gnus-summary-from-or-to-or-newsgroups gnus-tmp-header) ?s) + (?f (gnus-summary-from-or-to-or-newsgroups gnus-tmp-header gnus-tmp-from) + ?s) (?t (gnus-summary-number-of-articles-in-thread (and (boundp 'thread) (car thread)) gnus-tmp-level) ?d) @@ -1109,7 +1134,10 @@ that were fetched. Say, for nnultimate groups." (and (boundp 'thread) (car thread)) gnus-tmp-level t) ?c) (?u gnus-tmp-user-defined ?s) - (?P (gnus-pick-line-number) ?d)) + (?P (gnus-pick-line-number) ?d) + (?B gnus-tmp-thread-tree-header-string ?s) + (user-date (gnus-user-date + ,(macroexpand '(mail-header-date gnus-tmp-header))) ?s)) "An alist of format specifications that can appear in summary lines. These are paired with what variables they correspond with, along with the type of the variable (string, integer, character, etc).") @@ -1193,6 +1221,9 @@ end position and text.") (defvar gnus-newsgroup-forwarded nil "List of articles that have been forwarded in the current newsgroup.") +(defvar gnus-newsgroup-recent nil + "List of articles that have are recent in the current newsgroup.") + (defvar gnus-newsgroup-expirable nil "List of articles in the current newsgroup that can be expired.") @@ -1214,6 +1245,15 @@ end position and text.") (defvar gnus-newsgroup-dormant nil "List of dormant articles in the current newsgroup.") +(defvar gnus-newsgroup-unseen nil + "List of unseen articles in the current newsgroup.") + +(defvar gnus-newsgroup-seen nil + "Range of seen articles in the current newsgroup.") + +(defvar gnus-newsgroup-articles nil + "List of articles in the current newsgroup.") + (defvar gnus-newsgroup-scored nil "List of scored articles in the current newsgroup.") @@ -1254,10 +1294,12 @@ end position and text.") gnus-newsgroup-unselected gnus-newsgroup-marked gnus-newsgroup-reads gnus-newsgroup-saved gnus-newsgroup-replied gnus-newsgroup-forwarded + gnus-newsgroup-recent gnus-newsgroup-expirable gnus-newsgroup-processable gnus-newsgroup-killed gnus-newsgroup-downloadable gnus-newsgroup-undownloaded - gnus-newsgroup-unsendable + gnus-newsgroup-unsendable gnus-newsgroup-unseen + gnus-newsgroup-seen gnus-newsgroup-articles gnus-newsgroup-bookmarks gnus-newsgroup-dormant gnus-newsgroup-headers gnus-newsgroup-threads gnus-newsgroup-prepared gnus-summary-highlight-line-function @@ -1279,12 +1321,24 @@ end position and text.") gnus-cache-removable-articles gnus-newsgroup-cached gnus-newsgroup-data gnus-newsgroup-data-reverse gnus-newsgroup-limit gnus-newsgroup-limits - gnus-newsgroup-charset + gnus-newsgroup-charset gnus-newsgroup-display gnus-newsgroup-incorporated) "Variables that are buffer-local to the summary buffers.") (defvar gnus-newsgroup-variables nil - "Variables that have separate values in the newsgroups.") + "A list of variables that have separate values in different newsgroups. +A list of newsgroup (summary buffer) local variables, or cons of +variables and their default values (when the default values are not +nil), that should be made global while the summary buffer is active. +These variables can be used to set variables in the group parameters +while still allowing them to affect operations done in other +buffers. For example: + +\(setq gnus-newsgroup-variables + '(message-use-followup-to + (gnus-visible-headers . + \"^From:\\\\|^Newsgroups:\\\\|^Subject:\\\\|^Date:\\\\|^To:\"))) +") ;; Byte-compiler warning. (eval-when-compile (defvar gnus-article-mode-map)) @@ -1297,8 +1351,8 @@ end position and text.") ;; Multiple spaces. (while (string-match "[ \t][ \t]+" mystr) (setq mystr (concat (substring mystr 0 (match-beginning 0)) - " " - (substring mystr (match-end 0))))) + " " + (substring mystr (match-end 0))))) ;; Leading spaces. (when (string-match "^[ \t]+" mystr) (setq mystr (substring mystr (match-end 0)))) @@ -1514,6 +1568,7 @@ increase the score of each group you read." gnus-mouse-2 gnus-mouse-pick-article "m" gnus-summary-mail-other-window "a" gnus-summary-post-news + "i" gnus-summary-news-other-window "x" gnus-summary-limit-to-unread "s" gnus-summary-isearch-article "t" gnus-article-toggle-headers @@ -1526,6 +1581,7 @@ increase the score of each group you read." "\M-\C-e" gnus-summary-edit-parameters "\M-\C-a" gnus-summary-customize-parameters "\C-c\C-b" gnus-bug + "\C-c\C-n" gnus-namazu-search "*" gnus-cache-enter-article "\M-*" gnus-cache-remove-article "\M-&" gnus-summary-universal-argument @@ -1585,6 +1641,7 @@ increase the score of each group you read." "d" gnus-summary-limit-exclude-dormant "t" gnus-summary-limit-to-age "x" gnus-summary-limit-to-extra + "p" gnus-summary-limit-to-display-predicate "E" gnus-summary-limit-include-expunged "c" gnus-summary-limit-exclude-childless-dormant "C" gnus-summary-limit-mark-excluded-as-read @@ -1681,12 +1738,12 @@ increase the score of each group you read." "l" gnus-summary-stop-page-breaking "r" gnus-summary-caesar-message "t" gnus-article-toggle-headers + "g" gnus-summary-toggle-smiley "v" gnus-summary-verbose-headers "m" gnus-summary-toggle-mime "a" gnus-article-strip-headers-in-body ;; mnemonic: wash archive "p" gnus-article-verify-x-pgp-sig - "d" gnus-article-treat-dumbquotes - "s" gnus-smiley-display) + "d" gnus-article-treat-dumbquotes) (gnus-define-keys (gnus-summary-wash-hide-map "W" gnus-summary-wash-map) "a" gnus-article-hide @@ -1761,6 +1818,7 @@ increase the score of each group you read." "h" gnus-summary-save-article-folder "v" gnus-summary-save-article-vm "p" gnus-summary-pipe-output + "P" gnus-summary-muttprint "s" gnus-soup-add-article) (gnus-define-keys (gnus-summary-mime-map "K" gnus-summary-mode-map) @@ -1812,131 +1870,133 @@ increase the score of each group you read." ;; Define both the Article menu in the summary buffer and the equivalent ;; Commands menu in the article buffer here for consistency. (let ((innards - `(("Hide" - ["All" gnus-article-hide t] - ["Headers" gnus-article-toggle-headers t] - ["Signature" gnus-article-hide-signature t] - ["Citation" gnus-article-hide-citation t] + `(("Hide" + ["All" gnus-article-hide t] + ["Headers" gnus-article-toggle-headers t] + ["Signature" gnus-article-hide-signature t] + ["Citation" gnus-article-hide-citation t] ["List identifiers" gnus-article-hide-list-identifiers t] - ["PGP" gnus-article-hide-pgp t] + ["PGP" gnus-article-hide-pgp t] ["Banner" gnus-article-strip-banner t] - ["Boring headers" gnus-article-hide-boring-headers t]) - ("Highlight" - ["All" gnus-article-highlight t] - ["Headers" gnus-article-highlight-headers t] - ["Signature" gnus-article-highlight-signature t] - ["Citation" gnus-article-highlight-citation t]) - ("Date" - ["Local" gnus-article-date-local t] - ["ISO8601" gnus-article-date-iso8601 t] - ["UT" gnus-article-date-ut t] - ["Original" gnus-article-date-original t] - ["Lapsed" gnus-article-date-lapsed t] - ["User-defined" gnus-article-date-user t]) - ("Washing" - ("Remove Blanks" - ["Leading" gnus-article-strip-leading-blank-lines t] - ["Multiple" gnus-article-strip-multiple-blank-lines t] - ["Trailing" gnus-article-remove-trailing-blank-lines t] - ["All of the above" gnus-article-strip-blank-lines t] - ["All" gnus-article-strip-all-blank-lines t] - ["Leading space" gnus-article-strip-leading-space t] + ["Boring headers" gnus-article-hide-boring-headers t]) + ("Highlight" + ["All" gnus-article-highlight t] + ["Headers" gnus-article-highlight-headers t] + ["Signature" gnus-article-highlight-signature t] + ["Citation" gnus-article-highlight-citation t]) + ("Date" + ["Local" gnus-article-date-local t] + ["ISO8601" gnus-article-date-iso8601 t] + ["UT" gnus-article-date-ut t] + ["Original" gnus-article-date-original t] + ["Lapsed" gnus-article-date-lapsed t] + ["User-defined" gnus-article-date-user t]) + ("Washing" + ("Remove Blanks" + ["Leading" gnus-article-strip-leading-blank-lines t] + ["Multiple" gnus-article-strip-multiple-blank-lines t] + ["Trailing" gnus-article-remove-trailing-blank-lines t] + ["All of the above" gnus-article-strip-blank-lines t] + ["All" gnus-article-strip-all-blank-lines t] + ["Leading space" gnus-article-strip-leading-space t] ["Trailing space" gnus-article-strip-trailing-space t] - ["Leading space in headers" + ["Leading space in headers" gnus-article-remove-leading-whitespace t]) - ["Overstrike" gnus-article-treat-overstrike t] - ["Dumb quotes" gnus-article-treat-dumbquotes t] - ["Emphasis" gnus-article-emphasize t] - ["Word wrap" gnus-article-fill-cited-article t] + ["Overstrike" gnus-article-treat-overstrike t] + ["Dumb quotes" gnus-article-treat-dumbquotes t] + ["Emphasis" gnus-article-emphasize t] + ["Word wrap" gnus-article-fill-cited-article t] ["Fill long lines" gnus-article-fill-long-lines t] ["Capitalize sentences" gnus-article-capitalize-sentences t] - ["CR" gnus-article-remove-cr t] - ["Show X-Face" gnus-article-display-x-face t] + ["CR" gnus-article-remove-cr t] + ["Show X-Face" gnus-article-display-x-face t] ["Rot 13" gnus-summary-caesar-message ,@(if (featurep 'xemacs) '(t) '(:help "\"Caesar rotate\" article by 13"))] - ["Unix pipe" gnus-summary-pipe-message t] - ["Add buttons" gnus-article-add-buttons t] - ["Add buttons to head" gnus-article-add-buttons-to-head t] - ["Stop page breaking" gnus-summary-stop-page-breaking t] - ["Toggle MIME" gnus-summary-toggle-mime t] - ["Verbose header" gnus-summary-verbose-headers t] - ["Toggle header" gnus-summary-toggle-header t] - ["Toggle smileys" gnus-smiley-display t] + ["Unix pipe" gnus-summary-pipe-message t] + ["Add buttons" gnus-article-add-buttons t] + ["Add buttons to head" gnus-article-add-buttons-to-head t] + ["Stop page breaking" gnus-summary-stop-page-breaking t] + ["Toggle MIME" gnus-summary-toggle-mime t] + ["Verbose header" gnus-summary-verbose-headers t] + ["Toggle header" gnus-summary-toggle-header t] + ["Toggle smiley" gnus-summary-toggle-smiley t] ["Verify X-PGP-Sig" gnus-article-verify-x-pgp-sig t] ["HZ" gnus-article-decode-HZ t]) - ("Output" - ["Save in default format" gnus-summary-save-article + ("Output" + ["Save in default format" gnus-summary-save-article ,@(if (featurep 'xemacs) '(t) '(:help "Save article using default method"))] - ["Save in file" gnus-summary-save-article-file + ["Save in file" gnus-summary-save-article-file ,@(if (featurep 'xemacs) '(t) '(:help "Save article in file"))] - ["Save in Unix mail format" gnus-summary-save-article-mail t] - ["Save in MH folder" gnus-summary-save-article-folder t] - ["Save in VM folder" gnus-summary-save-article-vm t] - ["Save in RMAIL mbox" gnus-summary-save-article-rmail t] - ["Save body in file" gnus-summary-save-article-body-file t] - ["Pipe through a filter" gnus-summary-pipe-output t] - ["Add to SOUP packet" gnus-soup-add-article t] - ["Print" gnus-summary-print-article t]) - ("Backend" - ["Respool article..." gnus-summary-respool-article t] - ["Move article..." gnus-summary-move-article - (gnus-check-backend-function - 'request-move-article gnus-newsgroup-name)] - ["Copy article..." gnus-summary-copy-article t] - ["Crosspost article..." gnus-summary-crosspost-article - (gnus-check-backend-function - 'request-replace-article gnus-newsgroup-name)] - ["Import file..." gnus-summary-import-article t] - ["Create article..." gnus-summary-create-article t] - ["Check if posted" gnus-summary-article-posted-p t] - ["Edit article" gnus-summary-edit-article - (not (gnus-group-read-only-p))] - ["Delete article" gnus-summary-delete-article - (gnus-check-backend-function - 'request-expire-articles gnus-newsgroup-name)] - ["Query respool" gnus-summary-respool-query t] + ["Save in Unix mail format" gnus-summary-save-article-mail t] + ["Save in MH folder" gnus-summary-save-article-folder t] + ["Save in VM folder" gnus-summary-save-article-vm t] + ["Save in RMAIL mbox" gnus-summary-save-article-rmail t] + ["Save body in file" gnus-summary-save-article-body-file t] + ["Pipe through a filter" gnus-summary-pipe-output t] + ["Add to SOUP packet" gnus-soup-add-article t] + ["Print with Muttprint" gnus-summary-muttprint t] + ["Print" gnus-summary-print-article t]) + ("Backend" + ["Respool article..." gnus-summary-respool-article t] + ["Move article..." gnus-summary-move-article + (gnus-check-backend-function + 'request-move-article gnus-newsgroup-name)] + ["Copy article..." gnus-summary-copy-article t] + ["Crosspost article..." gnus-summary-crosspost-article + (gnus-check-backend-function + 'request-replace-article gnus-newsgroup-name)] + ["Import file..." gnus-summary-import-article t] + ["Create article..." gnus-summary-create-article t] + ["Check if posted" gnus-summary-article-posted-p t] + ["Edit article" gnus-summary-edit-article + (not (gnus-group-read-only-p))] + ["Delete article" gnus-summary-delete-article + (gnus-check-backend-function + 'request-expire-articles gnus-newsgroup-name)] + ["Query respool" gnus-summary-respool-query t] ["Trace respool" gnus-summary-respool-trace t] - ["Delete expirable articles" gnus-summary-expire-articles-now - (gnus-check-backend-function - 'request-expire-articles gnus-newsgroup-name)]) - ("Extract" - ["Uudecode" gnus-uu-decode-uu + ["Delete expirable articles" gnus-summary-expire-articles-now + (gnus-check-backend-function + 'request-expire-articles gnus-newsgroup-name)]) + ("Extract" + ["Uudecode" gnus-uu-decode-uu ,@(if (featurep 'xemacs) '(t) '(:help "Decode uuencoded article(s)"))] - ["Uudecode and save" gnus-uu-decode-uu-and-save t] - ["Unshar" gnus-uu-decode-unshar t] - ["Unshar and save" gnus-uu-decode-unshar-and-save t] - ["Save" gnus-uu-decode-save t] - ["Binhex" gnus-uu-decode-binhex t] - ["Postscript" gnus-uu-decode-postscript t]) - ("Cache" - ["Enter article" gnus-cache-enter-article t] - ["Remove article" gnus-cache-remove-article t]) + ["Uudecode and save" gnus-uu-decode-uu-and-save t] + ["Unshar" gnus-uu-decode-unshar t] + ["Unshar and save" gnus-uu-decode-unshar-and-save t] + ["Save" gnus-uu-decode-save t] + ["Binhex" gnus-uu-decode-binhex t] + ["Postscript" gnus-uu-decode-postscript t]) + ("Cache" + ["Enter article" gnus-cache-enter-article t] + ["Remove article" gnus-cache-remove-article t]) ["Translate" gnus-article-babel t] - ["Select article buffer" gnus-summary-select-article-buffer t] - ["Enter digest buffer" gnus-summary-enter-digest-group t] - ["Isearch article..." gnus-summary-isearch-article t] - ["Beginning of the article" gnus-summary-beginning-of-article t] - ["End of the article" gnus-summary-end-of-article t] - ["Fetch parent of article" gnus-summary-refer-parent-article t] - ["Fetch referenced articles" gnus-summary-refer-references t] - ["Fetch current thread" gnus-summary-refer-thread t] - ["Fetch article with id..." gnus-summary-refer-article t] - ["Setup Mailing List Params" gnus-mailing-list-insinuate t] - ["Redisplay" gnus-summary-show-article t]))) + ["Select article buffer" gnus-summary-select-article-buffer t] + ["Enter digest buffer" gnus-summary-enter-digest-group t] + ["Isearch article..." gnus-summary-isearch-article t] + ["Beginning of the article" gnus-summary-beginning-of-article t] + ["End of the article" gnus-summary-end-of-article t] + ["Fetch parent of article" gnus-summary-refer-parent-article t] + ["Fetch referenced articles" gnus-summary-refer-references t] + ["Fetch current thread" gnus-summary-refer-thread t] + ["Fetch article with id..." gnus-summary-refer-article t] + ["Setup Mailing List Params" gnus-mailing-list-insinuate t] + ["Redisplay" gnus-summary-show-article t] + ["Raw article" gnus-summary-show-raw-article t]))) (easy-menu-define gnus-summary-article-menu gnus-summary-mode-map "" (cons "Article" innards)) (if (not (keymapp gnus-summary-article-menu)) (easy-menu-define - gnus-article-commands-menu gnus-article-mode-map "" - (cons "Commands" innards)) + gnus-article-commands-menu gnus-article-mode-map "" + (cons "Commands" innards)) ;; in Emacs, don't share menu. - (setq gnus-article-commands-menu + (setq gnus-article-commands-menu (copy-keymap gnus-summary-article-menu)) (define-key gnus-article-mode-map [menu-bar commands] (cons "Commands" gnus-article-commands-menu)))) @@ -1962,7 +2022,7 @@ increase the score of each group you read." (easy-menu-define gnus-summary-post-menu gnus-summary-mode-map "" `("Post" - ["Post an article" gnus-summary-post-news + ["Send a message (mail or news)" gnus-summary-post-news ,@(if (featurep 'xemacs) '(t) '(:help "Post an article"))] ["Followup" gnus-summary-followup @@ -1988,6 +2048,7 @@ increase the score of each group you read." ["Resend message" gnus-summary-resend-message t] ["Send bounced mail" gnus-summary-resend-bounced-mail t] ["Send a mail" gnus-summary-mail-other-window t] + ["Create a local message" gnus-summary-news-other-window t] ["Uuencode and post" gnus-uu-post-news ,@(if (featurep 'xemacs) '(t) '(:help "Post a uuencoded article"))] @@ -1999,7 +2060,7 @@ increase the score of each group you read." ;;["Send bounced" gnus-resend-bounced-mail t]) )) - (cond + (cond ((not (keymapp gnus-summary-post-menu)) (setq gnus-article-post-menu gnus-summary-post-menu)) ((not gnus-article-post-menu) @@ -2011,7 +2072,7 @@ increase the score of each group you read." (easy-menu-define gnus-summary-misc-menu gnus-summary-mode-map "" - `("Misc" + `("Gnus" ("Mark Read" ["Mark as read" gnus-summary-mark-as-read-forward t] ["Mark same subject and select" @@ -2039,6 +2100,7 @@ increase the score of each group you read." ["Age..." gnus-summary-limit-to-age t] ["Extra..." gnus-summary-limit-to-extra t] ["Score" gnus-summary-limit-to-score t] + ["Display Predicate" gnus-summary-limit-to-display-predicate t] ["Unread" gnus-summary-limit-to-unread t] ["Non-dormant" gnus-summary-limit-exclude-dormant t] ["Articles" gnus-summary-limit-to-articles t] @@ -2058,7 +2120,7 @@ increase the score of each group you read." ["Mark region" gnus-uu-mark-region t] ["Unmark region" gnus-uu-unmark-region t] ["Mark by regexp..." gnus-uu-mark-by-regexp t] - ["Unmark by regexp..." gnus-uu-unmark-by-regexp t] + ["Unmark by regexp..." gnus-uu-unmark-by-regexp t] ["Mark all" gnus-uu-mark-all t] ["Mark buffer" gnus-uu-mark-buffer t] ["Mark sparse" gnus-uu-mark-sparse t] @@ -2709,9 +2771,24 @@ display only a single character." (aset table i [??])))) (setq buffer-display-table table))) +(defun gnus-summary-set-article-display-arrow (pos) + "Update the overlay arrow to point to line at position POS." + (when (and gnus-summary-display-arrow + (boundp 'overlay-arrow-position) + (boundp 'overlay-arrow-string)) + (save-excursion + (goto-char pos) + (beginning-of-line) + (unless overlay-arrow-position + (setq overlay-arrow-position (make-marker))) + (setq overlay-arrow-string "=>" + overlay-arrow-position (set-marker overlay-arrow-position + (point) + (current-buffer)))))) + (defun gnus-summary-buffer-name (group) "Return the summary buffer name of GROUP." - (concat "*Summary " group "*")) + (concat "*Summary " (gnus-group-decoded-name group) "*")) (defun gnus-summary-setup-buffer (group) "Initialize summary buffer." @@ -2857,30 +2934,29 @@ buffer that was in action when the last article was fetched." (point) (progn (eval gnus-summary-dummy-line-format-spec) (point)) (list 'gnus-number gnus-tmp-number 'gnus-intangible gnus-tmp-number))) -(defun gnus-summary-from-or-to-or-newsgroups (header) - (let ((to (cdr (assq 'To (mail-header-extra header)))) - (newsgroups (cdr (assq 'Newsgroups (mail-header-extra header)))) - (default-mime-charset (with-current-buffer gnus-summary-buffer +(defun gnus-summary-extract-address-component (from) + (or (car (funcall gnus-extract-address-components from)) + from)) + +(defun gnus-summary-from-or-to-or-newsgroups (header gnus-tmp-from) + (let ((default-mime-charset (with-current-buffer gnus-summary-buffer default-mime-charset))) - (cond - ((and to - gnus-ignored-from-addresses - (string-match gnus-ignored-from-addresses - (mail-header-from header))) - (concat "-> " - (or (car (funcall gnus-extract-address-components - (funcall - gnus-decode-encoded-word-function to))) - (funcall gnus-decode-encoded-word-function to)))) - ((and newsgroups - gnus-ignored-from-addresses - (string-match gnus-ignored-from-addresses - (mail-header-from header))) - (concat "=> " newsgroups)) - (t - (or (car (funcall gnus-extract-address-components - (mail-header-from header))) - (mail-header-from header)))))) + ;; Is it really necessary to do this next part for each summary line? + ;; Luckily, doesn't seem to slow things down much. + (or + (and gnus-ignored-from-addresses + (string-match gnus-ignored-from-addresses gnus-tmp-from) + (let ((extra-headers (mail-header-extra header)) + to + newsgroups) + (cond + ((setq to (cdr (assq 'To extra-headers))) + (concat "-> " + (gnus-summary-extract-address-component + (funcall gnus-decode-encoded-word-function to)))) + ((setq newsgroups (cdr (assq 'Newsgroups extra-headers))) + (concat "=> " newsgroups))))) + (gnus-summary-extract-address-component gnus-tmp-from)))) (defun gnus-summary-insert-line (gnus-tmp-header gnus-tmp-level gnus-tmp-current @@ -2895,16 +2971,23 @@ buffer that was in action when the last article was fetched." (if (or (null gnus-summary-default-score) (<= (abs (- gnus-tmp-score gnus-summary-default-score)) gnus-summary-zcore-fuzz)) - ? ;Whitespace + ?\ ;;;Whitespace (if (< gnus-tmp-score gnus-summary-default-score) gnus-score-below-mark gnus-score-over-mark))) + (gnus-tmp-number (mail-header-number gnus-tmp-header)) (gnus-tmp-replied (cond (gnus-tmp-process gnus-process-mark) ((memq gnus-tmp-current gnus-newsgroup-cached) gnus-cached-mark) (gnus-tmp-replied gnus-replied-mark) + ((memq gnus-tmp-current gnus-newsgroup-forwarded) + gnus-forwarded-mark) ((memq gnus-tmp-current gnus-newsgroup-saved) gnus-saved-mark) + ((memq gnus-tmp-number gnus-newsgroup-recent) + gnus-recent-mark) + ((memq gnus-tmp-number gnus-newsgroup-unseen) + gnus-unseen-mark) (t gnus-no-mark))) (gnus-tmp-from (mail-header-from gnus-tmp-header)) (gnus-tmp-name @@ -2919,7 +3002,6 @@ buffer that was in action when the last article was fetched." (1+ (match-beginning 0)) (1- (match-end 0)))) (t gnus-tmp-from))) (gnus-tmp-subject (mail-header-subject gnus-tmp-header)) - (gnus-tmp-number (mail-header-number gnus-tmp-header)) (gnus-tmp-opening-bracket (if gnus-tmp-dummy ?\< ?\[)) (gnus-tmp-closing-bracket (if gnus-tmp-dummy ?\> ?\])) (buffer-read-only nil)) @@ -2927,8 +3009,9 @@ buffer that was in action when the last article was fetched." (setq gnus-tmp-name gnus-tmp-from)) (unless (numberp gnus-tmp-lines) (setq gnus-tmp-lines -1)) - (when (= gnus-tmp-lines -1) - (setq gnus-tmp-lines "?")) + (if (= gnus-tmp-lines -1) + (setq gnus-tmp-lines "?") + (setq gnus-tmp-lines (number-to-string gnus-tmp-lines))) (gnus-put-text-property-excluding-characters-with-faces (point) (progn (eval gnus-summary-line-format-spec) (point)) @@ -2961,7 +3044,7 @@ buffer that was in action when the last article was fetched." (if (or (null gnus-summary-default-score) (<= (abs (- score gnus-summary-default-score)) gnus-summary-zcore-fuzz)) - ? ;Whitespace + ?\ ;;;Whitespace (if (< score gnus-summary-default-score) gnus-score-below-mark gnus-score-over-mark)) 'score)) @@ -3002,7 +3085,7 @@ the thread are to be displayed." (defun gnus-summary-set-local-parameters (group) "Go through the local params of GROUP and set all variable specs in that list." (let ((params (gnus-group-find-parameter group)) - (vars '(quit-config)) ; Ignore quit-config. + (vars '(quit-config)) ; Ignore quit-config. elem) (while params (setq elem (car params) @@ -3010,9 +3093,9 @@ the thread are to be displayed." (and (consp elem) ; Has to be a cons. (consp (cdr elem)) ; The cdr has to be a list. (symbolp (car elem)) ; Has to be a symbol in there. - (not (memq (car elem) vars)) + (not (memq (car elem) vars)) (ignore-errors ; So we set it. - (push (car elem) vars) + (push (car elem) vars) (make-local-variable (car elem)) (set (car elem) (eval (nth 1 elem)))))))) @@ -3104,10 +3187,10 @@ If SHOW-ALL is non-nil, already read articles are also listed." (gnus-group-next-unread-group 1)) (gnus-handle-ephemeral-exit quit-config))) (let ((grpinfo (gnus-get-info group))) - (if (null (gnus-info-read grpinfo)) - (gnus-message 3 "Group %s contains no messages" + (if (null (gnus-info-read grpinfo)) + (gnus-message 3 "Group %s contains no messages" (gnus-group-decoded-name group)) - (gnus-message 3 "Can't select group"))) + (gnus-message 3 "Can't select group"))) nil) ;; The user did a `C-g' while prompting for number of articles, ;; so we exit this group. @@ -3740,7 +3823,7 @@ If LINE, insert the rebuilt thread starting on line LINE." (setq thread (gnus-remove-thread id))) (setq old-pos (gnus-point-at-bol)) (setq current (save-excursion - (and (zerop (forward-line -1)) + (and (re-search-backward "[\r\n]" nil t) (gnus-summary-article-number)))) ;; If this is a gathered thread, we have to go some re-gathering. (when (stringp (car thread)) @@ -4091,6 +4174,23 @@ Unscored articles will be counted as having a score of zero." (or (cdr (assq type (mail-header-extra (or header gnus-tmp-header)))) "")) +(defvar gnus-tmp-thread-tree-header-string "") + +(defvar gnus-sum-thread-tree-root "> " + "With %B spec, used for the root of a thread. +If nil, use subject instead.") +(defvar gnus-sum-thread-tree-single-indent "" + "With %B spec, used for a thread with just one message. +If nil, use subject instead.") +(defvar gnus-sum-thread-tree-vertical "| " + "With %B spec, used for drawing a vertical line.") +(defvar gnus-sum-thread-tree-indent " " + "With %B spec, used for indenting.") +(defvar gnus-sum-thread-tree-leaf-with-other "+-> " + "With %B spec, used for a leaf with brothers.") +(defvar gnus-sum-thread-tree-single-leaf "\\-> " + "With %B spec, used for a leaf without brothers.") + (defun gnus-summary-prepare-threads (threads) "Prepare summary buffer from THREADS and indentation LEVEL. THREADS is either a list of `(PARENT [(CHILD1 [(GRANDCHILD ...]...) ...])' @@ -4109,7 +4209,8 @@ or a straight list of headers." gnus-tmp-replied gnus-tmp-subject-or-nil gnus-tmp-dummy gnus-tmp-indentation gnus-tmp-lines gnus-tmp-score gnus-tmp-score-char gnus-tmp-from gnus-tmp-name - gnus-tmp-number gnus-tmp-opening-bracket gnus-tmp-closing-bracket) + gnus-tmp-number gnus-tmp-opening-bracket gnus-tmp-closing-bracket + tree-stack) (setq gnus-tmp-prev-subject nil) @@ -4147,7 +4248,8 @@ or a straight list of headers." ;; the stack. (setq state (car stack) gnus-tmp-level (car state) - thread (cdr state) + tree-stack (cadr state) + thread (caddr state) stack (cdr stack) gnus-tmp-header (caar thread)))) @@ -4288,7 +4390,7 @@ or a straight list of headers." (if (or (null gnus-summary-default-score) (<= (abs (- gnus-tmp-score gnus-summary-default-score)) gnus-summary-zcore-fuzz)) - ? ;Whitespace + ?\ ;;;Whitespace (if (< gnus-tmp-score gnus-summary-default-score) gnus-score-below-mark gnus-score-over-mark)) gnus-tmp-replied @@ -4302,6 +4404,10 @@ or a straight list of headers." gnus-forwarded-mark) ((memq number gnus-newsgroup-saved) gnus-saved-mark) + ((memq number gnus-newsgroup-recent) + gnus-recent-mark) + ((memq number gnus-newsgroup-unseen) + gnus-unseen-mark) (t gnus-no-mark)) gnus-tmp-from (mail-header-from gnus-tmp-header) gnus-tmp-name @@ -4314,13 +4420,31 @@ or a straight list of headers." ((string-match "(.+)" gnus-tmp-from) (substring gnus-tmp-from (1+ (match-beginning 0)) (1- (match-end 0)))) - (t gnus-tmp-from))) + (t gnus-tmp-from)) + gnus-tmp-thread-tree-header-string + (cond + ((not gnus-show-threads) "") + ((zerop gnus-tmp-level) + (if (cdar thread) + (or gnus-sum-thread-tree-root subject) + (or gnus-sum-thread-tree-single-indent subject))) + (t + (concat (apply 'concat + (mapcar (lambda (item) + (if (= item 1) + gnus-sum-thread-tree-vertical + gnus-sum-thread-tree-indent)) + (cdr (reverse tree-stack)))) + (if (nth 1 thread) + gnus-sum-thread-tree-leaf-with-other + gnus-sum-thread-tree-single-leaf))))) (when (string= gnus-tmp-name "") (setq gnus-tmp-name gnus-tmp-from)) (unless (numberp gnus-tmp-lines) (setq gnus-tmp-lines -1)) - (when (= gnus-tmp-lines -1) - (setq gnus-tmp-lines "?")) + (if (= gnus-tmp-lines -1) + (setq gnus-tmp-lines "?") + (setq gnus-tmp-lines (number-to-string gnus-tmp-lines))) (gnus-put-text-property (point) (progn (eval gnus-summary-line-format-spec) (point)) @@ -4333,7 +4457,11 @@ or a straight list of headers." (setq gnus-tmp-prev-subject subject))) (when (nth 1 thread) - (push (cons (max 0 gnus-tmp-level) (nthcdr 1 thread)) stack)) + (push (list (max 0 gnus-tmp-level) + (copy-list tree-stack) + (nthcdr 1 thread)) + stack)) + (push (if (nth 1 thread) 1 0) tree-stack) (incf gnus-tmp-level) (setq threads (if thread-end nil (cdar thread))) (unless threads @@ -4406,30 +4534,20 @@ or a straight list of headers." (let ((name (gnus-group-decoded-name gnus-newsgroup-name))) (gnus-message 5 "Fetching headers for %s..." name) (prog1 - ;;;!!! FIXME: temporary fix for an infloop on nnimap. - (if (eq 'nnimap (car (gnus-find-method-for-group name))) - (if (eq 'nov - (setq gnus-headers-retrieved-by - (gnus-retrieve-headers - articles gnus-newsgroup-name - ;; We might want to fetch old headers, but - ;; not if there is only 1 article. - (and (or (and - (not (eq gnus-fetch-old-headers 'some)) - (not (numberp gnus-fetch-old-headers))) - (> (length articles) 1)) - gnus-fetch-old-headers)))) - (gnus-get-newsgroup-headers-xover - articles nil nil gnus-newsgroup-name t) - (gnus-get-newsgroup-headers)) - (gnus-retrieve-parsed-headers - articles gnus-newsgroup-name - ;; We might want to fetch old headers, but - ;; not if there is only 1 article. - (and (or (and (not (eq gnus-fetch-old-headers 'some)) - (not (numberp gnus-fetch-old-headers))) - (> (length articles) 1)) - gnus-fetch-old-headers))) + (if (eq 'nov + (setq gnus-headers-retrieved-by + (gnus-retrieve-headers + articles gnus-newsgroup-name + ;; We might want to fetch old headers, but + ;; not if there is only 1 article. + (and (or (and + (not (eq gnus-fetch-old-headers 'some)) + (not (numberp gnus-fetch-old-headers))) + (> (length articles) 1)) + gnus-fetch-old-headers)))) + (gnus-get-newsgroup-headers-xover + articles nil nil gnus-newsgroup-name t) + (gnus-get-newsgroup-headers)) (gnus-message 5 "Fetching headers for %s...done" name)))) (defun gnus-select-newsgroup (group &optional read-all select-articles) @@ -4439,15 +4557,15 @@ If SELECT-ARTICLES, only select those articles from GROUP." (let* ((entry (gnus-gethash group gnus-newsrc-hashtb)) ;;!!! Dirty hack; should be removed. (gnus-summary-ignore-duplicates - (if (eq (car (gnus-find-method-for-group group)) 'nnvirtual) + (if (eq (car (gnus-find-method-for-group group)) 'nnvirtual) t gnus-summary-ignore-duplicates)) (info (nth 2 entry)) articles fetched-articles cached) (unless (gnus-check-server - (setq gnus-current-select-method - (gnus-find-method-for-group group))) + (set (make-local-variable 'gnus-current-select-method) + (gnus-find-method-for-group group))) (error "Couldn't open server")) (or (and entry (not (eq (car entry) t))) ; Either it's active... @@ -4464,20 +4582,47 @@ If SELECT-ARTICLES, only select those articles from GROUP." (error "Couldn't request group %s: %s" group (gnus-status-message group))) - (setq gnus-newsgroup-name group) - (setq gnus-newsgroup-unselected nil) - (setq gnus-newsgroup-unreads (gnus-list-of-unread-articles group)) - (gnus-summary-setup-default-charset) + (setq gnus-newsgroup-name group + gnus-newsgroup-unselected nil + gnus-newsgroup-unreads (gnus-list-of-unread-articles group)) - ;; Adjust and set lists of article marks. - (when info - (gnus-adjust-marked-articles info)) + (let ((display (gnus-group-find-parameter group 'display))) + (setq gnus-newsgroup-display + (cond + ((not (zerop (or (car-safe read-all) 0))) + ;; The user entered the group with C-u SPC/RET, let's show + ;; all articles. + 'gnus-not-ignore) + ((eq display 'all) + '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)))) + + (gnus-summary-setup-default-charset) ;; Kludge to avoid having cached articles nixed out in virtual groups. - (setq cached - (if (gnus-virtual-group-p group) - gnus-newsgroup-cached - (gnus-cache-articles-in-group group))) + (when (gnus-virtual-group-p group) + (setq cached gnus-newsgroup-cached)) (setq gnus-newsgroup-unreads (gnus-set-difference @@ -4488,6 +4633,10 @@ If SELECT-ARTICLES, only select those articles from GROUP." (gnus-update-read-articles group gnus-newsgroup-unreads) + ;; Adjust and set lists of article marks. + (when info + (gnus-adjust-marked-articles info)) + (if (setq articles select-articles) (setq gnus-newsgroup-unselected (gnus-sorted-intersection @@ -4508,6 +4657,10 @@ If SELECT-ARTICLES, only select those articles from GROUP." ;; Retrieve the headers and read them in. (setq gnus-newsgroup-headers (gnus-fetch-headers articles)) + ;; Kludge to avoid having cached articles nixed out in virtual groups. + (when cached + (setq gnus-newsgroup-cached cached)) + ;; Suppress duplicates? (when gnus-suppress-duplicates (gnus-dup-suppress-articles)) @@ -4515,20 +4668,25 @@ If SELECT-ARTICLES, only select those articles from GROUP." ;; Set the initial limit. (setq gnus-newsgroup-limit (copy-sequence articles)) ;; Remove canceled articles from the list of unread articles. + (setq fetched-articles + (mapcar (lambda (headers) (mail-header-number headers)) + gnus-newsgroup-headers)) + (setq gnus-newsgroup-articles fetched-articles) (setq gnus-newsgroup-unreads (gnus-set-sorted-intersection - gnus-newsgroup-unreads - (setq fetched-articles - (mapcar (lambda (headers) (mail-header-number headers)) - gnus-newsgroup-headers)))) + gnus-newsgroup-unreads fetched-articles)) + + (let ((marks (assq 'seen (gnus-info-marks info)))) + ;; The `seen' marks are treated specially. + (when (setq gnus-newsgroup-seen (cdr marks)) + (dolist (article gnus-newsgroup-articles) + (unless (gnus-member-of-range + article gnus-newsgroup-seen) + (push article gnus-newsgroup-unseen))))) + ;; Removed marked articles that do not exist. (gnus-update-missing-marks (gnus-sorted-complement fetched-articles articles)) - - ;; Kludge to avoid having cached articles nixed out in virtual groups. - (when cached - (setq gnus-newsgroup-cached cached)) - ;; We might want to build some more threads first. (when (and gnus-fetch-old-headers (eq gnus-headers-retrieved-by 'nov)) @@ -4557,6 +4715,62 @@ If SELECT-ARTICLES, only select those articles from GROUP." ;; GROUP is successfully selected. (or gnus-newsgroup-headers t))))) +(defun gnus-summary-display-make-predicate (display) + (require 'gnus-agent) + (when (= (length display) 1) + (setq display (car display))) + (unless gnus-summary-display-cache + (dolist (elem (append (list (cons 'read 'read) + (cons 'unseen 'unseen)) + gnus-article-mark-lists)) + (push (cons (cdr elem) + (gnus-byte-compile + `(lambda () (gnus-article-marked-p ',(cdr elem))))) + gnus-summary-display-cache))) + (let ((gnus-category-predicate-alist gnus-summary-display-cache)) + (gnus-get-predicate display))) + +;; Uses the dynamically bound `number' variable. +(defvar number) +(defun gnus-article-marked-p (type &optional article) + (let ((article (or article number))) + (cond + ((eq type 'tick) + (memq article gnus-newsgroup-marked)) + ((eq type 'unsend) + (memq article gnus-newsgroup-unsendable)) + ((eq type 'undownload) + (memq article gnus-newsgroup-undownloaded)) + ((eq type 'download) + (memq article gnus-newsgroup-downloadable)) + ((eq type 'unread) + (memq article gnus-newsgroup-unreads)) + ((eq type 'read) + (memq article gnus-newsgroup-reads)) + ((eq type 'dormant) + (memq article gnus-newsgroup-dormant) ) + ((eq type 'expire) + (memq article gnus-newsgroup-expirable)) + ((eq type 'reply) + (memq article gnus-newsgroup-replied)) + ((eq type 'killed) + (memq article gnus-newsgroup-killed)) + ((eq type 'bookmark) + (assq article gnus-newsgroup-bookmarks)) + ((eq type 'score) + (assq article gnus-newsgroup-scored)) + ((eq type 'save) + (memq article gnus-newsgroup-saved)) + ((eq type 'cache) + (memq article gnus-newsgroup-cached)) + ((eq type 'forward) + (memq article gnus-newsgroup-forwarded)) + ((eq type 'seen) + (not (memq article gnus-newsgroup-unseen))) + ((eq type 'recent) + (memq article gnus-newsgroup-recent)) + (t t)))) + (defun gnus-articles-to-read (group &optional read-all) "Find out what articles the user wants to read." (let* ((articles @@ -4565,11 +4779,15 @@ If SELECT-ARTICLES, only select those articles from GROUP." (if (or read-all (and (zerop (length gnus-newsgroup-marked)) (zerop (length gnus-newsgroup-unreads))) - (eq (gnus-group-find-parameter group 'display) - 'all)) + (eq gnus-newsgroup-display 'gnus-not-ignore)) + ;; We want to select the headers for all the articles in + ;; the group, so we select either all the active + ;; articles in the group, or (if that's nil), the + ;; articles in the cache. (or (gnus-uncompress-range (gnus-active group)) (gnus-cache-articles-in-group group)) + ;; Select only the "normal" subset of articles. (sort (append gnus-newsgroup-dormant gnus-newsgroup-marked (copy-sequence gnus-newsgroup-unreads)) '<))) @@ -4589,13 +4807,16 @@ If SELECT-ARTICLES, only select those articles from GROUP." (natnump gnus-large-newsgroup) (> number gnus-large-newsgroup)) (let* ((cursor-in-echo-area nil) - (input (read-from-minibuffer - (format - "How many articles from %s (max %d): " - (gnus-limit-string gnus-newsgroup-name 35) - number) - (cons (number-to-string gnus-large-newsgroup) - 0)))) + (input + (read-from-minibuffer + (format + "How many articles from %s (max %d): " + (gnus-limit-string + (gnus-group-decoded-name gnus-newsgroup-name) + 35) + number) + (cons (number-to-string gnus-large-newsgroup) + 0)))) (if (string-match "^[ \t]*$" input) number input))) @@ -4605,7 +4826,8 @@ If SELECT-ARTICLES, only select those articles from GROUP." (read-string (format "%s %s (%d scored, %d total): " "How many articles from" - group scored number)))) + (gnus-group-decoded-name group) + scored number)))) (if (string-match "^[ \t]*$" input) number input))) (t number)) @@ -4658,6 +4880,15 @@ If SELECT-ARTICLES, only select those articles from GROUP." (setq marks (cdr marks))) out)) +(defun gnus-article-mark-to-type (mark) + "Return the type of MARK." + (or (cadr (assq mark gnus-article-special-mark-lists)) + 'list)) + +(defun gnus-article-unpropagatable-p (mark) + "Return whether MARK should be propagated to backend." + (memq mark gnus-article-unpropagated-mark-lists)) + (defun gnus-adjust-marked-articles (info) "Set all article lists and remove all marks that are no longer valid." (let* ((marked-lists (gnus-info-marks info)) @@ -4665,28 +4896,26 @@ If SELECT-ARTICLES, only select those articles from GROUP." (min (car active)) (max (cdr active)) (types gnus-article-mark-lists) - (uncompressed '(score bookmark killed)) - marks var articles article mark) + marks var articles article mark mark-type) - (while marked-lists - (setq marks (pop marked-lists)) - (set (setq var (intern (format "gnus-newsgroup-%s" - (car (rassq (setq mark (car marks)) - types))))) - (if (memq (car marks) uncompressed) (cdr marks) - (gnus-uncompress-range (cdr marks)))) + (dolist (marks marked-lists) + (setq mark (car marks) + mark-type (gnus-article-mark-to-type mark) + var (intern (format "gnus-newsgroup-%s" (car (rassq mark types))))) - (setq articles (symbol-value var)) - - ;; All articles have to be subsets of the active articles. + ;; We set the variable according to the type of the marks list, + ;; and then adjust the marks to a subset of the active articles. (cond ;; Adjust "simple" lists. - ((memq mark '(tick dormant expire reply save)) - (while articles - (when (or (< (setq article (pop articles)) min) (> article max)) - (set var (delq article (symbol-value var)))))) + ((eq mark-type 'list) + (set var (setq articles (gnus-uncompress-range (cdr marks)))) + (when (memq mark '(tick dormant expire reply save)) + (while articles + (when (or (< (setq article (pop articles)) min) (> article max)) + (set var (delq article (symbol-value var))))))) ;; Adjust assocs. - ((memq mark uncompressed) + ((eq mark-type 'tuple) + (set var (setq articles (cdr marks))) (when (not (listp (cdr (symbol-value var)))) (set var (list (symbol-value var)))) (when (not (listp (cdr articles))) @@ -4695,36 +4924,37 @@ If SELECT-ARTICLES, only select those articles from GROUP." (when (or (not (consp (setq article (pop articles)))) (< (car article) min) (> (car article) max)) - (set var (delq article (symbol-value var)))))))))) + (set var (delq article (symbol-value var)))))) + ((eq mark-type 'range) + (cond + ((eq mark 'seen)))))))) (defun gnus-update-missing-marks (missing) "Go through the list of MISSING articles and remove them from the mark lists." (when missing - (let ((types gnus-article-mark-lists) - var m) + (let (var m) ;; Go through all types. - (while types - (setq var (intern (format "gnus-newsgroup-%s" (car (pop types))))) - (when (symbol-value var) - ;; This list has articles. So we delete all missing articles - ;; from it. - (setq m missing) - (while m - (set var (delq (pop m) (symbol-value var))))))))) + (dolist (elem gnus-article-mark-lists) + (when (eq (gnus-article-mark-to-type (cdr elem)) 'list) + (setq var (intern (format "gnus-newsgroup-%s" (car elem)))) + (when (symbol-value var) + ;; This list has articles. So we delete all missing + ;; articles from it. + (setq m missing) + (while m + (set var (delq (pop m) (symbol-value var)))))))))) (defun gnus-update-marks () "Enter the various lists of marked articles into the newsgroup info list." (let ((types gnus-article-mark-lists) (info (gnus-get-info gnus-newsgroup-name)) - (uncompressed '(score bookmark killed)) type list newmarked symbol delta-marks) (when info ;; Add all marks lists to the list of marks lists. (while (setq type (pop types)) (setq list (symbol-value (setq symbol - (intern (format "gnus-newsgroup-%s" - (car type)))))) + (intern (format "gnus-newsgroup-%s" (car type)))))) (when list ;; Get rid of the entries of the articles that have the @@ -4743,27 +4973,26 @@ If SELECT-ARTICLES, only select those articles from GROUP." (setq arts (cdr arts))) (setq list (cdr all))))) - (unless (memq (cdr type) uncompressed) + (when (eq (cdr type) 'seen) + (setq list + (if list + (gnus-add-to-range list gnus-newsgroup-unseen) + (gnus-compress-sequence gnus-newsgroup-articles)))) + + (when (eq (gnus-article-mark-to-type (cdr type)) 'list) (setq list (gnus-compress-sequence (set symbol (sort list '<)) t))) - (when (gnus-check-backend-function - 'request-set-mark gnus-newsgroup-name) - ;; propagate flags to server, with the following exceptions: - ;; uncompressed:s are not proper flags (they are cons cells) - ;; cache is a internal gnus flag - ;; download are local to one gnus installation (well) - ;; unsend are for nndraft groups only - ;; xxx: generality of this? this suits nnimap anyway - (unless (memq (cdr type) (append '(cache download unsend) - uncompressed)) - (let* ((old (cdr (assq (cdr type) (gnus-info-marks info)))) - (del (gnus-remove-from-range (gnus-copy-sequence old) list)) - (add (gnus-remove-from-range - (gnus-copy-sequence list) old))) - (when add - (push (list add 'add (list (cdr type))) delta-marks)) - (when del - (push (list del 'del (list (cdr type))) delta-marks))))) + (when (and (gnus-check-backend-function + 'request-set-mark gnus-newsgroup-name) + (not (gnus-article-unpropagatable-p (cdr type)))) + (let* ((old (cdr (assq (cdr type) (gnus-info-marks info)))) + (del (gnus-remove-from-range (gnus-copy-sequence old) list)) + (add (gnus-remove-from-range + (gnus-copy-sequence list) old))) + (when add + (push (list add 'add (list (cdr type))) delta-marks)) + (when del + (push (list del 'del (list (cdr type))) delta-marks)))) (when list (push (cons (cdr type) list) newmarked))) @@ -4804,7 +5033,7 @@ If WHERE is `summary', the summary mode line format will be used." (let* ((mformat (symbol-value (intern (format "gnus-%s-mode-line-format-spec" where)))) - (gnus-tmp-group-name (gnus-group-decoded-name + (gnus-tmp-group-name (gnus-group-decoded-name gnus-newsgroup-name)) (gnus-tmp-article-number (or gnus-current-article 0)) (gnus-tmp-unread gnus-newsgroup-unreads) @@ -4967,9 +5196,11 @@ The resulting hash table is returned, or nil if no Xrefs were found." (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-active ,group)) + (gnus-request-set-mark ,group (list (list ',range 'del '(read)))) (gnus-group-update-group ,group t)))) ;; Add the read articles to the range. (gnus-info-set-read info range) + (gnus-request-set-mark group (list (list range 'add '(read)))) ;; Then we have to re-compute how many unread ;; articles there are in this group. (when active @@ -5041,22 +5272,20 @@ The resulting hash table is returned, or nil if no Xrefs were found." ;; Subject. (progn (goto-char p) - (if (search-forward "\nsubject: " nil t) + (if (search-forward "\nsubject:" nil t) (nnheader-header-value) "(none)")) ;; From. (progn (goto-char p) - (if (or (search-forward "\nfrom: " nil t) - (search-forward "\nfrom:" nil t)) + (if (search-forward "\nfrom:" nil t) (nnheader-header-value) "(nobody)")) ;; Date. (progn (goto-char p) - (if (search-forward "\ndate: " nil t) - (nnheader-header-value) - "")) + (if (search-forward "\ndate:" nil t) + (nnheader-header-value) "")) ;; Message-ID. (progn (goto-char p) @@ -5072,7 +5301,7 @@ The resulting hash table is returned, or nil if no Xrefs were found." ;; References. (progn (goto-char p) - (if (search-forward "\nreferences: " nil t) + (if (search-forward "\nreferences:" nil t) (progn (setq end (point)) (prog1 @@ -5080,7 +5309,7 @@ The resulting hash table is returned, or nil if no Xrefs were found." (setq ref (buffer-substring (progn - ;; (end-of-line) + ;; (end-of-line) (search-backward ">" end t) (1+ (point))) (progn @@ -5089,7 +5318,7 @@ The resulting hash table is returned, or nil if no Xrefs were found." ;; Get the references from the in-reply-to header if there ;; were no references and the in-reply-to header looks ;; promising. - (if (and (search-forward "\nin-reply-to: " nil t) + (if (and (search-forward "\nin-reply-to:" nil t) (setq in-reply-to (nnheader-header-value)) (string-match "<[^>]+>" in-reply-to)) (let (ref2) @@ -5119,7 +5348,7 @@ The resulting hash table is returned, or nil if no Xrefs were found." ;; Xref. (progn (goto-char p) - (and (search-forward "\nxref: " nil t) + (and (search-forward "\nxref:" nil t) (nnheader-header-value))) ;; Extra. (when gnus-extra-headers @@ -5128,7 +5357,7 @@ The resulting hash table is returned, or nil if no Xrefs were found." (while extra (goto-char p) (when (search-forward - (concat "\n" (symbol-name (car extra)) ": ") nil t) + (concat "\n" (symbol-name (car extra)) ":") nil t) (push (cons (car extra) (nnheader-header-value)) out)) (pop extra)) out)))) @@ -5217,11 +5446,8 @@ Return a list of headers that match SEQUENCE (see (let ((gnus-nov-is-evil t)) (nconc (nreverse headers) - ;;;!!! FIXME: temporary fix for an infloop on nnimap. - (if (eq 'nnimap (car (gnus-find-method-for-group group))) - (when (eq (gnus-retrieve-headers sequence group) 'headers) - (gnus-get-newsgroup-headers)) - (gnus-retrieve-parsed-headers sequence group)))))))) + (when (eq (gnus-retrieve-headers sequence group) 'headers) + (gnus-get-newsgroup-headers)))))))) (defun gnus-article-get-xrefs () "Fill in the Xref value in `gnus-current-headers', if necessary. @@ -5741,7 +5967,7 @@ If FORCE (the prefix), also save the .newsrc file(s)." (let* ((group gnus-newsgroup-name) (quit-config (gnus-group-quit-config gnus-newsgroup-name)) (mode major-mode) - (group-point nil) + (group-point nil) (buf (current-buffer))) (unless quit-config ;; Do adaptive scoring, and possibly save score files. @@ -5874,7 +6100,7 @@ If FORCE (the prefix), also save the .newsrc file(s)." (when (equal (gnus-group-group-name) group) (gnus-group-next-unread-group 1)) (when quit-config - (gnus-handle-ephemeral-exit quit-config))))) + (gnus-handle-ephemeral-exit quit-config))))) (defun gnus-handle-ephemeral-exit (quit-config) "Handle movement when leaving an ephemeral group. @@ -5883,25 +6109,25 @@ The state which existed when entering the ephemeral is reset." (gnus-configure-windows 'group 'force) (set-buffer (car quit-config)) (cond ((eq major-mode 'gnus-summary-mode) - (gnus-set-global-variables)) - ((eq major-mode 'gnus-article-mode) - (save-excursion - ;; The `gnus-summary-buffer' variable may point - ;; to the old summary buffer when using a single - ;; article buffer. - (unless (gnus-buffer-live-p gnus-summary-buffer) - (set-buffer gnus-group-buffer)) - (set-buffer gnus-summary-buffer) - (gnus-set-global-variables)))) + (gnus-set-global-variables)) + ((eq major-mode 'gnus-article-mode) + (save-excursion + ;; The `gnus-summary-buffer' variable may point + ;; to the old summary buffer when using a single + ;; article buffer. + (unless (gnus-buffer-live-p gnus-summary-buffer) + (set-buffer gnus-group-buffer)) + (set-buffer gnus-summary-buffer) + (gnus-set-global-variables)))) (if (or (eq (cdr quit-config) 'article) - (eq (cdr quit-config) 'pick)) - (progn - ;; The current article may be from the ephemeral group - ;; thus it is best that we reload this article - (gnus-summary-show-article) - (if (and (boundp 'gnus-pick-mode) (symbol-value 'gnus-pick-mode)) - (gnus-configure-windows 'pick 'force) - (gnus-configure-windows (cdr quit-config) 'force))) + (eq (cdr quit-config) 'pick)) + (progn + ;; The current article may be from the ephemeral group + ;; thus it is best that we reload this article + (gnus-summary-show-article) + (if (and (boundp 'gnus-pick-mode) (symbol-value 'gnus-pick-mode)) + (gnus-configure-windows 'pick 'force) + (gnus-configure-windows (cdr quit-config) 'force))) (gnus-configure-windows (cdr quit-config) 'force)) (when (eq major-mode 'gnus-summary-mode) (gnus-summary-next-subject 1 nil t) @@ -6176,7 +6402,9 @@ If FORCE, also allow jumping to articles not currently shown." (unless silent (gnus-message 3 "Can't find article %d" article)) nil) - (goto-char (gnus-data-pos data)) + (let ((pt (gnus-data-pos data))) + (goto-char pt) + (gnus-summary-set-article-display-arrow pt)) (gnus-summary-position-point) article))) @@ -6654,24 +6882,35 @@ If given a prefix, remove all limits." (gnus-summary-limit nil 'pop) (gnus-summary-position-point))) -(defun gnus-summary-limit-to-subject (subject &optional header) - "Limit the summary buffer to articles that have subjects that match a regexp." - (interactive "sLimit to subject (regexp): ") +(defun gnus-summary-limit-to-subject (subject &optional header not-matching) + "Limit the summary buffer to articles that have subjects that match a regexp. +If NOT-MATCHING, excluding articles that have subjects that match a regexp." + (interactive + (list (read-string (if current-prefix-arg + "Exclude subject (regexp): " + "Limit to subject (regexp): ")) + nil current-prefix-arg)) (unless header (setq header "subject")) (when (not (equal "" subject)) (prog1 (let ((articles (gnus-summary-find-matching - (or header "subject") subject 'all))) + (or header "subject") subject 'all nil nil + not-matching))) (unless articles (error "Found no matches for \"%s\"" subject)) (gnus-summary-limit articles)) (gnus-summary-position-point)))) -(defun gnus-summary-limit-to-author (from) - "Limit the summary buffer to articles that have authors that match a regexp." - (interactive "sLimit to author (regexp): ") - (gnus-summary-limit-to-subject from "from")) +(defun gnus-summary-limit-to-author (from &optional not-matching) + "Limit the summary buffer to articles that have authors that match a regexp. +If NOT-MATCHING, excluding articles that have authors that match a regexp." + (interactive + (list (read-string (if current-prefix-arg + "Exclude author (regexp): " + "Limit to author (regexp): ")) + current-prefix-arg)) + (gnus-summary-limit-to-subject from "from" not-matching)) (defun gnus-summary-limit-to-age (age &optional younger-p) "Limit the summary buffer to articles that are older than (or equal) AGE days. @@ -6711,30 +6950,48 @@ articles that are younger than AGE days." (gnus-summary-limit (nreverse articles))) (gnus-summary-position-point))) -(defun gnus-summary-limit-to-extra (header regexp) +(defun gnus-summary-limit-to-extra (header regexp &optional not-matching) "Limit the summary buffer to articles that match an 'extra' header." (interactive (let ((header (intern (gnus-completing-read (symbol-name (car gnus-extra-headers)) - "Limit extra header:" + (if current-prefix-arg + "Exclude extra header:" + "Limit extra header:") (mapcar (lambda (x) (cons (symbol-name x) x)) gnus-extra-headers) nil t)))) (list header - (read-string (format "Limit to header %s (regexp): " header))))) + (read-string (format "%s header %s (regexp): " + (if current-prefix-arg "Exclude" "Limit to") + header)) + current-prefix-arg))) (when (not (equal "" regexp)) (prog1 (let ((articles (gnus-summary-find-matching - (cons 'extra header) regexp 'all))) + (cons 'extra header) regexp 'all nil nil + not-matching))) (unless articles (error "Found no matches for \"%s\"" regexp)) (gnus-summary-limit articles)) (gnus-summary-position-point)))) +(defun gnus-summary-limit-to-display-predicate () + "Limit the summary buffer to the predicated in the `display' group parameter." + (interactive) + (unless gnus-newsgroup-display + (error "There is no `display' group parameter")) + (let (articles) + (dolist (number gnus-newsgroup-articles) + (when (funcall gnus-newsgroup-display) + (push number articles))) + (gnus-summary-limit articles)) + (gnus-summary-position-point)) + (defalias 'gnus-summary-delete-marked-as-read 'gnus-summary-limit-to-unread) (make-obsolete 'gnus-summary-delete-marked-as-read 'gnus-summary-limit-to-unread) @@ -6787,12 +7044,9 @@ Returns how many articles were removed." (gnus-summary-limit articles)) (gnus-summary-position-point))) -(defun gnus-summary-limit-to-score (&optional score) +(defun gnus-summary-limit-to-score (score) "Limit to articles with score at or above SCORE." - (interactive "P") - (setq score (if score - (prefix-numeric-value score) - (or gnus-summary-default-score 0))) + (interactive "NLimit to articles with score of at least: ") (let ((data gnus-newsgroup-data) articles) (while data @@ -6813,10 +7067,10 @@ article." (gnus-id-to-thread (gnus-root-id id))))) (prog1 (gnus-summary-limit (nconc articles gnus-newsgroup-limit)) - (gnus-summary-limit-include-matching-articles - "subject" - (regexp-quote (gnus-simplify-subject-re - (mail-header-subject (gnus-id-to-header id))))) + (gnus-summary-limit-include-matching-articles + "subject" + (regexp-quote (gnus-simplify-subject-re + (mail-header-subject (gnus-id-to-header id))))) (gnus-summary-position-point)))) (defun gnus-summary-limit-include-matching-articles (header regexp) @@ -6994,6 +7248,7 @@ fetch-old-headers verbiage, and so on." ;; Most groups have nothing to remove. (if (or gnus-inhibit-limiting (and (null gnus-newsgroup-dormant) + (eq gnus-newsgroup-display 'gnus-not-ignore) (not (eq gnus-fetch-old-headers 'some)) (not (numberp gnus-fetch-old-headers)) (not (eq gnus-fetch-old-headers 'invisible)) @@ -7082,6 +7337,9 @@ fetch-old-headers verbiage, and so on." (push (cons number gnus-low-score-mark) gnus-newsgroup-reads))) t) + ;; Do the `display' group parameter. + (and gnus-newsgroup-display + (not (funcall gnus-newsgroup-display))) ;; Check NoCeM things. (if (and gnus-use-nocem (gnus-nocem-unwanted-article-p @@ -7317,7 +7575,7 @@ to guess what the document format is." (delete-matching-lines "^Path:\\|^From ") (widen)) (unwind-protect - (if (let ((gnus-newsgroup-ephemeral-charset gnus-newsgroup-charset) + (if (let ((gnus-newsgroup-ephemeral-charset gnus-newsgroup-charset) (gnus-newsgroup-ephemeral-ignored-charsets gnus-newsgroup-ignored-charsets)) (gnus-group-read-ephemeral-group @@ -7325,13 +7583,13 @@ to guess what the document format is." (nndoc-article-type ,(if force 'mbox 'guess))) t)) ;; Make all postings to this group go to the parent group. - (nconc (gnus-info-params (gnus-get-info name)) - params) - ;; Couldn't select this doc group. - (switch-to-buffer buf) - (gnus-set-global-variables) - (gnus-configure-windows 'summary) - (gnus-message 3 "Article couldn't be entered?")) + (nconc (gnus-info-params (gnus-get-info name)) + params) + ;; Couldn't select this doc group. + (switch-to-buffer buf) + (gnus-set-global-variables) + (gnus-configure-windows 'summary) + (gnus-message 3 "Article couldn't be entered?")) (kill-buffer dig))))) (defun gnus-summary-read-document (n) @@ -7615,13 +7873,14 @@ fetched headers for, whether they are displayed or not." (nreverse articles))) (defun gnus-summary-find-matching (header regexp &optional backward unread - not-case-fold) + not-case-fold not-matching) "Return a list of all articles that match REGEXP on HEADER. The search stars on the current article and goes forwards unless BACKWARD is non-nil. If BACKWARD is `all', do all articles. If UNREAD is non-nil, only unread articles will be taken into consideration. If NOT-CASE-FOLD, case won't be folded -in the comparisons." +in the comparisons. If NOT-MATCHING, return a list of all articles that +not match REGEXP on HEADER." (let ((case-fold-search (not not-case-fold)) articles d func) (if (consp header) @@ -7642,8 +7901,12 @@ in the comparisons." (when (and (or (not unread) ; We want all articles... (gnus-data-unread-p d)) ; Or just unreads. (vectorp (gnus-data-header d)) ; It's not a pseudo. - (string-match regexp - (funcall func (gnus-data-header d)))) ; Match. + (if not-matching + (not (string-match + regexp + (funcall func (gnus-data-header d)))) + (string-match regexp + (funcall func (gnus-data-header d))))) (push (gnus-data-number d) articles))) ; Success! (nreverse articles))) @@ -7701,6 +7964,13 @@ article. If BACKWARD (the prefix) is non-nil, search backward instead." (when gnus-page-broken (gnus-narrow-to-page)))) +(defun gnus-summary-print-truncate-and-quote (string &optional len) + "Truncate to LEN and quote all \"(\"'s in STRING." + (gnus-replace-in-string (if (and len (> (length string) len)) + (substring string 0 len) + string) + "[()]" "\\\\\\&")) + (defun gnus-summary-print-article (&optional filename n) "Generate and print a PostScript image of the N next (mail) articles. @@ -7730,9 +8000,13 @@ to save in." (let ((ps-left-header (list (concat "(" - (mail-header-subject gnus-current-headers) ")") + (gnus-summary-print-truncate-and-quote + (mail-header-subject gnus-current-headers) + 66) ")") (concat "(" - (mail-header-from gnus-current-headers) ")"))) + (gnus-summary-print-truncate-and-quote + (mail-header-from gnus-current-headers) + 45) ")"))) (ps-right-header (list "/pagenumberstring load" @@ -7748,31 +8022,46 @@ to save in." (ps-despool filename)) (defun gnus-summary-show-article (&optional arg) - "Force re-fetching of the current article. + "Force redisplaying of the current article. If ARG (the prefix) is a number, show the article with the charset defined in `gnus-summary-show-article-charset-alist', or the charset -inputed. +input. If ARG (the prefix) is non-nil and not a number, show the raw article -without any article massaging functions being run." +without any article massaging functions being run. Normally, the key strokes +are `C-u g'." (interactive "P") (cond ((numberp arg) + (gnus-summary-show-article t) (let ((gnus-newsgroup-charset (or (cdr (assq arg gnus-summary-show-article-charset-alist)) - (read-coding-system "Charset: "))) + (mm-read-coding-system + "View as charset: " + (save-excursion + (set-buffer gnus-article-buffer) + (let ((coding-systems + (detect-coding-region (point) (point-max)))) + (or (car-safe coding-systems) + coding-systems)))))) (gnus-newsgroup-ignored-charsets 'gnus-all)) (gnus-summary-select-article nil 'force) (let ((deps gnus-newsgroup-dependencies) - head header) + head header lines) (save-excursion (set-buffer gnus-original-article-buffer) (save-restriction (message-narrow-to-head) - (setq head (buffer-string))) + (setq head (buffer-string)) + (goto-char (point-min)) + (unless (re-search-forward "^lines:[ \t]\\([0-9]+\\)" nil t) + (goto-char (point-max)) + (widen) + (setq lines (1- (count-lines (point) (point-max)))))) (with-temp-buffer (insert (format "211 %d Article retrieved.\n" (cdr gnus-article-current))) (insert head) + (if lines (insert (format "Lines: %d\n" lines))) (insert ".\n") (let ((nntp-server-buffer (current-buffer))) (setq header (car (gnus-get-newsgroup-headers deps t)))))) @@ -7780,7 +8069,9 @@ without any article massaging functions being run." (gnus-data-find (cdr gnus-article-current)) header) (gnus-summary-update-article-line - (cdr gnus-article-current) header)))) + (cdr gnus-article-current) header) + (when (gnus-summary-goto-subject (cdr gnus-article-current) nil t) + (gnus-summary-update-secondary-mark (cdr gnus-article-current)))))) ((not arg) ;; Select the article the normal way. (gnus-summary-select-article nil 'force)) @@ -7800,6 +8091,11 @@ without any article massaging functions being run." (gnus-summary-goto-subject gnus-current-article) (gnus-summary-position-point)) +(defun gnus-summary-show-raw-article () + "Show the raw article without any article massaging functions being run." + (interactive) + (gnus-summary-show-article t)) + (defun gnus-summary-verbose-headers (&optional arg) "Toggle permanent full header display. If ARG is a positive number, turn header display on. @@ -7912,10 +8208,6 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." (interactive "P") (unless action (setq action 'move)) - ;; Disable marking as read. - (let (gnus-mark-article-hook) - (save-window-excursion - (gnus-summary-select-article))) ;; Check whether the source group supports the required functions. (cond ((and (eq action 'move) (not (gnus-check-backend-function @@ -7927,7 +8219,7 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." (error "The current group does not support article editing"))) (let ((articles (gnus-summary-work-articles n)) (prefix (if (gnus-check-backend-function - 'request-move-article gnus-newsgroup-name) + 'request-move-article gnus-newsgroup-name) (gnus-group-real-prefix gnus-newsgroup-name) "")) (names '((move "Move" "Moving") @@ -7993,7 +8285,7 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." (mail-header-xref (gnus-summary-article-header article)) " "))) (setq new-xref (concat (gnus-group-real-name gnus-newsgroup-name) - ":" article)) + ":" (number-to-string article))) (unless xref (setq xref (list (system-name)))) (setq new-xref @@ -8010,7 +8302,8 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." (gnus-request-accept-article to-newsgroup select-method (not articles)))) (setq new-xref (concat new-xref " " (car art-group) - ":" (cdr art-group))) + ":" + (number-to-string (cdr art-group)))) ;; Now we have the new Xrefs header, so we insert ;; it and replace the new article. (nnheader-replace-header "Xref" new-xref) @@ -8032,7 +8325,7 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." (entry (gnus-gethash pto-group gnus-newsrc-hashtb)) (info (nth 2 entry)) - (to-group (gnus-info-group info)) + (to-group (gnus-info-group info)) to-marks) ;; Update the group that has been moved to. (when (and info @@ -8075,25 +8368,26 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." (setcdr gnus-newsgroup-active to-article)) (while marks - (when (memq article (symbol-value - (intern (format "gnus-newsgroup-%s" - (caar marks))))) - (push (cdar marks) to-marks) - ;; If the other group is the same as this group, - ;; then we have to add the mark to the list. - (when (equal to-group gnus-newsgroup-name) - (set (intern (format "gnus-newsgroup-%s" (caar marks))) - (cons to-article - (symbol-value - (intern (format "gnus-newsgroup-%s" - (caar marks))))))) - ;; Copy the marks to other group. - (gnus-add-marked-articles - to-group (cdar marks) (list to-article) info)) + (when (eq (gnus-article-mark-to-type (cdar marks)) 'list) + (when (memq article (symbol-value + (intern (format "gnus-newsgroup-%s" + (caar marks))))) + (push (cdar marks) to-marks) + ;; If the other group is the same as this group, + ;; then we have to add the mark to the list. + (when (equal to-group gnus-newsgroup-name) + (set (intern (format "gnus-newsgroup-%s" (caar marks))) + (cons to-article + (symbol-value + (intern (format "gnus-newsgroup-%s" + (caar marks))))))) + ;; Copy the marks to other group. + (gnus-add-marked-articles + to-group (cdar marks) (list to-article) info))) (setq marks (cdr marks))) (gnus-request-set-mark to-group (list (list (list to-article) - 'set + 'add to-marks)))) (gnus-dribble-enter @@ -8119,12 +8413,10 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." (gnus-summary-mark-article article gnus-canceled-mark)))) (gnus-summary-remove-process-mark article)) ;; Re-activate all groups that have been moved to. - (while to-groups - (save-excursion - (set-buffer gnus-group-buffer) - (when (gnus-group-goto-group (car to-groups) t) - (gnus-group-get-new-news-this-group 1 t)) - (pop to-groups))) + (save-excursion + (set-buffer gnus-group-buffer) + (let ((gnus-group-marked to-groups)) + (gnus-group-get-new-news-this-group nil t))) (gnus-kill-buffer copy-buf) (gnus-summary-position-point) @@ -8144,10 +8436,9 @@ re-spool using this method." (gnus-summary-move-article n nil nil 'crosspost)) (defcustom gnus-summary-respool-default-method nil - "Default method for respooling an article. + "Default method type for respooling an article. If nil, use to the current newsgroup method." - :type '(choice (gnus-select-method :value (nnml "")) - (const nil)) + :type 'symbol :group 'gnus-summary-mail) (defun gnus-summary-respool-article (&optional n method) @@ -8210,7 +8501,15 @@ latter case, they will be copied into the relevant groups." (erase-buffer) (nnheader-insert-file-contents file) (goto-char (point-min)) - (unless (nnheader-article-p) + (if (nnheader-article-p) + (save-restriction + (goto-char (point-min)) + (search-forward "\n\n" nil t) + (narrow-to-region (point-min) (1- (point))) + (goto-char (point-min)) + (unless (re-search-forward "^date:" nil t) + (goto-char (point-max)) + (insert "Date: " (message-make-date (nth 5 atts)) "\n"))) ;; This doesn't look like an article, so we fudge some headers. (setq atts (file-attributes file) lines (count-lines (point-min) (point-max))) @@ -8431,7 +8730,7 @@ groups." (if (and (not read-only) (not (gnus-request-replace-article (cdr gnus-article-current) (car gnus-article-current) - (current-buffer) t))) + (current-buffer) t))) (error "Couldn't replace article") ;; Update the summary buffer. (if (and references @@ -8461,10 +8760,17 @@ groups." (gnus-data-find (cdr gnus-article-current)) header) (gnus-summary-update-article-line - (cdr gnus-article-current) header)))))) + (cdr gnus-article-current) header) + (if (gnus-summary-goto-subject + (cdr gnus-article-current) nil t) + (gnus-summary-update-secondary-mark + (cdr gnus-article-current)))))))) ;; Update threads. (set-buffer (or buffer gnus-summary-buffer)) - (gnus-summary-update-article (cdr gnus-article-current))) + (gnus-summary-update-article (cdr gnus-article-current)) + (if (gnus-summary-goto-subject (cdr gnus-article-current) nil t) + (gnus-summary-update-secondary-mark + (cdr gnus-article-current)))) ;; Prettify the article buffer again. (unless no-highlight (save-excursion @@ -8491,6 +8797,13 @@ groups." (execute-kbd-macro (concat (this-command-keys) key)) (gnus-article-edit-done)) +(defun gnus-summary-toggle-smiley (&optional arg) + "Toggle the display of smilies as small graphical icons." + (interactive "P") + (save-excursion + (set-buffer gnus-article-buffer) + (gnus-smiley-display arg))) + ;;; Respooling (defun gnus-summary-respool-query (&optional silent trace) @@ -8599,8 +8912,8 @@ number of articles marked is returned." (while (and (> n 0) (if unmark - (gnus-summary-remove-process-mark - (gnus-summary-article-number)) + (gnus-summary-remove-process-mark + (gnus-summary-article-number)) (gnus-summary-set-process-mark (gnus-summary-article-number))) (zerop (gnus-summary-next-subject (if backward -1 1) nil t))) (setq n (1- n))) @@ -8633,9 +8946,9 @@ the actual number of articles unmarked is returned." (error "No such mark type: %s" type) (setq var (intern (format "gnus-newsgroup-%s" type))) (set var (cons article (symbol-value var))) - (if (memq type '(processable cached replied forwarded saved)) + (if (memq type '(processable cached replied forwarded recent saved)) (gnus-summary-update-secondary-mark article) - ;;; !!! This is bobus. We should find out what primary + ;;; !!! This is bogus. We should find out what primary ;;; !!! mark we want to set. (gnus-summary-update-mark gnus-del-mark 'unread))))) @@ -8848,7 +9161,7 @@ Iff NO-EXPIRE, auto-expiry will be inhibited." (setq mark gnus-del-mark)) (when (and (not no-expire) gnus-newsgroup-auto-expire - (memq mark gnus-auto-expirable-marks)) + (memq mark gnus-auto-expirable-marks)) (setq mark gnus-expirable-mark)) (let ((article (or article (gnus-summary-article-number))) (old-mark (gnus-summary-article-mark article))) @@ -8895,6 +9208,10 @@ Iff NO-EXPIRE, auto-expiry will be inhibited." gnus-forwarded-mark) ((memq article gnus-newsgroup-saved) gnus-saved-mark) + ((memq article gnus-newsgroup-recent) + gnus-recent-mark) + ((memq article gnus-newsgroup-unseen) + gnus-unseen-mark) (t gnus-no-mark)) 'replied) (when (gnus-visual-p 'summary-highlight 'highlight) @@ -8903,7 +9220,7 @@ Iff NO-EXPIRE, auto-expiry will be inhibited." (defun gnus-summary-update-mark (mark type) (let ((forward (cdr (assq type gnus-summary-mark-positions))) - (buffer-read-only nil)) + (buffer-read-only nil)) (re-search-backward "[\n\r]" (gnus-point-at-bol) 'move-to-limit) (when forward (when (looking-at "\r") @@ -9040,7 +9357,7 @@ The difference between N and the number of marks cleared is returned." (gnus-summary-mark-article gnus-current-article gnus-read-mark)))) (defun gnus-summary-mark-unread-as-ticked () - "Intended to be used by `gnus-summary-mark-article-hook'." + "Intended to be used by `gnus-summary-mark-article-hook'." (when (memq gnus-current-article gnus-newsgroup-unreads) (gnus-summary-mark-article gnus-current-article gnus-ticked-mark))) @@ -9128,7 +9445,7 @@ even ticked and dormant ones." (goto-char (point-min)) (push gnus-newsgroup-limit gnus-newsgroup-limits) (setq gnus-newsgroup-limit (copy-sequence gnus-newsgroup-limit)) - (mapcar (lambda (x) (push (mail-header-number x) + (mapcar (lambda (x) (push (mail-header-number x) gnus-newsgroup-limit)) headers) (gnus-summary-prepare-unthreaded (nreverse headers)) @@ -9362,6 +9679,8 @@ is non-nil or the Subject: of both articles are the same." (set-buffer gnus-summary-buffer) (gnus-summary-unmark-all-processable) (gnus-summary-update-article current-article) + (if (gnus-summary-goto-subject (cdr gnus-article-current) nil t) + (gnus-summary-update-secondary-mark (cdr gnus-article-current))) (gnus-summary-rethread-current) (gnus-message 3 "Article %d is now the child of article %d" current-article parent-article))))) @@ -9661,7 +9980,9 @@ The variable `gnus-default-article-saver' specifies the saver function." (gnus-message 1 "Article %d is unsaveable" article)) ;; This is a real article. (save-window-excursion - (gnus-summary-select-article t nil nil article)) + (let ((gnus-display-mime-function nil) + (gnus-article-prepare-hook nil)) + (gnus-summary-select-article t nil nil article))) (save-excursion (set-buffer save-buffer) (erase-buffer) @@ -9685,7 +10006,10 @@ pipe those articles instead." (require 'gnus-art) (let ((gnus-default-article-saver 'gnus-summary-save-in-pipe)) (gnus-summary-save-article arg t)) - (gnus-configure-windows 'pipe)) + (let ((buffer (get-buffer "*Shell Command Output*"))) + (if (and buffer + (with-current-buffer buffer (> (point-max) (point-min)))) + (gnus-configure-windows 'pipe)))) (defun gnus-summary-save-article-mail (&optional arg) "Append the current article to an mail file. @@ -9742,6 +10066,17 @@ save those articles instead." (let ((gnus-default-article-saver 'gnus-summary-save-body-in-file)) (gnus-summary-save-article arg))) +(defun gnus-summary-muttprint (&optional arg) + "Print the current article using Muttprint. +If N is a positive number, save the N next articles. +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") + (require 'gnus-art) + (let ((gnus-default-article-saver 'gnus-summary-pipe-to-muttprint)) + (gnus-summary-save-article arg t))) + (defun gnus-summary-pipe-message (program) "Pipe the current article through PROGRAM." (interactive "sProgram: ") @@ -9749,11 +10084,11 @@ save those articles instead." (let ((mail-header-separator "")) (gnus-eval-in-buffer-window gnus-article-buffer (save-restriction - (widen) - (let ((start (window-start)) - buffer-read-only) - (message-pipe-buffer-body program) - (set-window-start (get-buffer-window (current-buffer)) start)))))) + (widen) + (let ((start (window-start)) + buffer-read-only) + (message-pipe-buffer-body program) + (set-window-start (get-buffer-window (current-buffer)) start)))))) (defun gnus-get-split-value (methods) "Return a value based on the split METHODS." @@ -9828,7 +10163,7 @@ save those articles instead." (nreverse split-name)) nil nil nil 'gnus-group-history)))) - (to-method (gnus-server-to-method (gnus-group-method to-newsgroup)))) + (to-method (gnus-server-to-method (gnus-group-method to-newsgroup)))) (when to-newsgroup (if (or (string= to-newsgroup "") (string= to-newsgroup prefix)) @@ -10592,7 +10927,7 @@ returned." (gnus-set-difference articles (mapcar (lambda (h) (mail-header-number h)) gnus-newsgroup-headers))) - (setq gnus-newsgroup-headers + (setq gnus-newsgroup-headers (merge 'list gnus-newsgroup-headers (gnus-fetch-headers articles) @@ -10600,12 +10935,12 @@ returned." ;; Suppress duplicates? (when gnus-suppress-duplicates (gnus-dup-suppress-articles)) - + ;; We might want to build some more threads first. (when (and gnus-fetch-old-headers (eq gnus-headers-retrieved-by 'nov)) (if (eq gnus-fetch-old-headers 'invisible) - (gnus-build-all-threads) + (gnus-build-all-threads) (gnus-build-old-threads))) ;; Let the Gnus agent mark articles as read. (when gnus-agent @@ -10636,9 +10971,9 @@ If ALL is a number, fetch this number of articles." (or (memq i old) (push i older)) (incf i)) (setq len (length older)) - (cond + (cond ((null older) nil) - ((numberp all) + ((numberp all) (if (< all len) (setq older (subseq older 0 all)))) (all nil) @@ -10649,10 +10984,10 @@ If ALL is a number, fetch this number of articles." (read-string (format "How many articles from %s (default %d): " - (gnus-limit-string + (gnus-limit-string (gnus-group-decoded-name gnus-newsgroup-name) 35) len)))) - (unless (string-match "^[ \t]*$" input) + (unless (string-match "^[ \t]*$" input) (setq all (string-to-number input)) (if (< all len) (setq older (subseq older 0 all)))))))) @@ -10670,7 +11005,7 @@ If ALL is a number, fetch this number of articles." (old-active gnus-newsgroup-active) (nnmail-fetched-sources (list t)) i new) - (setq gnus-newsgroup-active + (setq gnus-newsgroup-active (gnus-activate-group gnus-newsgroup-name 'scan)) (setq i (1+ (cdr old-active))) (while (<= i (cdr gnus-newsgroup-active)) @@ -10678,7 +11013,7 @@ If ALL is a number, fetch this number of articles." (incf i)) (if (not new) (message "No gnus is bad news.") - (setq new (nreverse new)) + (setq new (nreverse new)) (gnus-summary-insert-articles new) (setq gnus-newsgroup-unreads (append gnus-newsgroup-unreads new))