X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;ds=sidebyside;f=lisp%2Fgnus-sum.el;h=b0864383c2cc2572a87d7ae305884bbbd6cd2df5;hb=0faa85a7d606b33a6d7c8e0c87ea489291c873b8;hp=a101f8a88e39a70c28c6fe132612e7eff67eb1b0;hpb=e85b83e8b076986fb7b0b0d805fbf3daec45e941;p=elisp%2Fgnus.git- diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el index a101f8a..b086438 100644 --- a/lisp/gnus-sum.el +++ b/lisp/gnus-sum.el @@ -1,8 +1,9 @@ -;;; gnus-sum.el --- summary mode commands for Gnus -;; Copyright (C) 1996,97 Free Software Foundation, Inc. +;;; gnus-sum.el --- summary mode commands for Semi-gnus +;; Copyright (C) 1996,97,98 Free Software Foundation, Inc. -;; Author: Lars Magne Ingebrigtsen -;; Keywords: news +;; Author: Lars Magne Ingebrigtsen +;; MORIOKA Tomohiko +;; Keywords: mail, news, MIME ;; This file is part of GNU Emacs. @@ -33,7 +34,11 @@ (require 'gnus-range) (require 'gnus-int) (require 'gnus-undo) +(require 'std11) +(require 'mime-view) + (autoload 'gnus-summary-limit-include-cached "gnus-cache" nil t) +(autoload 'gnus-set-summary-default-charset "gnus-i18n" nil t) (defcustom gnus-kill-summary-on-exit t "*If non-nil, kill the summary buffer when you exit from it. @@ -122,9 +127,12 @@ comparing subjects." (defcustom gnus-simplify-subject-functions nil "List of functions taking a string argument that simplify subjects. -The functions are applied recursively." +The functions are applied recursively. + +Useful functions to put in this list include: `gnus-simplify-subject-re', +`gnus-simplify-subject-fuzzy' and `gnus-simplify-whitespace'." :group 'gnus-thread - :type '(repeat (list function))) + :type '(repeat function)) (defcustom gnus-simplify-ignored-prefixes nil "*Regexp, matches for which are removed from subject lines when simplifying fuzzily." @@ -145,7 +153,7 @@ non-nil and non-`some', fill in all gaps that Gnus manages to guess." (defcustom gnus-summary-thread-gathering-function 'gnus-gather-threads-by-subject - "Function used for gathering loose threads. + "*Function used for gathering loose threads. There are two pre-defined functions: `gnus-gather-threads-by-subject', which only takes Subjects into consideration; and `gnus-gather-threads-by-references', which compared the References @@ -322,7 +330,7 @@ variable." :group 'gnus-article-various :type 'boolean) -(defcustom gnus-show-mime nil +(defcustom gnus-show-mime t "*If non-nil, do mime processing of articles. The articles will simply be fed to the function given by `gnus-show-mime-method'." @@ -333,9 +341,9 @@ The articles will simply be fed to the function given by "*Variable used to suggest where articles are to be moved to. It uses the same syntax as the `gnus-split-methods' variable." :group 'gnus-summary-mail - :type '(repeat (choice (list function) - (cons regexp (repeat string)) - sexp))) + :type '(repeat (choice (list :value (fun) function) + (cons :value ("" "") regexp (repeat string)) + (sexp :value nil)))) (defcustom gnus-unread-mark ? "*Mark used for unread articles." @@ -489,7 +497,7 @@ list of parameters to that command." :type 'boolean) (defcustom gnus-summary-dummy-line-format - "* %(: :%) %S\n" + " %(: :%) %S\n" "*The format specification for the dummy roots in the summary buffer. It works along the same lines as a normal formatting string, with some simple extensions. @@ -612,6 +620,11 @@ If you want to modify the summary buffer, you can use this hook." :group 'gnus-summary-various :type 'hook) +(defcustom gnus-summary-prepared-hook nil + "*A hook called as the last thing after the summary buffer has been generated." + :group 'gnus-summary-various + :type 'hook) + (defcustom gnus-summary-generate-hook nil "*A hook run just before generating the summary buffer. This hook is commonly used to customize threading variables and the @@ -651,19 +664,24 @@ is not run if `gnus-visual' is nil." :group 'gnus-summary-visual :type 'hook) -;; 1997/5/4 by MORIOKA Tomohiko -(defcustom gnus-structured-field-decoder 'identity +(defcustom gnus-structured-field-decoder + #'eword-decode-and-unfold-structured-field "Function to decode non-ASCII characters in structured field for summary." :group 'gnus-various :type 'function) -(defcustom gnus-unstructured-field-decoder 'identity +(defcustom gnus-unstructured-field-decoder + (function + (lambda (string) + (eword-decode-unstructured-field-body + (std11-unfold-string string) 'must-unfold) + )) "Function to decode non-ASCII characters in unstructured field for summary." :group 'gnus-various :type 'function) (defcustom gnus-parse-headers-hook - (list 'gnus-hack-decode-rfc1522 'gnus-decode-rfc1522) + '(gnus-set-summary-default-charset) "*A hook called before parsing the headers." :group 'gnus-various :type 'hook) @@ -730,7 +748,15 @@ automatically when it is selected." . gnus-summary-high-unread-face) ((and (< score default) (= mark gnus-unread-mark)) . gnus-summary-low-unread-face) - ((and (= mark gnus-unread-mark)) + ((= mark gnus-unread-mark) + . gnus-summary-normal-unread-face) + ((and (> score default) (memq mark (list gnus-downloadable-mark + gnus-undownloaded-mark))) + . gnus-summary-high-unread-face) + ((and (< score default) (memq mark (list gnus-downloadable-mark + gnus-undownloaded-mark))) + . gnus-summary-low-unread-face) + ((memq mark (list gnus-downloadable-mark gnus-undownloaded-mark)) . gnus-summary-normal-unread-face) ((> score default) . gnus-summary-high-read-face) @@ -738,7 +764,7 @@ automatically when it is selected." . gnus-summary-low-read-face) (t . gnus-summary-normal-read-face)) - "Controls the highlighting of summary buffer lines. + "*Controls the highlighting of summary buffer lines. A list of (FORM . FACE) pairs. When deciding how a a particular summary line should be displayed, each form is evaluated. The content @@ -801,7 +827,7 @@ which it may alter in any way.") (?x ,(macroexpand '(mail-header-xref gnus-tmp-header)) ?s) (?D ,(macroexpand '(mail-header-date gnus-tmp-header)) ?s) (?d (gnus-dd-mmm (mail-header-date gnus-tmp-header)) ?s) - (?o (gnus-date-iso8601 gnus-tmp-header) ?s) + (?o (gnus-date-iso8601 (mail-header-date gnus-tmp-header)) ?s) (?M ,(macroexpand '(mail-header-id gnus-tmp-header)) ?s) (?r ,(macroexpand '(mail-header-references gnus-tmp-header)) ?s) (?c (or (mail-header-chars gnus-tmp-header) 0) ?d) @@ -1065,6 +1091,10 @@ See `gnus-simplify-buffer-fuzzy' for details." (save-excursion (gnus-set-work-buffer) (let ((case-fold-search t)) + ;; Remove uninteresting prefixes. + (when (and gnus-simplify-ignored-prefixes + (string-match gnus-simplify-ignored-prefixes subject)) + (setq subject (substring subject (match-end 0)))) (insert subject) (inline (gnus-simplify-buffer-fuzzy)) (buffer-string)))) @@ -1116,7 +1146,9 @@ increase the score of each group you read." " " gnus-summary-next-page "\177" gnus-summary-prev-page [delete] gnus-summary-prev-page + [backspace] gnus-summary-prev-page "\r" gnus-summary-scroll-up + "\e\r" gnus-summary-scroll-down "n" gnus-summary-next-unread-article "p" gnus-summary-prev-unread-article "N" gnus-summary-next-article @@ -1198,9 +1230,11 @@ increase the score of each group you read." "t" gnus-article-hide-headers "g" gnus-summary-show-article "l" gnus-summary-goto-last-article + "v" gnus-summary-preview-mime-message "\C-c\C-v\C-v" gnus-uu-decode-uu-view "\C-d" gnus-summary-enter-digest-group "\M-\C-d" gnus-summary-read-document + "\M-\C-e" gnus-summary-edit-parameters "\C-c\C-b" gnus-bug "*" gnus-cache-enter-article "\M-*" gnus-cache-remove-article @@ -1340,7 +1374,6 @@ increase the score of each group you read." "e" gnus-article-emphasize "w" gnus-article-fill-cited-article "c" gnus-article-remove-cr - "q" gnus-article-de-quoted-unreadable "f" gnus-article-display-x-face "l" gnus-summary-stop-page-breaking "r" gnus-summary-caesar-message @@ -1372,6 +1405,7 @@ increase the score of each group you read." "l" gnus-article-date-local "e" gnus-article-date-lapsed "o" gnus-article-date-original + "i" gnus-article-date-iso8601 "s" gnus-article-date-user) (gnus-define-keys (gnus-summary-wash-empty-map "E" gnus-summary-wash-map) @@ -1379,6 +1413,7 @@ increase the score of each group you read." "l" gnus-article-strip-leading-blank-lines "m" gnus-article-strip-multiple-blank-lines "a" gnus-article-strip-blank-lines + "A" gnus-article-strip-all-blank-lines "s" gnus-article-strip-leading-space) (gnus-define-keys (gnus-summary-help-map "H" gnus-summary-mode-map) @@ -1447,210 +1482,110 @@ increase the score of each group you read." ["Increase score..." gnus-summary-increase-score t] ["Lower score..." gnus-summary-lower-score t])))) - '(("Default header" - ["Ask" (gnus-score-set-default 'gnus-score-default-header nil) - :style radio - :selected (null gnus-score-default-header)] - ["From" (gnus-score-set-default 'gnus-score-default-header 'a) - :style radio - :selected (eq gnus-score-default-header 'a)] - ["Subject" (gnus-score-set-default 'gnus-score-default-header 's) - :style radio - :selected (eq gnus-score-default-header 's)] - ["Article body" - (gnus-score-set-default 'gnus-score-default-header 'b) - :style radio - :selected (eq gnus-score-default-header 'b )] - ["All headers" - (gnus-score-set-default 'gnus-score-default-header 'h) - :style radio - :selected (eq gnus-score-default-header 'h )] - ["Message-ID" (gnus-score-set-default 'gnus-score-default-header 'i) - :style radio - :selected (eq gnus-score-default-header 'i )] - ["Thread" (gnus-score-set-default 'gnus-score-default-header 't) - :style radio - :selected (eq gnus-score-default-header 't )] - ["Crossposting" - (gnus-score-set-default 'gnus-score-default-header 'x) - :style radio - :selected (eq gnus-score-default-header 'x )] - ["Lines" (gnus-score-set-default 'gnus-score-default-header 'l) - :style radio - :selected (eq gnus-score-default-header 'l )] - ["Date" (gnus-score-set-default 'gnus-score-default-header 'd) - :style radio - :selected (eq gnus-score-default-header 'd )] - ["Followups to author" - (gnus-score-set-default 'gnus-score-default-header 'f) - :style radio - :selected (eq gnus-score-default-header 'f )]) - ("Default type" - ["Ask" (gnus-score-set-default 'gnus-score-default-type nil) - :style radio - :selected (null gnus-score-default-type)] - ;; The `:active' key is commented out in the following, - ;; because the GNU Emacs hack to support radio buttons use - ;; active to indicate which button is selected. - ["Substring" (gnus-score-set-default 'gnus-score-default-type 's) - :style radio - ;; :active (not (memq gnus-score-default-header '(l d))) - :selected (eq gnus-score-default-type 's)] - ["Regexp" (gnus-score-set-default 'gnus-score-default-type 'r) - :style radio - ;; :active (not (memq gnus-score-default-header '(l d))) - :selected (eq gnus-score-default-type 'r)] - ["Exact" (gnus-score-set-default 'gnus-score-default-type 'e) - :style radio - ;; :active (not (memq gnus-score-default-header '(l d))) - :selected (eq gnus-score-default-type 'e)] - ["Fuzzy" (gnus-score-set-default 'gnus-score-default-type 'f) - :style radio - ;; :active (not (memq gnus-score-default-header '(l d))) - :selected (eq gnus-score-default-type 'f)] - ["Before date" (gnus-score-set-default 'gnus-score-default-type 'b) - :style radio - ;; :active (eq (gnus-score-default-header 'd)) - :selected (eq gnus-score-default-type 'b)] - ["At date" (gnus-score-set-default 'gnus-score-default-type 'n) - :style radio - ;; :active (eq (gnus-score-default-header 'd)) - :selected (eq gnus-score-default-type 'n)] - ["After date" (gnus-score-set-default 'gnus-score-default-type 'a) - :style radio - ;; :active (eq (gnus-score-default-header 'd)) - :selected (eq gnus-score-default-type 'a)] - ["Less than number" - (gnus-score-set-default 'gnus-score-default-type '<) - :style radio - ;; :active (eq (gnus-score-default-header 'l)) - :selected (eq gnus-score-default-type '<)] - ["Equal to number" - (gnus-score-set-default 'gnus-score-default-type '=) - :style radio - ;; :active (eq (gnus-score-default-header 'l)) - :selected (eq gnus-score-default-type '=)] - ["Greater than number" - (gnus-score-set-default 'gnus-score-default-type '>) - :style radio - ;; :active (eq (gnus-score-default-header 'l)) - :selected (eq gnus-score-default-type '>)]) - ["Default fold" gnus-score-default-fold-toggle - :style toggle - :selected gnus-score-default-fold] - ("Default duration" - ["Ask" (gnus-score-set-default 'gnus-score-default-duration nil) - :style radio - :selected (null gnus-score-default-duration)] - ["Permanent" - (gnus-score-set-default 'gnus-score-default-duration 'p) - :style radio - :selected (eq gnus-score-default-duration 'p)] - ["Temporary" - (gnus-score-set-default 'gnus-score-default-duration 't) - :style radio - :selected (eq gnus-score-default-duration 't)] - ["Immediate" - (gnus-score-set-default 'gnus-score-default-duration 'i) - :style radio - :selected (eq gnus-score-default-duration 'i)])) - - (easy-menu-define - gnus-summary-article-menu gnus-summary-mode-map "" - '("Article" - ("Hide" - ["All" gnus-article-hide t] - ["Headers" gnus-article-hide-headers t] - ["Signature" gnus-article-hide-signature t] - ["Citation" gnus-article-hide-citation t] - ["PGP" gnus-article-hide-pgp 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] - ["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] - ["Leading space" gnus-article-strip-leading-space 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] - ["CR" gnus-article-remove-cr t] - ["Show X-Face" gnus-article-display-x-face t] - ["Quoted-Printable" gnus-article-de-quoted-unreadable t] - ["UnHTMLize" gnus-article-treat-html t] - ["Rot 13" gnus-summary-caesar-message 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]) - ("Output" - ["Save in default format" gnus-summary-save-article t] - ["Save in file" gnus-summary-save-article-file 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" 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] - ["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] - ["Delete expirable articles" gnus-summary-expire-articles-now - (gnus-check-backend-function - 'request-expire-articles gnus-newsgroup-name)]) - ("Extract" - ["Uudecode" gnus-uu-decode-uu 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]) - ["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] - ["Redisplay" gnus-summary-show-article t])) + ;; 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-hide-headers t] + ["Signature" gnus-article-hide-signature t] + ["Citation" gnus-article-hide-citation t] + ["PGP" gnus-article-hide-pgp 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]) + ["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] + ["CR" gnus-article-remove-cr t] + ["Show X-Face" gnus-article-display-x-face t] + ["UnHTMLize" gnus-article-treat-html t] + ["Rot 13" gnus-summary-caesar-message 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]) + ("Output" + ["Save in default format" gnus-summary-save-article t] + ["Save in file" gnus-summary-save-article-file 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" 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] + ["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] + ["Delete expirable articles" gnus-summary-expire-articles-now + (gnus-check-backend-function + 'request-expire-articles gnus-newsgroup-name)]) + ("Extract" + ["Uudecode" gnus-uu-decode-uu 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]) + ["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] + ["Redisplay" gnus-summary-show-article t]))) + (easy-menu-define + gnus-summary-article-menu gnus-summary-mode-map "" + (cons "Article" innards)) + + (easy-menu-define + gnus-article-commands-menu gnus-article-mode-map "" + (cons "Commands" innards))) (easy-menu-define gnus-summary-thread-menu gnus-summary-mode-map "" @@ -1741,7 +1676,9 @@ increase the score of each group you read." ["Mark above" gnus-uu-mark-over t] ["Mark series" gnus-uu-mark-series t] ["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] ["Mark all" gnus-uu-mark-all t] ["Mark buffer" gnus-uu-mark-buffer t] ["Mark sparse" gnus-uu-mark-sparse t] @@ -1800,6 +1737,7 @@ increase the score of each group you read." 'request-expire-articles gnus-newsgroup-name)] ["Edit local kill file" gnus-summary-edit-local-kill t] ["Edit main kill file" gnus-summary-edit-global-kill t] + ["Edit group parameters" gnus-summary-edit-parameters t] ("Exit" ["Catchup and exit" gnus-summary-catchup-and-exit t] ["Catchup all and exit" gnus-summary-catchup-and-exit t] @@ -1812,7 +1750,7 @@ increase the score of each group you read." ["Rescan group" gnus-summary-rescan-group t] ["Update dribble" gnus-summary-save-newsrc t]))) - (run-hooks 'gnus-summary-menu-hook))) + (gnus-run-hooks 'gnus-summary-menu-hook))) (defun gnus-score-set-default (var value) "A version of set that updates the GNU Emacs menu-bar." @@ -1940,12 +1878,14 @@ The following commands are available: (setq gnus-newsgroup-name group) (make-local-variable 'gnus-summary-line-format) (make-local-variable 'gnus-summary-line-format-spec) + (make-local-variable 'gnus-summary-dummy-line-format) + (make-local-variable 'gnus-summary-dummy-line-format-spec) (make-local-variable 'gnus-summary-mark-positions) (make-local-hook 'post-command-hook) (add-hook 'post-command-hook 'gnus-clear-inboxes-moved nil t) (make-local-hook 'pre-command-hook) (add-hook 'pre-command-hook 'gnus-set-global-variables nil t) - (run-hooks 'gnus-summary-mode-hook) + (gnus-run-hooks 'gnus-summary-mode-hook) (gnus-update-format-specifications nil 'summary 'summary-mode 'summary-dummy) (gnus-update-summary-mark-positions)) @@ -2156,10 +2096,12 @@ article number." (gnus-summary-last-subject)))) (defmacro gnus-summary-article-header (&optional number) + "Return the header of article NUMBER." `(gnus-data-header (gnus-data-find ,(or number '(gnus-summary-article-number))))) (defmacro gnus-summary-thread-level (&optional number) + "Return the level of thread that starts with article NUMBER." `(if (and (eq gnus-summary-make-false-root 'dummy) (get-text-property (point) 'gnus-intangible)) 0 @@ -2167,10 +2109,12 @@ article number." ,(or number '(gnus-summary-article-number)))))) (defmacro gnus-summary-article-mark (&optional number) + "Return the mark of article NUMBER." `(gnus-data-mark (gnus-data-find ,(or number '(gnus-summary-article-number))))) (defmacro gnus-summary-article-pos (&optional number) + "Return the position of the line of article NUMBER." `(gnus-data-pos (gnus-data-find ,(or number '(gnus-summary-article-number))))) @@ -2193,6 +2137,7 @@ article number." gnus-summary-default-score 0)) (defun gnus-summary-article-children (&optional number) + "Return a list of article numbers that are children of article NUMBER." (let* ((data (gnus-data-find-list (or number (gnus-summary-article-number)))) (level (gnus-data-level (car data))) l children) @@ -2204,6 +2149,7 @@ article number." (nreverse children))) (defun gnus-summary-article-parent (&optional number) + "Return the article number of the parent of article NUMBER." (let* ((data (gnus-data-find-list (or number (gnus-summary-article-number)) (gnus-data-list t))) (level (gnus-data-level (car data)))) @@ -2228,6 +2174,11 @@ This is all marks except unread, ticked, dormant, and expirable." (= mark gnus-expirable-mark)))) (defmacro gnus-article-mark (number) + "Return the MARK of article NUMBER. +This macro should only be used when computing the mark the \"first\" +time; i.e., when generating the summary lines. After that, +`gnus-summary-article-mark' should be used to examine the +marks of articles." `(cond ((memq ,number gnus-newsgroup-unsendable) gnus-unsendable-mark) ((memq ,number gnus-newsgroup-undownloaded) gnus-undownloaded-mark) @@ -2294,6 +2245,8 @@ This is all marks except unread, ticked, dormant, and expirable." ;; selective display). (aset table ?\n nil) (aset table ?\r nil) + ;; We keep TAB as well. + (aset table ?\t nil) ;; We nix out any glyphs over 126 that are not set already. (let ((i 256)) (while (>= (setq i (1- i)) 127) @@ -2388,9 +2341,7 @@ This is all marks except unread, ticked, dormant, and expirable." (defun gnus-update-summary-mark-positions () "Compute where the summary marks are to go." (save-excursion - (when (and gnus-summary-buffer - (get-buffer gnus-summary-buffer) - (buffer-name (get-buffer gnus-summary-buffer))) + (when (gnus-buffer-exists-p gnus-summary-buffer) (set-buffer gnus-summary-buffer)) (let ((gnus-replied-mark 129) (gnus-score-below-mark 130) @@ -2479,7 +2430,7 @@ This is all marks except unread, ticked, dormant, and expirable." 'gnus-number gnus-tmp-number) (when (gnus-visual-p 'summary-highlight 'highlight) (forward-line -1) - (run-hooks 'gnus-summary-update-hook) + (gnus-run-hooks 'gnus-summary-update-hook) (forward-line 1)))) (defun gnus-summary-update-line (&optional dont-update) @@ -2511,7 +2462,7 @@ This is all marks except unread, ticked, dormant, and expirable." 'score)) ;; Do visual highlighting. (when (gnus-visual-p 'summary-highlight 'highlight) - (run-hooks 'gnus-summary-update-hook))))) + (gnus-run-hooks 'gnus-summary-update-hook))))) (defvar gnus-tmp-new-adopts nil) @@ -2553,14 +2504,13 @@ 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) - '(quit-config to-address to-list to-group))) + (not (memq (car elem) '(quit-config))) ; Ignore quit-config. (ignore-errors ; So we set it. (make-local-variable (car elem)) (set (car elem) (eval (nth 1 elem)))))))) (defun gnus-summary-read-group (group &optional show-all no-article - kill-buffer no-display) + kill-buffer no-display backward) "Start reading news in newsgroup GROUP. If SHOW-ALL is non-nil, already read articles are also listed. If NO-ARTICLE is non-nil, no article is selected initially. @@ -2575,6 +2525,11 @@ If NO-DISPLAY, don't generate a summary buffer." (setq show-all nil))))) (eq gnus-auto-select-next 'quietly)) (set-buffer gnus-group-buffer) + ;; The entry function called above goes to the next + ;; group automatically, so we go two groups back + ;; if we are searching for the previous group. + (when backward + (gnus-group-prev-unread-group 2)) (if (not (equal group (gnus-group-group-name))) (setq group (gnus-group-group-name)) (setq group nil))) @@ -2642,7 +2597,7 @@ If NO-DISPLAY, don't generate a summary buffer." (gnus-copy-sequence (gnus-active gnus-newsgroup-name))) ;; You can change the summary buffer in some way with this hook. - (run-hooks 'gnus-select-group-hook) + (gnus-run-hooks 'gnus-select-group-hook) ;; Set any local variables in the group parameters. (gnus-summary-set-local-parameters gnus-newsgroup-name) (gnus-update-format-specifications @@ -2680,7 +2635,7 @@ If NO-DISPLAY, don't generate a summary buffer." ((and gnus-newsgroup-scored show-all) (gnus-summary-limit-include-expunged t)))) ;; Function `gnus-apply-kill-file' must be called in this hook. - (run-hooks 'gnus-apply-kill-hook) + (gnus-run-hooks 'gnus-apply-kill-hook) (if (and (zerop (buffer-size)) (not no-display)) (progn @@ -2712,8 +2667,8 @@ If NO-DISPLAY, don't generate a summary buffer." ;; article in the group. (goto-char (point-min)) (gnus-summary-position-point) - (gnus-set-mode-line 'summary) - (gnus-configure-windows 'summary 'force)) + (gnus-configure-windows 'summary 'force) + (gnus-set-mode-line 'summary)) (when (get-buffer-window gnus-group-buffer t) ;; Gotta use windows, because recenter does weird stuff if ;; the current buffer ain't the displayed window. @@ -2724,6 +2679,7 @@ If NO-DISPLAY, don't generate a summary buffer." (select-window owin))) ;; Mark this buffer as "prepared". (setq gnus-newsgroup-prepared t) + (gnus-run-hooks 'gnus-summary-prepared-hook) t))))) (defun gnus-summary-prepare () @@ -2733,7 +2689,7 @@ If NO-DISPLAY, don't generate a summary buffer." (erase-buffer) (setq gnus-newsgroup-data nil gnus-newsgroup-data-reverse nil) - (run-hooks 'gnus-summary-generate-hook) + (gnus-run-hooks 'gnus-summary-generate-hook) ;; Generate the buffer, either with threads or without. (when gnus-newsgroup-headers (gnus-summary-prepare-threads @@ -2747,7 +2703,7 @@ If NO-DISPLAY, don't generate a summary buffer." (setq gnus-newsgroup-data (nreverse gnus-newsgroup-data)) ;; Call hooks for modifying summary buffer. (goto-char (point-min)) - (run-hooks 'gnus-summary-prepare-hook))) + (gnus-run-hooks 'gnus-summary-prepare-hook))) (defsubst gnus-general-simplify-subject (subject) "Simply subject by the same rules as gnus-gather-threads-by-subject." @@ -2911,9 +2867,88 @@ If NO-DISPLAY, don't generate a summary buffer." gnus-newsgroup-dependencies))) threads)) +;; Build the thread tree. +(defun gnus-dependencies-add-header (header dependencies force-new) + "Enter HEADER into the DEPENDENCIES table if it is not already there. + +If FORCE-NEW is not NIL, enter HEADER into the DEPENDENCIES table even +if it was already present. + +If `gnus-summary-ignore-duplicates' is NIL then duplicate Message-IDs +will not be entered in the DEPENDENCIES table. Otherwise duplicate +Message-IDs will be renamed be renamed to a unique Message-ID before +being entered. + +Returns HEADER if it was entered in the DEPENDENCIES. Returns NIL otherwise." + + (let* ((id (mail-header-id header)) + (id-dep (and id (intern id dependencies))) + ref ref-dep ref-header) + ;; Enter this `header' in the `dependencies' table + (cond + ((not id-dep) + (setq header nil)) + ;; The first two cases do the normal part : enter a new `header' + ;; in the `dependencies' table, + ((not (boundp id-dep)) + (set id-dep (list header))) + ((null (car (symbol-value id-dep))) + (setcar (symbol-value id-dep) header)) + + ;; From here the `header' was already present in the + ;; `dependencies' table. + + (force-new + ;; Overrides an existing entry, + ;; Just set the header part of the entry. + (setcar (symbol-value id-dep) header)) + + ;; Renames the existing `header' to a unique Message-ID. + ((not gnus-summary-ignore-duplicates) + ;; An article with this Message-ID has already been seen. + ;; We rename the Message-ID. + (set (setq id-dep (intern (setq id (nnmail-message-id)) dependencies)) + (list header)) + (mail-header-set-id header id)) + + ;; - The last case ignores an existing entry, except it adds + ;; any additional Xrefs (in case the two articles came from + ;; different servers. + ;; Also sets `header' to `nil' meaning that the + ;; `dependencies' table was *not* modified. + (t + (mail-header-set-xref + (car (symbol-value id-dep)) + (concat (or (mail-header-xref (car (symbol-value id-dep))) + "") + (or (mail-header-xref header) ""))) + (setq header nil))) + + (when header + ;; First check if that we are not creating a References loop. + (setq ref (gnus-parent-id (mail-header-references header))) + (while (and ref + (setq ref-dep (intern-soft ref dependencies)) + (boundp ref-dep) + (setq ref-header (car (symbol-value ref-dep)))) + (if (string= id ref) + ;; Yuk ! This is a reference loop. Make the article be a + ;; root article. + (progn + (mail-header-set-references (car (symbol-value id-dep)) "none") + (setq ref nil)) + (setq ref (gnus-parent-id (mail-header-references ref-header))))) + (setq ref (gnus-parent-id (mail-header-references header))) + (setq ref-dep (intern (or ref "none") dependencies)) + (if (boundp ref-dep) + (setcdr (symbol-value ref-dep) + (nconc (cdr (symbol-value ref-dep)) + (list (symbol-value id-dep)))) + (set ref-dep (list nil (symbol-value id-dep))))) + header)) + (defun gnus-build-sparse-threads () (let ((headers gnus-newsgroup-headers) - (deps gnus-newsgroup-dependencies) header references generation relations cthread subject child end pthread relation new-child) ;; First we create an alist of generations/relations, where @@ -2931,43 +2966,28 @@ If NO-DISPLAY, don't generate a summary buffer." (setq generation 0) (while (search-backward ">" nil t) (setq end (1+ (point))) - (when (search-backward "<" nil t) - (unless (string= (setq new-child (buffer-substring (point) end)) - child) + (if (search-backward "<" nil t) (push (list (incf generation) child (setq child new-child) subject) - relations)))) + relations))) (push (list (1+ generation) child nil subject) relations) (erase-buffer))) (kill-buffer (current-buffer))) ;; Sort over trustworthiness. - (setq relations (sort relations 'car-less-than-car)) - (while (setq relation (pop relations)) - (when (if (boundp (setq cthread (intern (cadr relation) deps))) - (unless (car (symbol-value cthread)) - ;; Make this article the parent of these threads. - (setcar (symbol-value cthread) - (vector gnus-reffed-article-number - (cadddr relation) - "" "" - (cadr relation) - (or (caddr relation) "") 0 0 ""))) - (set cthread (list (vector gnus-reffed-article-number - (cadddr relation) - "" "" (cadr relation) - (or (caddr relation) "") 0 0 "")))) - (push gnus-reffed-article-number gnus-newsgroup-limit) - (push gnus-reffed-article-number gnus-newsgroup-sparse) - (push (cons gnus-reffed-article-number gnus-sparse-mark) - gnus-newsgroup-reads) - (decf gnus-reffed-article-number) - ;; Make this new thread the child of its parent. - (if (boundp (setq pthread (intern (or (caddr relation) "none") deps))) - (setcdr (symbol-value pthread) - (nconc (cdr (symbol-value pthread)) - (list (symbol-value cthread)))) - (set pthread (list nil (symbol-value cthread)))))) + (mapc #'(lambda (relation) + (when (gnus-dependencies-add-header + (make-full-mail-header gnus-reffed-article-number + (cadddr relation) + "" "" (cadr relation) + (or (caddr relation) "") 0 0 "") + gnus-newsgroup-dependencies nil) + (push gnus-reffed-article-number gnus-newsgroup-limit) + (push gnus-reffed-article-number gnus-newsgroup-sparse) + (push (cons gnus-reffed-article-number gnus-sparse-mark) + gnus-newsgroup-reads) + (decf gnus-reffed-article-number))) + (sort relations 'car-less-than-car)) (gnus-message 7 "Making sparse threads...done"))) (defun gnus-build-old-threads () @@ -2986,8 +3006,7 @@ If NO-DISPLAY, don't generate a summary buffer." (setq heads (cdr heads)) (setq id (symbol-name refs)) (while (and (setq id (gnus-build-get-header id)) - (not (car (gnus-gethash - id gnus-newsgroup-dependencies))))) + (not (car (gnus-id-to-thread id))))) (setq heads nil))))) gnus-newsgroup-dependencies))) @@ -2995,8 +3014,7 @@ If NO-DISPLAY, don't generate a summary buffer." ;; Look through the buffer of NOV lines and find the header to ;; ID. Enter this line into the dependencies hash table, and return ;; the id of the parent article (if any). - (let ((deps gnus-newsgroup-dependencies) - found header) + (let (found header) (prog1 (save-excursion (set-buffer nntp-server-buffer) @@ -3012,8 +3030,8 @@ If NO-DISPLAY, don't generate a summary buffer." (when found (beginning-of-line) (and - (setq header (gnus-nov-parse-line - (read (current-buffer)) deps)) + (setq header (gnus-nov-parse-line (read (current-buffer)) + gnus-newsgroup-dependencies)) (gnus-parent-id (mail-header-references header)))))) (when header (let ((number (mail-header-number header))) @@ -3028,8 +3046,7 @@ If NO-DISPLAY, don't generate a summary buffer." (defun gnus-build-all-threads () "Read all the headers." - (let ((deps gnus-newsgroup-dependencies) - (gnus-summary-ignore-duplicates t) + (let ((gnus-summary-ignore-duplicates t) found header article) (save-excursion (set-buffer nntp-server-buffer) @@ -3038,7 +3055,8 @@ If NO-DISPLAY, don't generate a summary buffer." (while (not (eobp)) (ignore-errors (setq article (read (current-buffer))) - (setq header (gnus-nov-parse-line article deps))) + (setq header (gnus-nov-parse-line article + gnus-newsgroup-dependencies))) (when header (push header gnus-newsgroup-headers) (if (memq (setq article (mail-header-number header)) @@ -3173,19 +3191,23 @@ If NO-DISPLAY, don't generate a summary buffer." (when headers (car headers)))) -(defun gnus-parent-headers (headers &optional generation) +(defun gnus-parent-headers (in-headers &optional generation) "Return the headers of the GENERATIONeth parent of HEADERS." (unless generation (setq generation 1)) (let ((parent t) + (headers in-headers) references) - (while (and parent headers (not (zerop generation))) - (setq references (mail-header-references headers)) + (while (and parent + headers + (not (zerop generation)) + (setq references (mail-header-references headers))) (when (and references (setq parent (gnus-parent-id references)) (setq headers (car (gnus-id-to-thread parent)))) (decf generation))) - headers)) + (and (not (eq headers in-headers)) + headers))) (defun gnus-id-to-thread (id) "Return the (sub-)thread where ID appears." @@ -3220,8 +3242,7 @@ If NO-DISPLAY, don't generate a summary buffer." (defun gnus-root-id (id) "Return the id of the root of the thread where ID appears." (let (last-id prev) - (while (and id (setq prev (car (gnus-gethash - id gnus-newsgroup-dependencies)))) + (while (and id (setq prev (car (gnus-id-to-thread id)))) (setq last-id id id (gnus-parent-id (mail-header-references prev)))) last-id)) @@ -3233,8 +3254,7 @@ If NO-DISPLAY, don't generate a summary buffer." (defun gnus-remove-thread (id &optional dont-remove) "Remove the thread that has ID in it." - (let ((dep gnus-newsgroup-dependencies) - headers thread last-id) + (let (headers thread last-id) ;; First go up in this thread until we find the root. (setq last-id (gnus-root-id id)) (setq headers (list (car (gnus-id-to-thread last-id)) @@ -3267,7 +3287,7 @@ If NO-DISPLAY, don't generate a summary buffer." (if thread (unless dont-remove (setq gnus-newsgroup-threads (delq thread gnus-newsgroup-threads))) - (setq thread (gnus-gethash last-id dep))) + (setq thread (gnus-id-to-thread last-id))) (when thread (prog1 thread ; We return this thread. @@ -3277,6 +3297,11 @@ If NO-DISPLAY, don't generate a summary buffer." ;; If we use dummy roots, then we have to remove the ;; dummy root as well. (when (eq gnus-summary-make-false-root 'dummy) + ;; We go to the dummy root by going to + ;; the first sub-"thread", and then one line up. + (gnus-summary-goto-article + (mail-header-number (caadr thread))) + (forward-line -1) (gnus-delete-line) (gnus-data-compute-positions)) (setq thread (cdr thread)) @@ -3427,8 +3452,7 @@ Unscored articles will be counted as having a score of zero." (apply gnus-thread-score-function (or (append (mapcar 'gnus-thread-total-score - (cdr (gnus-gethash (mail-header-id root) - gnus-newsgroup-dependencies))) + (cdr (gnus-id-to-thread (mail-header-id root)))) (when (> (mail-header-number root) 0) (list (or (cdr (assq (mail-header-number root) gnus-newsgroup-scored)) @@ -3475,7 +3499,6 @@ or a straight list of headers." (while (or threads stack gnus-tmp-new-adopts new-roots) (if (and (= gnus-tmp-level 0) - (not (setq gnus-tmp-dummy-line nil)) (or (not stack) (= (caar stack) 0)) (not gnus-tmp-false-parent) @@ -3590,7 +3613,10 @@ or a straight list of headers." (when gnus-tmp-header ;; We may have an old dummy line to output before this ;; article. - (when gnus-tmp-dummy-line + (when (and gnus-tmp-dummy-line + (gnus-subject-equal + gnus-tmp-dummy-line + (mail-header-subject gnus-tmp-header))) (gnus-summary-insert-dummy-line gnus-tmp-dummy-line (mail-header-number gnus-tmp-header)) (setq gnus-tmp-dummy-line nil)) @@ -3673,7 +3699,7 @@ or a straight list of headers." 'gnus-number number) (when gnus-visual-p (forward-line -1) - (run-hooks 'gnus-summary-update-hook) + (gnus-run-hooks 'gnus-summary-update-hook) (forward-line 1)) (setq gnus-tmp-prev-subject subject))) @@ -3795,11 +3821,11 @@ If READ-ALL is non-nil, all articles in the group are selected." articles gnus-newsgroup-name ;; We might want to fetch old headers, but ;; not if there is only 1 article. - (and gnus-fetch-old-headers - (or (and + (and (or (and (not (eq gnus-fetch-old-headers 'some)) (not (numberp gnus-fetch-old-headers))) - (> (length articles) 1)))))) + (> (length articles) 1)) + gnus-fetch-old-headers)))) (gnus-get-newsgroup-headers-xover articles nil nil gnus-newsgroup-name t) (gnus-get-newsgroup-headers))) @@ -4264,7 +4290,7 @@ The resulting hash table is returned, or nil if no Xrefs were found." (set-buffer nntp-server-buffer) ;; Translate all TAB characters into SPACE characters. (subst-char-in-region (point-min) (point-max) ?\t ? t) - (run-hooks 'gnus-parse-headers-hook) + (gnus-run-hooks 'gnus-parse-headers-hook) (let ((case-fold-search t) in-reply-to header p lines) (goto-char (point-min)) @@ -4295,7 +4321,6 @@ The resulting hash table is returned, or nil if no Xrefs were found." (progn (goto-char p) (if (search-forward "\nsubject: " nil t) - ;; 1997/5/4 by MORIOKA Tomohiko (funcall gnus-unstructured-field-decoder (nnheader-header-value)) "(none)")) @@ -4303,7 +4328,6 @@ The resulting hash table is returned, or nil if no Xrefs were found." (progn (goto-char p) (if (search-forward "\nfrom: " nil t) - ;; 1997/5/4 by MORIOKA Tomohiko (funcall gnus-structured-field-decoder (nnheader-header-value)) "(nobody)")) @@ -4315,10 +4339,12 @@ The resulting hash table is returned, or nil if no Xrefs were found." ;; Message-ID. (progn (goto-char p) - (setq id (if (search-forward "\nmessage-id:" nil t) - (buffer-substring - (1- (or (search-forward "<" nil t) (point))) - (or (search-forward ">" nil t) (point))) + (setq id (if (re-search-forward + "^message-id: *\\(<[^\n\t> ]+>\\)" nil t) + ;; We do it this way to make sure the Message-ID + ;; is (somewhat) syntactically valid. + (buffer-substring (match-beginning 1) + (match-end 1)) ;; If there was no message-id, we just fake one ;; to make subsequent routines simpler. (nnheader-generate-fake-message-id)))) @@ -4345,8 +4371,14 @@ The resulting hash table is returned, or nil if no Xrefs were found." (if (and (search-forward "\nin-reply-to: " nil t) (setq in-reply-to (nnheader-header-value)) (string-match "<[^>]+>" in-reply-to)) - (setq ref (substring in-reply-to (match-beginning 0) - (match-end 0))) + (let (ref2) + (setq ref (substring in-reply-to (match-beginning 0) + (match-end 0))) + (while (string-match "<[^>]+>" in-reply-to (match-end 0)) + (setq ref2 (substring in-reply-to (match-beginning 0) + (match-end 0))) + (when (> (length ref2) (length ref)) + (setq ref ref2)))) (setq ref nil)))) ;; Chars. 0 @@ -4369,43 +4401,11 @@ The resulting hash table is returned, or nil if no Xrefs were found." (funcall gnus-alter-header-function header) (setq id (mail-header-id header) ref (gnus-parent-id (mail-header-references header)))) - - ;; We do the threading while we read the headers. The - ;; message-id and the last reference are both entered into - ;; the same hash table. Some tippy-toeing around has to be - ;; done in case an article has arrived before the article - ;; which it refers to. - (if (boundp (setq id-dep (intern id dependencies))) - (if (and (car (symbol-value id-dep)) - (not force-new)) - ;; An article with this Message-ID has already been seen. - (if gnus-summary-ignore-duplicates - ;; We ignore this one, except we add - ;; any additional Xrefs (in case the two articles - ;; came from different servers). - (progn - (mail-header-set-xref - (car (symbol-value id-dep)) - (concat (or (mail-header-xref - (car (symbol-value id-dep))) - "") - (or (mail-header-xref header) ""))) - (setq header nil)) - ;; We rename the Message-ID. - (set - (setq id-dep (intern (setq id (nnmail-message-id)) - dependencies)) - (list header)) - (mail-header-set-id header id)) - (setcar (symbol-value id-dep) header)) - (set id-dep (list header))) - (when header - (if (boundp (setq ref-dep (intern (or ref "none") dependencies))) - (setcdr (symbol-value ref-dep) - (nconc (cdr (symbol-value ref-dep)) - (list (symbol-value id-dep)))) - (set ref-dep (list nil (symbol-value id-dep)))) - (push header headers)) + + (setq header + (gnus-dependencies-add-header header dependencies force-new)) + (if header + (push header headers)) (goto-char (point-max)) (widen)) (nreverse headers))))) @@ -4445,73 +4445,31 @@ The resulting hash table is returned, or nil if no Xrefs were found." (forward-char)) (setq header - (vector + (make-full-mail-header number ; number (funcall gnus-unstructured-field-decoder (gnus-nov-field)) ; subject (funcall gnus-structured-field-decoder (gnus-nov-field)) ; from (gnus-nov-field) ; date - (setq id (or (gnus-nov-field) - (nnheader-generate-fake-message-id))) ; id - (progn - (let ((beg (point))) - (search-forward "\t" eol) - (if (search-backward ">" beg t) - (setq ref - (buffer-substring - (1+ (point)) - (search-backward "<" beg t))) - (setq ref nil)) - (goto-char beg)) - (gnus-nov-field)) ; refs + (or (gnus-nov-field) + (nnheader-generate-fake-message-id)) ; id + (gnus-nov-field) ; refs (gnus-nov-read-integer) ; chars (gnus-nov-read-integer) ; lines - (if (= (following-char) ?\n) - nil + (unless (= (following-char) ?\n) (gnus-nov-field))))) ; misc (widen)) (when gnus-alter-header-function - (funcall gnus-alter-header-function header) - (setq id (mail-header-id header) - ref (gnus-parent-id (mail-header-references header)))) - - ;; We build the thread tree. - (when (equal id ref) - ;; This article refers back to itself. Naughty, naughty. - (setq ref nil)) - (if (boundp (setq id-dep (intern id dependencies))) - (if (and (car (symbol-value id-dep)) - (not force-new)) - ;; An article with this Message-ID has already been seen. - (if gnus-summary-ignore-duplicates - ;; We ignore this one, except we add any additional - ;; Xrefs (in case the two articles came from different - ;; servers. - (progn - (mail-header-set-xref - (car (symbol-value id-dep)) - (concat (or (mail-header-xref - (car (symbol-value id-dep))) - "") - (or (mail-header-xref header) ""))) - (setq header nil)) - ;; We rename the Message-ID. - (set - (setq id-dep (intern (setq id (nnmail-message-id)) - dependencies)) - (list header)) - (mail-header-set-id header id)) - (setcar (symbol-value id-dep) header)) - (set id-dep (list header))) - (when header - (if (boundp (setq ref-dep (intern (or ref "none") dependencies))) - (setcdr (symbol-value ref-dep) - (nconc (cdr (symbol-value ref-dep)) - (list (symbol-value id-dep)))) - (set ref-dep (list nil (symbol-value id-dep))))) + (funcall gnus-alter-header-function header)) + + (setq id (mail-header-id header) + ref (gnus-parent-id (mail-header-references header))) + + (gnus-dependencies-add-header header dependencies force-new) + header)) ;; Goes through the xover lines and returns a list of vectors @@ -4529,7 +4487,7 @@ list of headers that match SEQUENCE (see `nntp-retrieve-headers')." (save-excursion (set-buffer nntp-server-buffer) ;; Allow the user to mangle the headers before parsing them. - (run-hooks 'gnus-parse-headers-hook) + (gnus-run-hooks 'gnus-parse-headers-hook) (goto-char (point-min)) (while (not (eobp)) (condition-case () @@ -4591,8 +4549,13 @@ This is meant to be called in `gnus-article-internal-prepare-hook'." (defun gnus-summary-insert-subject (id &optional old-header use-old-header) "Find article ID and insert the summary line for that article." - (let ((header (if (and old-header use-old-header) - old-header (gnus-read-header id))) + (let ((header (cond ((and old-header use-old-header) + old-header) + ((and (numberp id) + (gnus-number-to-header id)) + (gnus-number-to-header id)) + (t + (gnus-read-header id)))) (number (and (numberp id) id)) pos d) (when header @@ -4600,7 +4563,8 @@ This is meant to be called in `gnus-article-internal-prepare-hook'." ;; article we have fetched. (when (and (not gnus-show-threads) old-header) - (when (setq d (gnus-data-find (mail-header-number old-header))) + (when (and number + (setq d (gnus-data-find (mail-header-number old-header)))) (goto-char (gnus-data-pos d)) (gnus-data-remove number @@ -4614,6 +4578,7 @@ This is meant to be called in `gnus-article-internal-prepare-hook'." (delq (setq number (mail-header-number header)) gnus-newsgroup-sparse)) (setq gnus-newsgroup-ancient (delq number gnus-newsgroup-ancient)) + (push number gnus-newsgroup-limit) (gnus-rebuild-thread (mail-header-id header)) (gnus-summary-goto-subject number nil t)) (when (and (numberp number) @@ -4634,47 +4599,50 @@ This is meant to be called in `gnus-article-internal-prepare-hook'." ;;; Process/prefix in the summary buffer (defun gnus-summary-work-articles (n) - "Return a list of articles to be worked upon. The prefix argument, -the list of process marked articles, and the current article will be -taken into consideration." - (cond - (n - ;; A numerical prefix has been given. - (setq n (prefix-numeric-value n)) - (let ((backward (< n 0)) - (n (abs (prefix-numeric-value n))) - articles article) - (save-excursion - (while - (and (> n 0) - (push (setq article (gnus-summary-article-number)) - articles) - (if backward - (gnus-summary-find-prev nil article) - (gnus-summary-find-next nil article))) - (decf n))) - (nreverse articles))) - ((gnus-region-active-p) - ;; Work on the region between point and mark. - (let ((max (max (point) (mark))) - articles article) - (save-excursion - (goto-char (min (point) (mark))) - (while - (and - (push (setq article (gnus-summary-article-number)) articles) - (gnus-summary-find-next nil article) - (< (point) max))) - (nreverse articles)))) - (gnus-newsgroup-processable - ;; There are process-marked articles present. - ;; Save current state. - (gnus-summary-save-process-mark) - ;; Return the list. - (reverse gnus-newsgroup-processable)) - (t - ;; Just return the current article. - (list (gnus-summary-article-number))))) + "Return a list of articles to be worked upon. +The prefix argument, the list of process marked articles, and the +current article will be taken into consideration." + (save-excursion + (set-buffer gnus-summary-buffer) + (cond + (n + ;; A numerical prefix has been given. + (setq n (prefix-numeric-value n)) + (let ((backward (< n 0)) + (n (abs (prefix-numeric-value n))) + articles article) + (save-excursion + (while + (and (> n 0) + (push (setq article (gnus-summary-article-number)) + articles) + (if backward + (gnus-summary-find-prev nil article) + (gnus-summary-find-next nil article))) + (decf n))) + (nreverse articles))) + ((and (gnus-region-active-p) (mark)) + (message "region active") + ;; Work on the region between point and mark. + (let ((max (max (point) (mark))) + articles article) + (save-excursion + (goto-char (min (point) (mark))) + (while + (and + (push (setq article (gnus-summary-article-number)) articles) + (gnus-summary-find-next nil article) + (< (point) max))) + (nreverse articles)))) + (gnus-newsgroup-processable + ;; There are process-marked articles present. + ;; Save current state. + (gnus-summary-save-process-mark) + ;; Return the list. + (reverse gnus-newsgroup-processable)) + (t + ;; Just return the current article. + (list (gnus-summary-article-number)))))) (defun gnus-summary-save-process-mark () "Push the current set of process marked articles on the stack." @@ -4720,7 +4688,7 @@ If EXCLUDE-GROUP, do not go to this group." (save-excursion (gnus-group-best-unread-group exclude-group)))) -(defun gnus-summary-find-next (&optional unread article backward) +(defun gnus-summary-find-next (&optional unread article backward undownloaded) (if backward (gnus-summary-find-prev) (let* ((dummy (gnus-summary-article-intangible-p)) (article (or article (gnus-summary-article-number))) @@ -4735,7 +4703,10 @@ If EXCLUDE-GROUP, do not go to this group." (if unread (progn (while arts - (when (gnus-data-unread-p (car arts)) + (when (or (and undownloaded + (eq gnus-undownloaded-mark + (gnus-data-mark (car arts)))) + (gnus-data-unread-p (car arts))) (setq result (car arts) arts nil)) (setq arts (cdr arts))) @@ -4975,38 +4946,42 @@ The prefix argument ALL means to select all articles." (defun gnus-summary-update-info (&optional non-destructive) (save-excursion (let ((group gnus-newsgroup-name)) - (when gnus-newsgroup-kill-headers - (setq gnus-newsgroup-killed - (gnus-compress-sequence - (nconc - (gnus-set-sorted-intersection - (gnus-uncompress-range gnus-newsgroup-killed) - (setq gnus-newsgroup-unselected - (sort gnus-newsgroup-unselected '<))) - (setq gnus-newsgroup-unreads - (sort gnus-newsgroup-unreads '<))) - t))) - (unless (listp (cdr gnus-newsgroup-killed)) - (setq gnus-newsgroup-killed (list gnus-newsgroup-killed))) - (let ((headers gnus-newsgroup-headers)) - (when (and (not gnus-save-score) - (not non-destructive)) - (setq gnus-newsgroup-scored nil)) - ;; Set the new ranges of read articles. - (save-excursion + (when group + (when gnus-newsgroup-kill-headers + (setq gnus-newsgroup-killed + (gnus-compress-sequence + (nconc + (gnus-set-sorted-intersection + (gnus-uncompress-range gnus-newsgroup-killed) + (setq gnus-newsgroup-unselected + (sort gnus-newsgroup-unselected '<))) + (setq gnus-newsgroup-unreads + (sort gnus-newsgroup-unreads '<))) + t))) + (unless (listp (cdr gnus-newsgroup-killed)) + (setq gnus-newsgroup-killed (list gnus-newsgroup-killed))) + (let ((headers gnus-newsgroup-headers)) + ;; Set the new ranges of read articles. + (save-excursion + (set-buffer gnus-group-buffer) + (gnus-undo-force-boundary)) + (gnus-update-read-articles + group (append gnus-newsgroup-unreads gnus-newsgroup-unselected)) + ;; Set the current article marks. + (let ((gnus-newsgroup-scored + (if (and (not gnus-save-score) + (not non-destructive)) + nil + gnus-newsgroup-scored))) + (save-excursion + (gnus-update-marks))) + ;; Do the cross-ref thing. + (when gnus-use-cross-reference + (gnus-mark-xrefs-as-read group headers gnus-newsgroup-unreads)) + ;; Do not switch windows but change the buffer to work. (set-buffer gnus-group-buffer) - (gnus-undo-force-boundary)) - (gnus-update-read-articles - group (append gnus-newsgroup-unreads gnus-newsgroup-unselected)) - ;; Set the current article marks. - (gnus-update-marks) - ;; Do the cross-ref thing. - (when gnus-use-cross-reference - (gnus-mark-xrefs-as-read group headers gnus-newsgroup-unreads)) - ;; Do not switch windows but change the buffer to work. - (set-buffer gnus-group-buffer) - (unless (gnus-ephemeral-group-p gnus-newsgroup-name) - (gnus-group-update-group group)))))) + (unless (gnus-ephemeral-group-p group) + (gnus-group-update-group group))))))) (defun gnus-summary-save-newsrc (&optional force) "Save the current number of read/marked articles in the dribble buffer. @@ -5022,13 +4997,15 @@ If FORCE (the prefix), also save the .newsrc file(s)." "Exit reading current newsgroup, and then return to group selection mode. gnus-exit-group-hook is called with no arguments if that value is non-nil." (interactive) + (gnus-set-global-variables) (gnus-kill-save-kill-buffer) + (gnus-async-halt-prefetch) (let* ((group gnus-newsgroup-name) (quit-config (gnus-group-quit-config gnus-newsgroup-name)) (mode major-mode) (group-point nil) (buf (current-buffer))) - (run-hooks 'gnus-summary-prepare-exit-hook) + (gnus-run-hooks 'gnus-summary-prepare-exit-hook) ;; If we have several article buffers, we kill them at exit. (unless gnus-single-article-buffer (gnus-kill-buffer gnus-original-article-buffer) @@ -5041,9 +5018,11 @@ gnus-exit-group-hook is called with no arguments if that value is non-nil." (gnus-dup-enter-articles)) (when gnus-use-trees (gnus-tree-close group)) + ;; Remove entries for this group. + (nnmail-purge-split-history (gnus-group-real-name group)) ;; Make all changes in this group permanent. (unless quit-config - (run-hooks 'gnus-exit-group-hook) + (gnus-run-hooks 'gnus-exit-group-hook) (gnus-summary-update-info) ;; Do adaptive scoring, and possibly save score files. (when gnus-newsgroup-adaptive @@ -5055,7 +5034,7 @@ gnus-exit-group-hook is called with no arguments if that value is non-nil." (set-buffer gnus-group-buffer) (unless quit-config (gnus-group-jump-to-group group)) - (run-hooks 'gnus-summary-exit-hook) + (gnus-run-hooks 'gnus-summary-exit-hook) (unless (or quit-config ;; If this group has disappeared from the summary ;; buffer, don't skip forwards. @@ -5106,6 +5085,8 @@ gnus-exit-group-hook is called with no arguments if that value is non-nil." (when (or no-questions gnus-expert-user (gnus-y-or-n-p "Discard changes to this group and exit? ")) + (gnus-async-halt-prefetch) + (gnus-run-hooks 'gnus-summary-prepare-exit-hook) ;; If we have several article buffers, we kill them at exit. (unless gnus-single-article-buffer (gnus-kill-buffer gnus-article-buffer) @@ -5136,8 +5117,8 @@ gnus-exit-group-hook is called with no arguments if that value is non-nil." (gnus-handle-ephemeral-exit quit-config))))) (defun gnus-handle-ephemeral-exit (quit-config) - "Handle movement when leaving an ephemeral group. The state -which existed when entering the ephemeral is reset." + "Handle movement when leaving an ephemeral group. +The state which existed when entering the ephemeral is reset." (if (not (buffer-name (car quit-config))) (gnus-configure-windows 'group 'force) (set-buffer (car quit-config)) @@ -5167,6 +5148,28 @@ which existed when entering the ephemeral is reset." (gnus-summary-recenter) (gnus-summary-position-point)))) +(defun gnus-summary-preview-mime-message (arg) + "MIME decode and play this message." + (interactive "P") + (let ((gnus-break-pages nil)) + (gnus-summary-select-article t t) + ) + (pop-to-buffer gnus-original-article-buffer t) + (let (buffer-read-only) + (if (text-property-any (point-min) (point-max) 'invisible t) + (remove-text-properties (point-min) (point-max) + gnus-hidden-properties) + )) + (mime-view-mode nil nil nil gnus-original-article-buffer + gnus-article-buffer) + ) + +(defun gnus-summary-scroll-down () + "Scroll down one line current article." + (interactive) + (gnus-summary-scroll-up -1) + ) + ;;; Dead summaries. (defvar gnus-dead-summary-mode-map nil) @@ -5217,25 +5220,24 @@ which existed when entering the ephemeral is reset." (defun gnus-kill-or-deaden-summary (buffer) "Kill or deaden the summary BUFFER." - (when (and (buffer-name buffer) - (not gnus-single-article-buffer)) - (save-excursion - (set-buffer buffer) - (gnus-kill-buffer gnus-article-buffer) - (gnus-kill-buffer gnus-original-article-buffer))) - (cond (gnus-kill-summary-on-exit - (when (and gnus-use-trees - (and (get-buffer buffer) - (buffer-name (get-buffer buffer)))) + (save-excursion + (when (and (buffer-name buffer) + (not gnus-single-article-buffer)) + (save-excursion + (set-buffer buffer) + (gnus-kill-buffer gnus-article-buffer) + (gnus-kill-buffer gnus-original-article-buffer))) + (cond (gnus-kill-summary-on-exit + (when (and gnus-use-trees + (gnus-buffer-exists-p buffer)) + (save-excursion + (set-buffer buffer) + (gnus-tree-close gnus-newsgroup-name))) + (gnus-kill-buffer buffer)) + ((gnus-buffer-exists-p buffer) (save-excursion - (set-buffer (get-buffer buffer)) - (gnus-tree-close gnus-newsgroup-name))) - (gnus-kill-buffer buffer)) - ((and (get-buffer buffer) - (buffer-name (get-buffer buffer))) - (save-excursion - (set-buffer buffer) - (gnus-deaden-summary))))) + (set-buffer buffer) + (gnus-deaden-summary)))))) (defun gnus-summary-wake-up-the-dead (&rest args) "Wake up the dead summary buffer." @@ -5314,7 +5316,7 @@ previous group instead." (when (gnus-buffer-live-p current-buffer) (set-buffer current-buffer) (gnus-summary-exit)) - (run-hooks 'gnus-group-no-more-groups-hook)) + (gnus-run-hooks 'gnus-group-no-more-groups-hook)) ;; We try to enter the target group. (gnus-group-jump-to-group target-group) (let ((unreads (gnus-group-group-unread))) @@ -5322,7 +5324,8 @@ previous group instead." (and unreads (not (zerop unreads)))) (gnus-summary-read-group target-group nil no-article - (and (buffer-name current-buffer) current-buffer))) + (and (buffer-name current-buffer) current-buffer) + nil backward)) (setq entered t) (setq current-group target-group target-group nil))))))) @@ -5335,7 +5338,7 @@ If prefix argument NO-ARTICLE is non-nil, no article is selected initially." ;; Walking around summary lines. -(defun gnus-summary-first-subject (&optional unread) +(defun gnus-summary-first-subject (&optional unread undownloaded) "Go to the first unread subject. If UNREAD is non-nil, go to the first unread article. Returns the article selected or nil if there are no unread articles." @@ -5358,7 +5361,10 @@ Returns the article selected or nil if there are no unread articles." (t (let ((data gnus-newsgroup-data)) (while (and data - (not (gnus-data-unread-p (car data)))) + (and (not (and undownloaded + (eq gnus-undownloaded-mark + (gnus-data-mark (car data))))) + (not (gnus-data-unread-p (car data))))) (setq data (cdr data))) (when data (goto-char (gnus-data-pos (car data))) @@ -5378,6 +5384,7 @@ returned." (if backward (gnus-summary-find-prev unread) (gnus-summary-find-next unread))) + (gnus-summary-show-thread) (setq n (1- n))) (when (/= 0 n) (gnus-message 7 "No more%s articles" @@ -5442,7 +5449,7 @@ Given a prefix, will force an `article' buffer configuration." (if gnus-summary-display-article-function (funcall gnus-summary-display-article-function article all-header) (gnus-article-prepare article all-header)) - (run-hooks 'gnus-select-article-hook) + (gnus-run-hooks 'gnus-select-article-hook) (when (and gnus-current-article (not (zerop gnus-current-article))) (gnus-summary-goto-subject gnus-current-article)) @@ -5644,6 +5651,9 @@ article." (let ((article (gnus-summary-article-number)) (article-window (get-buffer-window gnus-article-buffer t)) endp) + ;; If the buffer is empty, we have no article. + (unless article + (error "No article to select")) (gnus-configure-windows 'article) (if (eq (cdr (assq article gnus-newsgroup-reads)) gnus-canceled-mark) (if (and (eq gnus-summary-goto-unread 'never) @@ -5820,7 +5830,7 @@ If ALL-HEADERS is non-nil, no header lines are hidden." (interactive) (prog1 (when gnus-last-article - (gnus-summary-goto-article gnus-last-article)) + (gnus-summary-goto-article gnus-last-article nil t)) (gnus-summary-position-point))) (defun gnus-summary-pop-article (number) @@ -5895,7 +5905,9 @@ articles that are younger than AGE days." (setq is-younger (nnmail-time-less (nnmail-time-since (nnmail-date-to-time date)) cutoff)) - (when (if younger-p is-younger (not is-younger)) + (when (if younger-p + (not is-younger) + is-younger) (push (gnus-data-number d) articles)))) (gnus-summary-limit (nreverse articles))) (gnus-summary-position-point))) @@ -5979,7 +5991,9 @@ Returns how many articles were removed." (gnus-summary-position-point)))) (defun gnus-summary-limit-include-dormant () - "Display all the hidden articles that are marked as dormant." + "Display all the hidden articles that are marked as dormant. +Note that this command only works on a subset of the articles currently +fetched for this group." (interactive) (unless gnus-newsgroup-dormant (error "There are no dormant articles in this group")) @@ -6362,17 +6376,20 @@ or `gnus-select-method', no matter what backend the article comes from." (gnus-summary-article-sparse-p (mail-header-number header)) (memq (mail-header-number header) - gnus-newsgroup-limit)))) - (if (and header - (or (not (gnus-summary-article-sparse-p - (mail-header-number header))) - sparse)) - (prog1 - ;; The article is present in the buffer, so we just go to it. - (gnus-summary-goto-article - (mail-header-number header) nil t) - (when sparse - (gnus-summary-update-article (mail-header-number header)))) + gnus-newsgroup-limit))) + h) + (cond + ;; If the article is present in the buffer we just go to it. + ((and header + (or (not (gnus-summary-article-sparse-p + (mail-header-number header))) + sparse)) + (prog1 + (gnus-summary-goto-article + (mail-header-number header) nil t) + (when sparse + (gnus-summary-update-article (mail-header-number header))))) + (t ;; We fetch the article (let ((gnus-override-method (cond ((gnus-news-group-p gnus-newsgroup-name) @@ -6388,7 +6405,12 @@ or `gnus-select-method', no matter what backend the article comes from." ;; Fetch the header, and display the article. (if (setq number (gnus-summary-insert-subject message-id)) (gnus-summary-select-article nil nil nil number) - (gnus-message 3 "Couldn't fetch article %s" message-id))))))) + (gnus-message 3 "Couldn't fetch article %s" message-id)))))))) + +(defun gnus-summary-edit-parameters () + "Edit the group parameters of the current group." + (interactive) + (gnus-group-edit-group gnus-newsgroup-name 'params)) (defun gnus-summary-enter-digest-group (&optional force) "Enter an nndoc group based on the current article. @@ -6666,25 +6688,42 @@ article. If BACKWARD (the prefix) is non-nil, search backward instead." (when gnus-page-broken (gnus-narrow-to-page)))) -(defun gnus-summary-print-article (&optional filename) - "Generate and print a PostScript image of the article buffer. +(defun gnus-summary-print-article (&optional filename n) + "Generate and print a PostScript image of the N next (mail) articles. + +If N is negative, print the N previous articles. If N is nil and articles +have been marked with the process mark, print these instead. -If the optional argument FILENAME is nil, send the image to the printer. -If FILENAME is a string, save the PostScript image in a file with that -name. If FILENAME is a number, prompt the user for the name of the file +If the optional second argument FILENAME is nil, send the image to the +printer. If FILENAME is a string, save the PostScript image in a file with +that name. If FILENAME is a number, prompt the user for the name of the file to save in." - (interactive (list (ps-print-preprint current-prefix-arg))) - (gnus-summary-select-article) - (gnus-eval-in-buffer-window gnus-article-buffer - (let ((buffer (generate-new-buffer " *print*"))) - (unwind-protect - (progn - (copy-to-buffer buffer (point-min) (point-max)) - (set-buffer buffer) - (gnus-article-delete-invisible-text) - (run-hooks 'gnus-ps-print-hook) - (ps-print-buffer-with-faces filename)) - (kill-buffer buffer))))) + (interactive (list (ps-print-preprint current-prefix-arg) + current-prefix-arg)) + (dolist (article (gnus-summary-work-articles n)) + (gnus-summary-select-article nil nil 'pseudo article) + (gnus-eval-in-buffer-window gnus-article-buffer + (let ((buffer (generate-new-buffer " *print*"))) + (unwind-protect + (progn + (copy-to-buffer buffer (point-min) (point-max)) + (set-buffer buffer) + (gnus-article-delete-invisible-text) + (let ((ps-left-header + (list + (concat "(" + (mail-header-subject gnus-current-headers) ")") + (concat "(" + (mail-header-from gnus-current-headers) ")"))) + (ps-right-header + (list + "/pagenumberstring load" + (concat "(" + (mail-header-date gnus-current-headers) ")")))) + (gnus-run-hooks 'gnus-ps-print-hook) + (save-excursion + (ps-print-buffer-with-faces filename)))) + (kill-buffer buffer)))))) (defun gnus-summary-show-article (&optional arg) "Force re-fetching of the current article. @@ -6741,7 +6780,7 @@ If ARG is a negative number, hide the unwanted header lines." (setq e (1- (or (search-forward "\n\n" nil t) (point-max))))) (insert-buffer-substring gnus-original-article-buffer 1 e) (let ((article-inhibit-hiding t)) - (run-hooks 'gnus-article-display-hook)) + (gnus-run-hooks 'gnus-article-display-hook)) (when (or (not hidden) (and (numberp arg) (< arg 0))) (gnus-article-hide-headers))))) @@ -6783,7 +6822,8 @@ forward." (when (gnus-visual-p 'page-marker) (let ((buffer-read-only nil)) (gnus-remove-text-with-property 'gnus-prev) - (gnus-remove-text-with-property 'gnus-next))))) + (gnus-remove-text-with-property 'gnus-next)) + (setq gnus-page-broken nil)))) (defun gnus-summary-move-article (&optional n to-newsgroup select-method action) @@ -6867,9 +6907,9 @@ and `request-accept' functions." ((eq action 'copy) (save-excursion (set-buffer copy-buf) - (gnus-request-article-this-buffer article gnus-newsgroup-name) - (gnus-request-accept-article - to-newsgroup select-method (not articles)))) + (when (gnus-request-original-article article gnus-newsgroup-name) + (gnus-request-accept-article + to-newsgroup select-method (not articles))))) ;; Crosspost the article. ((eq action 'crosspost) (let ((xref (message-tokenize-header @@ -6888,7 +6928,7 @@ and `request-accept' functions." (save-excursion (set-buffer copy-buf) ;; First put the article in the destination group. - (gnus-request-article-this-buffer article gnus-newsgroup-name) + (gnus-request-original-article article gnus-newsgroup-name) (when (consp (setq art-group (gnus-request-accept-article to-newsgroup select-method (not articles)))) @@ -6981,11 +7021,14 @@ and `request-accept' functions." (when (eq action 'crosspost) (save-excursion (set-buffer copy-buf) - (gnus-request-article-this-buffer article gnus-newsgroup-name) + (gnus-request-original-article article gnus-newsgroup-name) (nnheader-replace-header "Xref" new-xref) (gnus-request-replace-article article gnus-newsgroup-name (current-buffer))))) + ;;;!!!Why is this necessary? + (set-buffer gnus-summary-buffer) + (gnus-summary-goto-subject article) (when (eq action 'move) (gnus-summary-mark-article article gnus-canceled-mark)))) @@ -7067,7 +7110,7 @@ latter case, they will be copied into the relevant groups." (gnus-summary-copy-article n nil method))) (defun gnus-summary-import-article (file) - "Import a random file into a mail newsgroup." + "Import an arbitrary file into a mail newsgroup." (interactive "fImport file: ") (let ((group gnus-newsgroup-name) (now (current-time)) @@ -7081,7 +7124,7 @@ latter case, they will be copied into the relevant groups." (set-buffer (get-buffer-create " *import file*")) (buffer-disable-undo (current-buffer)) (erase-buffer) - (insert-file-contents file) + (nnheader-insert-file-contents file) (goto-char (point-min)) (unless (nnheader-article-p) ;; This doesn't look like an article, so we fudge some headers. @@ -7126,7 +7169,7 @@ This will be the case if the article has both been mailed and posted." ;; We need to update the info for ;; this group for `gnus-list-of-read-articles' ;; to give us the right answer. - (run-hooks 'gnus-exit-group-hook) + (gnus-run-hooks 'gnus-exit-group-hook) (gnus-summary-update-info) (gnus-list-of-read-articles gnus-newsgroup-name)) (setq gnus-newsgroup-expirable @@ -7140,13 +7183,14 @@ This will be the case if the article has both been mailed and posted." ;; through the expiry process. (gnus-message 6 "Expiring articles...") ;; The list of articles that weren't expired is returned. - (if expiry-wait - (let ((nnmail-expiry-wait-function nil) - (nnmail-expiry-wait expiry-wait)) - (setq es (gnus-request-expire-articles - expirable gnus-newsgroup-name))) - (setq es (gnus-request-expire-articles - expirable gnus-newsgroup-name))) + (save-excursion + (if expiry-wait + (let ((nnmail-expiry-wait-function nil) + (nnmail-expiry-wait expiry-wait)) + (setq es (gnus-request-expire-articles + expirable gnus-newsgroup-name))) + (setq es (gnus-request-expire-articles + expirable gnus-newsgroup-name)))) (unless total (setq gnus-newsgroup-expirable es)) ;; We go through the old list of expirable, and mark all @@ -7282,17 +7326,17 @@ groups." (unless no-highlight (save-excursion (set-buffer gnus-article-buffer) - (run-hooks 'gnus-article-display-hook) + (gnus-run-hooks 'gnus-article-display-hook) (set-buffer gnus-original-article-buffer) (gnus-request-article (cdr gnus-article-current) (car gnus-article-current) (current-buffer)))) ;; Prettify the summary buffer line. (when (gnus-visual-p 'summary-highlight 'highlight) - (run-hooks 'gnus-visual-mark-article-hook)))) + (gnus-run-hooks 'gnus-visual-mark-article-hook)))) (defun gnus-summary-edit-wash (key) - "Perform editing command in the article buffer." + "Perform editing command KEY in the article buffer." (interactive (list (progn @@ -7569,36 +7613,41 @@ returned." (defun gnus-summary-mark-article-as-unread (mark) "Mark the current article quickly as unread with MARK." - (let ((article (gnus-summary-article-number))) - (if (<= article 0) - (gnus-error 1 "Can't mark negative article numbers") - (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked)) - (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant)) - (setq gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable)) - (setq gnus-newsgroup-reads (delq article gnus-newsgroup-reads)) - (cond ((= mark gnus-ticked-mark) - (push article gnus-newsgroup-marked)) - ((= mark gnus-dormant-mark) - (push article gnus-newsgroup-dormant)) - (t - (push article gnus-newsgroup-unreads))) - (setq gnus-newsgroup-reads - (delq (assq article gnus-newsgroup-reads) - gnus-newsgroup-reads)) + (let* ((article (gnus-summary-article-number)) + (old-mark (gnus-summary-article-mark article))) + (if (eq mark old-mark) + t + (if (<= article 0) + (progn + (gnus-error 1 "Can't mark negative article numbers") + nil) + (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked)) + (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant)) + (setq gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable)) + (setq gnus-newsgroup-reads (delq article gnus-newsgroup-reads)) + (cond ((= mark gnus-ticked-mark) + (push article gnus-newsgroup-marked)) + ((= mark gnus-dormant-mark) + (push article gnus-newsgroup-dormant)) + (t + (push article gnus-newsgroup-unreads))) + (setq gnus-newsgroup-reads + (delq (assq article gnus-newsgroup-reads) + gnus-newsgroup-reads)) + + ;; See whether the article is to be put in the cache. + (and gnus-use-cache + (vectorp (gnus-summary-article-header article)) + (save-excursion + (gnus-cache-possibly-enter-article + gnus-newsgroup-name article + (gnus-summary-article-header article) + (= mark gnus-ticked-mark) + (= mark gnus-dormant-mark) (= mark gnus-unread-mark)))) - ;; See whether the article is to be put in the cache. - (and gnus-use-cache - (vectorp (gnus-summary-article-header article)) - (save-excursion - (gnus-cache-possibly-enter-article - gnus-newsgroup-name article - (gnus-summary-article-header article) - (= mark gnus-ticked-mark) - (= mark gnus-dormant-mark) (= mark gnus-unread-mark)))) - - ;; Fix the mark. - (gnus-summary-update-mark mark 'unread)) - t)) + ;; Fix the mark. + (gnus-summary-update-mark mark 'unread) + t)))) (defun gnus-summary-mark-article (&optional article mark no-expire) "Mark ARTICLE with MARK. MARK can be any character. @@ -7621,32 +7670,35 @@ marked." (= mark gnus-duplicate-mark)))) (setq mark gnus-expirable-mark)) (let* ((mark (or mark gnus-del-mark)) - (article (or article (gnus-summary-article-number)))) - (unless article - (error "No article on current line")) - (if (or (= mark gnus-unread-mark) - (= mark gnus-ticked-mark) - (= mark gnus-dormant-mark)) - (gnus-mark-article-as-unread article mark) - (gnus-mark-article-as-read article mark)) - - ;; See whether the article is to be put in the cache. - (and gnus-use-cache - (not (= mark gnus-canceled-mark)) - (vectorp (gnus-summary-article-header article)) - (save-excursion - (gnus-cache-possibly-enter-article - gnus-newsgroup-name article - (gnus-summary-article-header article) - (= mark gnus-ticked-mark) - (= mark gnus-dormant-mark) (= mark gnus-unread-mark)))) - - (when (gnus-summary-goto-subject article nil t) - (let ((buffer-read-only nil)) - (gnus-summary-show-thread) - ;; Fix the mark. - (gnus-summary-update-mark mark 'unread) - t)))) + (article (or article (gnus-summary-article-number))) + (old-mark (gnus-summary-article-mark article))) + (if (eq mark old-mark) + t + (unless article + (error "No article on current line")) + (if (not (if (or (= mark gnus-unread-mark) + (= mark gnus-ticked-mark) + (= mark gnus-dormant-mark)) + (gnus-mark-article-as-unread article mark) + (gnus-mark-article-as-read article mark))) + t + ;; See whether the article is to be put in the cache. + (and gnus-use-cache + (not (= mark gnus-canceled-mark)) + (vectorp (gnus-summary-article-header article)) + (save-excursion + (gnus-cache-possibly-enter-article + gnus-newsgroup-name article + (gnus-summary-article-header article) + (= mark gnus-ticked-mark) + (= mark gnus-dormant-mark) (= mark gnus-unread-mark)))) + + (when (gnus-summary-goto-subject article nil t) + (let ((buffer-read-only nil)) + (gnus-summary-show-thread) + ;; Fix the mark. + (gnus-summary-update-mark mark 'unread) + t)))))) (defun gnus-summary-update-secondary-mark (article) "Update the secondary (read, process, cache) mark." @@ -7662,7 +7714,7 @@ marked." (t gnus-unread-mark)) 'replied) (when (gnus-visual-p 'summary-highlight 'highlight) - (run-hooks 'gnus-summary-update-hook)) + (gnus-run-hooks 'gnus-summary-update-hook)) t) (defun gnus-summary-update-mark (mark type) @@ -7697,20 +7749,21 @@ marked." (push (cons article mark) gnus-newsgroup-reads) ;; Possibly remove from cache, if that is used. (when gnus-use-cache - (gnus-cache-enter-remove-article article)))) + (gnus-cache-enter-remove-article article)) + t)) (defun gnus-mark-article-as-unread (article &optional mark) "Enter ARTICLE in the pertinent lists and remove it from others." (let ((mark (or mark gnus-ticked-mark))) - (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked) - gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant) - gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable) - gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads)) - (if (<= article 0) (progn (gnus-error 1 "Can't mark negative article numbers") nil) + (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked) + gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant) + gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable) + gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads)) + ;; Unsuppress duplicates? (when gnus-suppress-duplicates (gnus-dup-unsuppress-article article)) @@ -7920,15 +7973,15 @@ The number of articles marked as read is returned." (when all (setq gnus-newsgroup-marked nil gnus-newsgroup-dormant nil)) - (setq gnus-newsgroup-unreads nil)) + (setq gnus-newsgroup-unreads gnus-newsgroup-downloadable)) ;; We actually mark all articles as canceled, which we ;; have to do when using auto-expiry or adaptive scoring. (gnus-summary-show-all-threads) - (when (gnus-summary-first-subject (not all)) + (when (gnus-summary-first-subject (not all) t) (while (and (if to-here (< (point) to-here) t) (gnus-summary-mark-article-as-read gnus-catchup-mark) - (gnus-summary-find-next (not all))))) + (gnus-summary-find-next (not all) nil nil t)))) (gnus-set-mode-line 'summary)) t)) (gnus-summary-position-point))) @@ -7956,7 +8009,8 @@ If prefix argument ALL is non-nil, all articles are marked as read." (interactive "P") (when (gnus-summary-catchup all quietly nil 'fast) ;; Select next newsgroup or exit. - (if (eq gnus-auto-select-next 'quietly) + (if (and (not (gnus-group-quit-config gnus-newsgroup-name)) + (eq gnus-auto-select-next 'quietly)) (gnus-summary-next-group nil) (gnus-summary-exit)))) @@ -8052,7 +8106,9 @@ is non-nil or the Subject: of both articles are the same." (gnus-summary-article-header parent-article)))) (unless (and message-id (not (equal message-id ""))) (error "No message-id in desired parent")) - (gnus-summary-select-article t t nil current-article) + ;; We don't want the article to be marked as read. + (let (gnus-mark-article-hook) + (gnus-summary-select-article t t nil current-article)) (set-buffer gnus-original-article-buffer) (let ((buf (format "%s" (buffer-string)))) (nnheader-temp-write nil @@ -8614,7 +8670,7 @@ save those articles instead." (cond ((assq 'execute props) (gnus-execute-command (cdr (assq 'execute props))))) (let ((gnus-current-article (gnus-summary-article-number))) - (run-hooks 'gnus-mark-article-hook))) + (gnus-run-hooks 'gnus-mark-article-hook))) (defun gnus-execute-command (command &optional automatic) (save-excursion @@ -8665,6 +8721,14 @@ save those articles instead." (not (gnus-summary-article-sparse-p (mail-header-number header)))) ;; We have found the header. header + ;; If this is a sparse article, we have to nix out its + ;; previous entry in the thread hashtb. + (when (and header + (gnus-summary-article-sparse-p (mail-header-number header))) + (let* ((parent (gnus-parent-id (mail-header-references header))) + (thread (and parent (gnus-id-to-thread parent)))) + (when thread + (delq (assq header thread) thread)))) ;; We have to really fetch the header to this article. (save-excursion (set-buffer nntp-server-buffer) @@ -8850,9 +8914,43 @@ save those articles instead." (when buffers (map-y-or-n-p "Update summary buffer %s? " - (lambda (buf) (switch-to-buffer buf) (gnus-summary-exit)) + (lambda (buf) + (switch-to-buffer buf) + (gnus-summary-exit)) buffers))))) + +;;; @ for mime-partial +;;; + +(defun gnus-request-partial-message () + (save-excursion + (let ((number (gnus-summary-article-number)) + (group gnus-newsgroup-name) + (mother gnus-article-buffer)) + (set-buffer (get-buffer-create " *Partial Article*")) + (erase-buffer) + (setq mime-preview-buffer mother) + (gnus-request-original-article number group) + (mime-parse-buffer) + ))) + +(autoload 'mime-combine-message/partial-pieces-automatically + "mime-partial" + "Internal method to combine message/partial messages automatically.") + +(mime-add-condition + 'action '((type . message)(subtype . partial) + (major-mode . gnus-original-article-mode) + (method . mime-combine-message/partial-pieces-automatically) + (summary-buffer-exp . gnus-summary-buffer) + (request-partial-message-method . gnus-request-partial-message) + )) + + +;;; @ end +;;; + (gnus-ems-redefine) (provide 'gnus-sum)