X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fgnus-sum.el;h=bc37277193eba24e723fe78bd8696965cce110b0;hb=f0c2d45d7a3aa9463cc66ffdec5e95a5cf555549;hp=a7137158105d1eafa1684d14d4b4c86a76b1f941;hpb=16b30aeecd944d93ebbcee9568582dd6fb6e930f;p=elisp%2Fgnus.git- diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el index a713715..bc37277 100644 --- a/lisp/gnus-sum.el +++ b/lisp/gnus-sum.el @@ -37,6 +37,12 @@ (require 'gnus-util) (require 'mime-view) +;; Avoid byte-compile warnings. +(eval-when-compile + (defvar gnus-article-decoded-p) + (defvar gnus-decode-encoded-word-function) + ) + (autoload 'gnus-summary-limit-include-cached "gnus-cache" nil t) (autoload 'gnus-set-summary-default-charset "gnus-i18n" nil t) @@ -222,10 +228,10 @@ to expose hidden threads." :group 'gnus-thread :type 'boolean) -(defcustom gnus-thread-ignore-subject nil - "*If non-nil, ignore subjects and do all threading based on the Reference header. -If nil, which is the default, articles that have different subjects -from their parents will start separate threads." +(defcustom gnus-thread-ignore-subject t + "*If non-nil, which is the default, ignore subjects and do all threading based on the Reference header. +If nil, articles that have different subjects from their parents will +start separate threads." :group 'gnus-thread :type 'boolean) @@ -256,8 +262,12 @@ equal will be included." (defcustom gnus-auto-select-first t "*If nil, don't select the first unread article when entering a group. If this variable is `best', select the highest-scored unread article -in the group. If neither nil nor `best', select the first unread -article. +in the group. If t, select the first unread article. + +This variable can also be a function to place point on a likely +subject line. Useful values include `gnus-summary-first-unread-subject', +`gnus-summary-first-unread-article' and +`gnus-summary-best-unread-article'. If you want to prevent automatic selection of the first unread article in some newsgroups, set the variable to nil in @@ -265,7 +275,10 @@ in some newsgroups, set the variable to nil in :group 'gnus-group-select :type '(choice (const :tag "none" nil) (const best) - (sexp :menu-tag "first" t))) + (sexp :menu-tag "first" t) + (function-item gnus-summary-first-unread-subject) + (function-item gnus-summary-first-unread-article) + (function-item gnus-summary-best-unread-article))) (defcustom gnus-auto-select-next t "*If non-nil, offer to go to the next group from the end of the previous. @@ -286,7 +299,9 @@ will go to the next group without confirmation." (sexp :menu-tag "on" t))) (defcustom gnus-auto-select-same nil - "*If non-nil, select the next article with the same subject." + "*If non-nil, select the next article with the same subject. +If there are no more articles with the same subject, go to +the first unread article." :group 'gnus-summary-maneuvering :type 'boolean) @@ -304,6 +319,7 @@ and non-`vertical', do both horizontal and vertical recentering." :group 'gnus-summary-maneuvering :type '(choice (const :tag "none" nil) (const vertical) + (integer :tag "height") (sexp :menu-tag "both" t))) (defcustom gnus-show-all-headers nil @@ -316,7 +332,7 @@ and non-`vertical', do both horizontal and vertical recentering." "*If non-nil, ignore articles with identical Message-ID headers." :group 'gnus-summary :type 'boolean) - + (defcustom gnus-single-article-buffer t "*If non-nil, display all articles in the same buffer. If nil, each group will get its own article buffer." @@ -333,7 +349,7 @@ variable." (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'." +`gnus-article-display-method-for-mime'." :group 'gnus-article-mime :type 'boolean) @@ -475,6 +491,19 @@ It uses the same syntax as the `gnus-split-methods' variable." :group 'gnus-extract-view :type 'boolean) +(defcustom gnus-auto-expirable-marks + (list gnus-killed-mark gnus-del-mark gnus-catchup-mark + gnus-low-score-mark gnus-ancient-mark gnus-read-mark + gnus-souped-mark gnus-duplicate-mark) + "*The list of marks converted into expiration if a group is auto-expirable." + :group 'gnus-summary + :type '(repeat character)) + +(defcustom gnus-inhibit-user-auto-expire t + "*If non-nil, user marking commands will not mark an article as expirable, even if the group has auto-expire turned on." + :group 'gnus-summary + :type 'boolean) + (defcustom gnus-view-pseudos nil "*If `automatic', pseudo-articles will be viewed automatically. If `not-confirm', pseudos will be viewed automatically, and the user @@ -506,7 +535,7 @@ with some simple extensions. :group 'gnus-threading :type 'string) -(defcustom gnus-summary-mode-line-format "Gnus: %%b [%A] %Z" +(defcustom gnus-summary-mode-line-format "Gnus: %g [%A] %Z" "*The format specification for the summary mode line. It works along the same lines as a normal formatting string, with some simple extensions: @@ -665,24 +694,7 @@ is not run if `gnus-visual' is nil." :group 'gnus-summary-visual :type 'hook) -(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 - (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 - '(gnus-set-summary-default-charset) +(defcustom gnus-parse-headers-hook '(gnus-set-summary-default-charset) "*A hook called before parsing the headers." :group 'gnus-various :type 'hook) @@ -787,6 +799,33 @@ mark: The articles mark." The function is called with one parameter, the article header vector, which it may alter in any way.") +(defcustom gnus-extra-headers nil + "*Extra headers to parse." + :group 'gnus-summary + :type '(repeat symbol)) + +(defcustom gnus-ignored-from-addresses + (and user-mail-address (regexp-quote user-mail-address)) + "*Regexp of From headers that may be suppressed in favor of To headers." + :group 'gnus-summary + :type 'regexp) + +(defcustom gnus-newsgroup-default-charset-alist + '(("^hk\\>\\|^tw\\>\\|\\" . cn-big5) + ("^cn\\>\\|\\" . cn-gb-2312) + ("^fj\\>\\|^japan\\>" . iso-2022-jp-2) + ("^relcom\\>" . koi8-r)) + "Alist of Regexps (to match group names) and default charsets to be applied." + :type '(repeat (cons (regexp :tag "Group") + (symbol :tag "Charset"))) + :group 'gnus) + +(defcustom gnus-newsgroup-iso-8859-1-forced-regexp + "^tw\\>\\|^hk\\>\\|^cn\\>\\|\\" + "Regexp of newsgroup in which ISO-8859-1 is forced to other charset." + :type 'regexp + :group 'gnus) + ;;; Internal variables (defvar gnus-scores-exclude-files nil) @@ -820,9 +859,10 @@ which it may alter in any way.") (?S ,(macroexpand '(mail-header-subject gnus-tmp-header)) ?s) (?s gnus-tmp-subject-or-nil ?s) (?n gnus-tmp-name ?s) - (?A (car (cdr (funcall gnus-extract-address-components gnus-tmp-from))) - ?s) - (?a (or (car (funcall gnus-extract-address-components gnus-tmp-from)) + (?A (std11-address-string + (car (mime-read-field 'From gnus-tmp-header))) ?s) + (?a (or (std11-full-name-string + (car (mime-read-field 'From gnus-tmp-header))) gnus-tmp-from) ?s) (?F gnus-tmp-from ?s) (?x ,(macroexpand '(mail-header-xref gnus-tmp-header)) ?s) @@ -845,6 +885,7 @@ which it may alter in any way.") (?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) (?t (gnus-summary-number-of-articles-in-thread (and (boundp 'thread) (car thread)) gnus-tmp-level) ?d) @@ -972,6 +1013,9 @@ variable (string, integer, character, etc).") (defvar gnus-last-article nil) (defvar gnus-newsgroup-history nil) +(defvar gnus-newsgroup-default-charset nil) +(defvar gnus-newsgroup-iso-8859-1-forced nil) + (defconst gnus-summary-local-variables '(gnus-newsgroup-name gnus-newsgroup-begin gnus-newsgroup-end @@ -1002,7 +1046,8 @@ variable (string, integer, character, etc).") (gnus-newsgroup-expunged-tally . 0) gnus-cache-removable-articles gnus-newsgroup-cached gnus-newsgroup-data gnus-newsgroup-data-reverse - gnus-newsgroup-limit gnus-newsgroup-limits) + gnus-newsgroup-limit gnus-newsgroup-limits + gnus-newsgroup-default-charset gnus-newsgroup-iso-8859-1-forced) "Variables that are buffer-local to the summary buffers.") ;; Byte-compiler warning. @@ -1150,7 +1195,7 @@ increase the score of each group you read." [delete] gnus-summary-prev-page [backspace] gnus-summary-prev-page "\r" gnus-summary-scroll-up - "\e\r" gnus-summary-scroll-down + "\M-\r" gnus-summary-scroll-down "n" gnus-summary-next-unread-article "p" gnus-summary-prev-unread-article "N" gnus-summary-next-article @@ -1237,6 +1282,7 @@ increase the score of each group you read." "\C-d" gnus-summary-enter-digest-group "\M-\C-d" gnus-summary-read-document "\M-\C-e" gnus-summary-edit-parameters + "\M-\C-g" gnus-summary-customize-parameters "\C-c\C-b" gnus-bug "*" gnus-cache-enter-article "\M-*" gnus-cache-remove-article @@ -1357,6 +1403,7 @@ increase the score of each group you read." [delete] gnus-summary-prev-page "p" gnus-summary-prev-page "\r" gnus-summary-scroll-up + "\M-\r" gnus-summary-scroll-down "<" gnus-summary-beginning-of-article ">" gnus-summary-end-of-article "b" gnus-summary-beginning-of-article @@ -1391,6 +1438,7 @@ increase the score of each group you read." "b" gnus-article-hide-boring-headers "s" gnus-article-hide-signature "c" gnus-article-hide-citation + "C" gnus-article-hide-citation-in-followups "p" gnus-article-hide-pgp "P" gnus-article-hide-pem "\C-c" gnus-article-hide-citation-maybe) @@ -1450,7 +1498,16 @@ 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 - "s" gnus-soup-add-article)) + "s" gnus-soup-add-article) + + (gnus-define-keys (gnus-summary-mime-map "K" gnus-summary-mode-map) + "b" gnus-summary-display-buttonized + "v" gnus-article-view-part + "o" gnus-article-save-part + "c" gnus-article-copy-part + "e" gnus-article-externalize-part + "|" gnus-article-pipe-part) + ) (defun gnus-summary-make-menu-bar () (gnus-turn-off-edit-menu 'summary) @@ -1624,8 +1681,8 @@ increase the score of each group you read." ["Wide reply and yank" gnus-summary-wide-reply-with-original t] ["Mail forward" gnus-summary-mail-forward t] ["Post forward" gnus-summary-post-forward t] - ["Digest and mail" gnus-uu-digest-mail-forward t] - ["Digest and post" gnus-uu-digest-post-forward t] + ["Digest and mail" gnus-summary-mail-digest t] + ["Digest and post" gnus-summary-post-digest t] ["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] @@ -1742,9 +1799,11 @@ increase the score of each group you read." ["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] + ["Customize group parameters" gnus-summary-customize-parameters t] + ["Send a bug report" gnus-bug t] ("Exit" ["Catchup and exit" gnus-summary-catchup-and-exit t] - ["Catchup all and exit" gnus-summary-catchup-and-exit t] + ["Catchup all and exit" gnus-summary-catchup-all-and-exit t] ["Catchup and goto next" gnus-summary-catchup-and-goto-next-group t] ["Exit group" gnus-summary-exit t] ["Exit group without updating" gnus-summary-exit-no-update t] @@ -1771,6 +1830,7 @@ increase the score of each group you read." ("article body" "body" string) ("article head" "head" string) ("xref" "xref" string) + ("extra header" "extra" string) ("lines" "lines" number) ("followups to author" "followup" string))) (types '((number ("less than" <) @@ -1872,7 +1932,7 @@ The following commands are available: (setq mode-name "Summary") (make-local-variable 'minor-mode-alist) (use-local-map gnus-summary-mode-map) - (buffer-disable-undo (current-buffer)) + (buffer-disable-undo) (setq buffer-read-only t) ;Disable modification (setq truncate-lines t) (setq selective-display t) @@ -1983,21 +2043,26 @@ The following commands are available: (when list (let ((data (and after-article (gnus-data-find-list after-article))) (ilist list)) - (or data (not after-article) (error "No such article: %d" after-article)) - ;; Find the last element in the list to be spliced into the main - ;; list. - (while (cdr list) - (setq list (cdr list))) - (if (not data) - (progn - (setcdr list gnus-newsgroup-data) - (setq gnus-newsgroup-data ilist) + (if (not (or data + after-article)) + (let ((odata gnus-newsgroup-data)) + (setq gnus-newsgroup-data (nconc list gnus-newsgroup-data)) (when offset - (gnus-data-update-list (cdr list) offset))) - (setcdr list (cdr data)) - (setcdr data ilist) - (when offset - (gnus-data-update-list (cdr list) offset))) + (gnus-data-update-list odata offset))) + ;; Find the last element in the list to be spliced into the main + ;; list. + (while (cdr list) + (setq list (cdr list))) + (if (not data) + (progn + (setcdr list gnus-newsgroup-data) + (setq gnus-newsgroup-data ilist) + (when offset + (gnus-data-update-list (cdr list) offset))) + (setcdr list (cdr data)) + (setcdr data ilist) + (when offset + (gnus-data-update-list (cdr list) offset)))) (setq gnus-newsgroup-data-reverse nil)))) (defun gnus-data-remove (article &optional offset) @@ -2026,21 +2091,11 @@ The following commands are available: (defun gnus-data-update-list (data offset) "Add OFFSET to the POS of all data entries in DATA." + (setq gnus-newsgroup-data-reverse nil) (while data (setcar (nthcdr 2 (car data)) (+ offset (nth 2 (car data)))) (setq data (cdr data)))) -(defun gnus-data-compute-positions () - "Compute the positions of all articles." - (let ((data gnus-newsgroup-data) - pos) - (while data - (when (setq pos (text-property-any - (point-min) (point-max) - 'gnus-number (gnus-data-number (car data)))) - (gnus-data-set-pos (car data) (+ pos 3))) - (setq data (cdr data))))) - (defun gnus-summary-article-pseudo-p (article) "Say whether this article is a pseudo article or not." (not (vectorp (gnus-data-header (gnus-data-find article))))) @@ -2208,6 +2263,21 @@ marks of articles." ,@forms) (gnus-restore-hidden-threads-configuration ,config))))) +(defun gnus-data-compute-positions () + "Compute the positions of all articles." + (setq gnus-newsgroup-data-reverse nil) + (let ((data gnus-newsgroup-data)) + (save-excursion + (gnus-save-hidden-threads + (gnus-summary-show-all-threads) + (goto-char (point-min)) + (while data + (while (get-text-property (point) 'gnus-intangible) + (forward-line 1)) + (gnus-data-set-pos (car data) (+ (point) 3)) + (setq data (cdr data)) + (forward-line 1)))))) + (defun gnus-hidden-threads-configuration () "Return the current hidden threads configuration." (save-excursion @@ -2223,7 +2293,7 @@ marks of articles." (while (setq point (pop config)) (when (and (< point (point-max)) (goto-char point) - (= (following-char) ?\n)) + (eq (char-after) ?\n)) (subst-char-in-region point (1+ point) ?\n ?\r))))) ;; Various summary mode internalish functions. @@ -2268,8 +2338,7 @@ marks of articles." (setq gnus-summary-buffer (current-buffer)) (not gnus-newsgroup-prepared)) ;; Fix by Sudish Joseph - (setq gnus-summary-buffer (set-buffer (get-buffer-create buffer))) - (gnus-add-current-to-buffer-list) + (setq gnus-summary-buffer (set-buffer (gnus-get-buffer-create buffer))) (gnus-summary-mode group) (when gnus-carpal (gnus-carpal-setup-buffer 'summary)) @@ -2296,7 +2365,9 @@ marks of articles." (original gnus-original-article-buffer) (gac gnus-article-current) (reffed gnus-reffed-article-number) - (score-file gnus-current-score-file)) + (score-file gnus-current-score-file) + (default-charset gnus-newsgroup-default-charset) + (iso-8859-1-forced gnus-newsgroup-iso-8859-1-forced)) (save-excursion (set-buffer gnus-group-buffer) (setq gnus-newsgroup-name name @@ -2309,7 +2380,9 @@ marks of articles." gnus-article-buffer article-buffer gnus-original-article-buffer original gnus-reffed-article-number reffed - gnus-current-score-file score-file) + gnus-current-score-file score-file + gnus-newsgroup-default-charset default-charset + gnus-newsgroup-iso-8859-1-forced iso-8859-1-forced) ;; The article buffer also has local variables. (when (gnus-buffer-live-p gnus-article-buffer) (set-buffer gnus-article-buffer) @@ -2328,7 +2401,7 @@ marks of articles." (defun gnus-summary-last-article-p (&optional article) "Return whether ARTICLE is the last article in the buffer." (if (not (setq article (or article (gnus-summary-article-number)))) - t ; All non-existent numbers are the last article. :-) + t ; All non-existent numbers are the last article. :-) (not (cdr (gnus-data-find-list article))))) (defun gnus-make-thread-indent-array () @@ -2352,13 +2425,14 @@ marks of articles." (gnus-score-over-mark 130) (gnus-download-mark 131) (spec gnus-summary-line-format-spec) - thread gnus-visual pos) + gnus-visual pos) (save-excursion (gnus-set-work-buffer) (let ((gnus-summary-line-format-spec spec) (gnus-newsgroup-downloadable '((0 . t)))) (gnus-summary-insert-line - [0 "" "" "" "" "" 0 0 ""] 0 nil 128 t nil "" nil 1) + (make-full-mail-header 0 "" "" "" "" "" 0 0 "" nil) + 0 nil 128 t nil "" nil 1) (goto-char (point-min)) (setq pos (list (cons 'unread (and (search-forward "\200" nil t) (- (point) 2))))) @@ -2382,6 +2456,31 @@ marks of articles." (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)))) + (rfc2047-default-charset gnus-newsgroup-default-charset) + (mm-charset-iso-8859-1-forced gnus-newsgroup-iso-8859-1-forced)) + (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)))))) + (defun gnus-summary-insert-line (gnus-tmp-header gnus-tmp-level gnus-tmp-current gnus-tmp-unread gnus-tmp-replied @@ -2514,7 +2613,8 @@ the thread are to be displayed." (set (car elem) (eval (nth 1 elem)))))))) (defun gnus-summary-read-group (group &optional show-all no-article - kill-buffer no-display backward) + kill-buffer no-display backward + select-articles) "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. @@ -2525,8 +2625,10 @@ If NO-DISPLAY, don't generate a summary buffer." (let ((gnus-auto-select-next nil)) (or (gnus-summary-read-group-1 group show-all no-article - kill-buffer no-display) - (setq show-all nil))))) + kill-buffer no-display + select-articles) + (setq show-all nil + select-articles nil))))) (eq gnus-auto-select-next 'quietly)) (set-buffer gnus-group-buffer) ;; The entry function called above goes to the next @@ -2540,7 +2642,8 @@ If NO-DISPLAY, don't generate a summary buffer." result)) (defun gnus-summary-read-group-1 (group show-all no-article - kill-buffer no-display) + kill-buffer no-display + &optional select-articles) ;; Killed foreign groups can't be entered. (when (and (not (gnus-group-native-p group)) (not (gnus-gethash group gnus-newsrc-hashtb))) @@ -2548,7 +2651,8 @@ If NO-DISPLAY, don't generate a summary buffer." (gnus-message 5 "Retrieving newsgroup: %s..." group) (let* ((new-group (gnus-summary-setup-buffer group)) (quit-config (gnus-group-quit-config group)) - (did-select (and new-group (gnus-select-newsgroup group show-all)))) + (did-select (and new-group (gnus-select-newsgroup + group show-all select-articles)))) (cond ;; This summary buffer exists already, so we just select it. ((not new-group) @@ -2663,16 +2767,21 @@ If NO-DISPLAY, don't generate a summary buffer." (not no-display) gnus-newsgroup-unreads gnus-auto-select-first) - (unless (if (eq gnus-auto-select-first 'best) - (gnus-summary-best-unread-article) - (gnus-summary-first-unread-article)) - (gnus-configure-windows 'summary)) + (progn + (gnus-configure-windows 'summary) + (cond + ((eq gnus-auto-select-first 'best) + (gnus-summary-best-unread-article)) + ((eq gnus-auto-select-first t) + (gnus-summary-first-unread-article)) + ((gnus-functionp gnus-auto-select-first) + (funcall gnus-auto-select-first)))) ;; Don't select any articles, just move point to the first ;; article in the group. (goto-char (point-min)) (gnus-summary-position-point) (gnus-configure-windows 'summary 'force) - (gnus-set-mode-line 'summary)) + (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. @@ -2872,7 +2981,7 @@ If NO-DISPLAY, don't generate a summary buffer." threads)) ;; Build the thread tree. -(defun gnus-dependencies-add-header (header dependencies force-new) +(defsubst 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 @@ -2953,7 +3062,7 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." (let ((headers gnus-newsgroup-headers) (gnus-summary-ignore-duplicates t) header references generation relations - cthread subject child end pthread relation new-child date) + subject child end new-child date) ;; First we create an alist of generations/relations, where ;; generations is how much we trust the relation, and the relation ;; is parent/child. @@ -3018,12 +3127,9 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." (setq heads nil))))) gnus-newsgroup-dependencies))) -;; The following macros and functions were written by Felix Lee -;; . - (defmacro gnus-nov-read-integer () '(prog1 - (if (= (following-char) ?\t) + (if (eq (char-after) ?\t) 0 (let ((num (ignore-errors (read buffer)))) (if (numberp num) num 0))) @@ -3036,12 +3142,22 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." (defmacro gnus-nov-field () '(buffer-substring (point) (if (gnus-nov-skip-field) (1- (point)) eol))) +(defmacro gnus-nov-parse-extra () + '(let (out string) + (while (not (memq (char-after) '(?\n nil))) + (setq string (gnus-nov-field)) + (when (string-match "^\\([^ :]+\\): " string) + (push (cons (intern (match-string 1 string)) + (substring string (match-end 0))) + out))) + out)) + ;; This function has to be called with point after the article number ;; on the beginning of the line. (defsubst gnus-nov-parse-line (number dependencies &optional force-new) (let ((eol (gnus-point-at-eol)) (buffer (current-buffer)) - header rawtext decoded) + header) ;; overview: [num subject from date id refs chars lines misc] (unwind-protect @@ -3053,30 +3169,17 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." (setq header (make-full-mail-header number ; number - (progn - (setq rawtext (gnus-nov-field) ; subject - decoded (funcall - gnus-unstructured-field-decoder rawtext)) - (if (string= rawtext decoded) - rawtext - (put-text-property 0 (length decoded) 'raw-text rawtext decoded) - decoded)) - (progn - (setq rawtext (gnus-nov-field) ; from - decoded (funcall - gnus-structured-field-decoder rawtext)) - (if (string= rawtext decoded) - rawtext - (put-text-property 0 (length decoded) 'raw-text rawtext decoded) - decoded)) + (gnus-nov-field) ; subject + (gnus-nov-field) ; from (gnus-nov-field) ; date (or (gnus-nov-field) (nnheader-generate-fake-message-id)) ; id (gnus-nov-field) ; refs (gnus-nov-read-integer) ; chars (gnus-nov-read-integer) ; lines - (unless (= (following-char) ?\n) - (gnus-nov-field))))) ; misc + (unless (eq (char-after) ?\n) + (gnus-nov-field)) ; misc + (gnus-nov-parse-extra)))) ; extra (widen)) @@ -3123,7 +3226,7 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." "Read all the headers." (let ((gnus-summary-ignore-duplicates t) (dependencies gnus-newsgroup-dependencies) - found header article) + header article) (save-excursion (set-buffer nntp-server-buffer) (let ((case-fold-search nil)) @@ -3134,14 +3237,16 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." header (gnus-nov-parse-line article dependencies))) (when header - (push header gnus-newsgroup-headers) - (if (memq (setq article (mail-header-number header)) - gnus-newsgroup-unselected) - (progn - (push article gnus-newsgroup-unreads) - (setq gnus-newsgroup-unselected - (delq article gnus-newsgroup-unselected))) - (push article gnus-newsgroup-ancient)) + (save-excursion + (set-buffer gnus-summary-buffer) + (push header gnus-newsgroup-headers) + (if (memq (setq article (mail-header-number header)) + gnus-newsgroup-unselected) + (progn + (push article gnus-newsgroup-unreads) + (setq gnus-newsgroup-unselected + (delq article gnus-newsgroup-unselected))) + (push article gnus-newsgroup-ancient))) (forward-line 1))))))) (defun gnus-summary-update-article-line (article header) @@ -3189,7 +3294,7 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." (defun gnus-summary-update-article (article &optional iheader) "Update ARTICLE in the summary buffer." (set-buffer gnus-summary-buffer) - (let* ((header (or iheader (gnus-summary-article-header article))) + (let* ((header (gnus-summary-article-header article)) (id (mail-header-id header)) (data (gnus-data-find article)) (thread (gnus-id-to-thread id)) @@ -3202,16 +3307,13 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." references)) "none"))) (buffer-read-only nil) - (old (car thread)) - (number (mail-header-number header)) - pos) + (old (car thread))) (when thread - ;; !!! Should this be in or not? (unless iheader - (setcar thread nil)) - (when parent - (delq thread parent)) - (if (gnus-summary-insert-subject id header iheader) + (setcar thread nil) + (when parent + (delq thread parent))) + (if (gnus-summary-insert-subject id header) ;; Set the (possibly) new article number in the data structure. (gnus-data-set-number data (gnus-id-to-article id)) (setcar thread old) @@ -3263,10 +3365,11 @@ If LINE, insert the rebuilt thread starting on line LINE." ;;!!! then we want to insert at the beginning of the buffer. ;;!!! That happens to be true with Gnus now, but that may ;;!!! change in the future. Perhaps. - (gnus-data-enter-list (if line nil current) data (- (point) old-pos)) - (setq gnus-newsgroup-threads (nconc threads gnus-newsgroup-threads)) - (when line - (gnus-data-compute-positions))))) + (gnus-data-enter-list + (if line nil current) data (- (point) old-pos)) + (setq gnus-newsgroup-threads + (nconc threads gnus-newsgroup-threads)) + (gnus-data-compute-positions)))) (defun gnus-number-to-header (number) "Return the header for article NUMBER." @@ -3342,9 +3445,8 @@ If LINE, insert the rebuilt thread starting on line LINE." "Remove the thread that has ID in it." (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)) - (caadr (gnus-id-to-thread last-id)))) + (setq last-id (gnus-root-id id) + headers (message-flatten-list (gnus-id-to-thread last-id))) ;; We have now found the real root of this thread. It might have ;; been gathered into some loose thread, so we have to search ;; through the threads to find the thread we wanted. @@ -3394,6 +3496,7 @@ If LINE, insert the rebuilt thread starting on line LINE." (while thread (gnus-remove-thread-1 (car thread)) (setq thread (cdr thread)))) + (gnus-summary-show-all-threads) (gnus-remove-thread-1 thread)))))))) (defun gnus-remove-thread-1 (thread) @@ -3416,10 +3519,10 @@ If LINE, insert the rebuilt thread starting on line LINE." "Sort THREADS." (if (not gnus-thread-sort-functions) threads - (gnus-message 7 "Sorting threads...") + (gnus-message 8 "Sorting threads...") (prog1 (sort threads (gnus-make-sort-function gnus-thread-sort-functions)) - (gnus-message 7 "Sorting threads...done")))) + (gnus-message 8 "Sorting threads...done")))) (defun gnus-sort-articles (articles) "Sort ARTICLES." @@ -3464,14 +3567,15 @@ If LINE, insert the rebuilt thread starting on line LINE." (defsubst gnus-article-sort-by-author (h1 h2) "Sort articles by root author." (string-lessp - (let ((extract (funcall - gnus-extract-address-components - (mail-header-from h1)))) - (or (car extract) (cadr extract) "")) - (let ((extract (funcall - gnus-extract-address-components - (mail-header-from h2)))) - (or (car extract) (cadr extract) "")))) + (let ((addr (mime-read-field 'From h1))) + (or (std11-full-name-string addr) + (std11-address-string addr) + "")) + (let ((addr (mime-read-field 'From h2))) + (or (std11-full-name-string addr) + (std11-address-string addr) + "")) + )) (defun gnus-thread-sort-by-author (h1 h2) "Sort threads by root author." @@ -3491,7 +3595,7 @@ If LINE, insert the rebuilt thread starting on line LINE." (defsubst gnus-article-sort-by-date (h1 h2) "Sort articles by root article date." - (gnus-time-less + (time-less-p (gnus-date-get-time (mail-header-date h1)) (gnus-date-get-time (mail-header-date h2)))) @@ -3552,6 +3656,12 @@ Unscored articles will be counted as having a score of zero." (defvar gnus-tmp-root-expunged nil) (defvar gnus-tmp-dummy-line nil) +(defvar gnus-tmp-header) +(defun gnus-extra-header (type &optional header) + "Return the extra header of TYPE." + (or (cdr (assq type (mail-header-extra (or header gnus-tmp-header)))) + "")) + (defun gnus-summary-prepare-threads (threads) "Prepare summary buffer from THREADS and indentation LEVEL. THREADS is either a list of `(PARENT [(CHILD1 [(GRANDCHILD ...]...) ...])' @@ -3779,7 +3889,7 @@ or a straight list of headers." (setq gnus-tmp-name gnus-tmp-from)) (unless (numberp gnus-tmp-lines) (setq gnus-tmp-lines 0)) - (gnus-put-text-property-excluding-characters-with-faces + (gnus-put-text-property (point) (progn (eval gnus-summary-line-format-spec) (point)) 'gnus-number number) @@ -3833,13 +3943,14 @@ or a straight list of headers." (cdr (assq number gnus-newsgroup-scored)) (memq number gnus-newsgroup-processable)))))) -(defun gnus-select-newsgroup (group &optional read-all) +(defun gnus-select-newsgroup (group &optional read-all select-articles) "Select newsgroup GROUP. -If READ-ALL is non-nil, all articles in the group are selected." +If READ-ALL is non-nil, all articles in the group are selected. +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)) @@ -3884,10 +3995,13 @@ If READ-ALL is non-nil, all articles in the group are selected." (setq gnus-newsgroup-processable nil) (gnus-update-read-articles group gnus-newsgroup-unreads) - (unless (gnus-ephemeral-group-p gnus-newsgroup-name) - (gnus-group-update-group group)) - (setq articles (gnus-articles-to-read group read-all)) + (if (setq articles select-articles) + (setq gnus-newsgroup-unselected + (gnus-sorted-intersection + gnus-newsgroup-unreads + (gnus-sorted-complement gnus-newsgroup-unreads articles))) + (setq articles (gnus-articles-to-read group read-all))) (cond ((null articles) @@ -3898,6 +4012,7 @@ If READ-ALL is non-nil, all articles in the group are selected." ;; Init the dependencies hash table. (setq gnus-newsgroup-dependencies (gnus-make-hashtable (length articles))) + (gnus-set-global-variables) ;; Retrieve the headers and read them in. (gnus-message 5 "Fetching headers for %s..." gnus-newsgroup-name) (setq gnus-newsgroup-headers @@ -3937,15 +4052,15 @@ If READ-ALL is non-nil, all articles in the group are selected." ;; Removed marked articles that do not exist. (gnus-update-missing-marks (gnus-sorted-complement fetched-articles articles)) - ;; Let the Gnus agent mark articles as read. - (when gnus-agent - (gnus-agent-get-undownloaded-list)) ;; 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-old-threads))) + ;; Let the Gnus agent mark articles as read. + (when gnus-agent + (gnus-agent-get-undownloaded-list)) ;; Check whether auto-expire is to be done in this group. (setq gnus-newsgroup-auto-expire (gnus-group-auto-expirable-p group)) @@ -4108,7 +4223,7 @@ If READ-ALL is non-nil, all articles in the group are selected." (let ((types gnus-article-mark-lists) (info (gnus-get-info gnus-newsgroup-name)) (uncompressed '(score bookmark killed)) - type list newmarked symbol) + type list newmarked symbol delta-marks) (when info ;; Add all marks lists that are non-nil to the list of marks lists. (while (setq type (pop types)) @@ -4157,7 +4272,9 @@ If READ-ALL is non-nil, all articles in the group are selected." "This function sets the mode line of the article or summary buffers. If WHERE is `summary', the summary mode line format will be used." ;; Is this mode line one we keep updated? - (when (memq where gnus-updated-mode-lines) + (when (and (memq where gnus-updated-mode-lines) + (symbol-value + (intern (format "gnus-%s-mode-line-format-spec" where)))) (let (mode-string) (save-excursion ;; We evaluate this in the summary buffer since these @@ -4313,7 +4430,7 @@ The resulting hash table is returned, or nil if no Xrefs were found." ;; Then we add the read articles to the range. (gnus-add-to-range ninfo (setq articles (sort articles '<)))))) - + (defun gnus-group-make-articles-read (group articles) "Update the info of GROUP to say that ARTICLES are read." (let* ((num 0) @@ -4371,15 +4488,17 @@ The resulting hash table is returned, or nil if no Xrefs were found." (or dependencies (save-excursion (set-buffer gnus-summary-buffer) gnus-newsgroup-dependencies))) - headers id id-dep ref-dep end ref) + headers id end ref + (rfc2047-default-charset gnus-newsgroup-default-charset) + (mm-charset-iso-8859-1-forced gnus-newsgroup-iso-8859-1-forced)) (save-excursion (set-buffer nntp-server-buffer) ;; Translate all TAB characters into SPACE characters. (subst-char-in-region (point-min) (point-max) ?\t ? t) + (subst-char-in-region (point-min) (point-max) ?\r ? t) (gnus-run-hooks 'gnus-parse-headers-hook) (let ((case-fold-search t) - rawtext decoded - in-reply-to header p lines chars) + in-reply-to header p lines chars ctype) (goto-char (point-min)) ;; Search to the beginning of the next header. Error messages ;; do not begin with 2 or 3. @@ -4394,7 +4513,7 @@ The resulting hash table is returned, or nil if no Xrefs were found." ;; doesn't always go hand in hand. (setq header - (vector + (make-full-mail-header ;; Number. (prog1 (read cur) @@ -4408,33 +4527,20 @@ The resulting hash table is returned, or nil if no Xrefs were found." (progn (goto-char p) (if (search-forward "\nsubject: " nil t) - (progn - (setq rawtext (nnheader-header-value) - decoded (funcall - gnus-unstructured-field-decoder rawtext)) - (if (string-equal rawtext decoded) - rawtext - (put-text-property 0 (length decoded) 'raw-text rawtext decoded) - decoded)) + (buffer-substring (match-end 0) (std11-field-end)) "(none)")) ;; From. (progn (goto-char p) (if (search-forward "\nfrom: " nil t) - (progn - (setq rawtext (nnheader-header-value) - decoded (funcall - gnus-structured-field-decoder rawtext)) - (if (string-equal rawtext decoded) - rawtext - (put-text-property 0 (length decoded) 'raw-text rawtext decoded) - decoded)) + (buffer-substring (match-end 0) (std11-field-end)) "(nobody)")) ;; Date. (progn (goto-char p) (if (search-forward "\ndate: " nil t) - (nnheader-header-value) "")) + (buffer-substring (match-end 0) (std11-field-end)) + "")) ;; Message-ID. (progn (goto-char p) @@ -4454,11 +4560,11 @@ The resulting hash table is returned, or nil if no Xrefs were found." (progn (setq end (point)) (prog1 - (nnheader-header-value) + (buffer-substring (match-end 0) (std11-field-end)) (setq ref (buffer-substring (progn - (end-of-line) + ;; (end-of-line) (search-backward ">" end t) (1+ (point))) (progn @@ -4468,7 +4574,9 @@ The resulting hash table is returned, or nil if no Xrefs were found." ;; were no references and the in-reply-to header looks ;; promising. (if (and (search-forward "\nin-reply-to: " nil t) - (setq in-reply-to (nnheader-header-value)) + (setq in-reply-to + (buffer-substring (match-end 0) + (std11-field-end))) (string-match "<[^>]+>" in-reply-to)) (let (ref2) (setq ref (substring in-reply-to (match-beginning 0) @@ -4477,7 +4585,8 @@ The resulting hash table is returned, or nil if no Xrefs were found." (setq ref2 (substring in-reply-to (match-beginning 0) (match-end 0))) (when (> (length ref2) (length ref)) - (setq ref ref2)))) + (setq ref ref2))) + ref) (setq ref nil)))) ;; Chars. (progn @@ -4497,7 +4606,27 @@ The resulting hash table is returned, or nil if no Xrefs were found." (progn (goto-char p) (and (search-forward "\nxref: " nil t) - (nnheader-header-value))))) + (buffer-substring (match-end 0) (std11-field-end)))) + ;; Extra. + (when gnus-extra-headers + (let ((extra gnus-extra-headers) + out) + (while extra + (goto-char p) + (when (search-forward + (concat "\n" (symbol-name (car extra)) ": ") nil t) + (push (cons (car extra) + (buffer-substring (match-end 0) + (std11-field-end))) + out)) + (pop extra)) + out)))) + (goto-char p) + (if (and (search-forward "\ncontent-type: " nil t) + (setq ctype + (buffer-substring (match-end 0) (std11-field-end)))) + (mime-entity-set-content-type-internal + header (mime-parse-Content-Type ctype))) (when (equal id ref) (setq ref nil)) @@ -4523,11 +4652,14 @@ list of headers that match SEQUENCE (see `nntp-retrieve-headers')." ;; Get the Xref when the users reads the articles since most/some ;; NNTP servers do not include Xrefs when using XOVER. (setq gnus-article-internal-prepare-hook '(gnus-article-get-xrefs)) - (let ((cur nntp-server-buffer) + (let ((rfc2047-default-charset gnus-newsgroup-default-charset) + (mm-charset-iso-8859-1-forced gnus-newsgroup-iso-8859-1-forced) + (cur nntp-server-buffer) (dependencies (or dependencies gnus-newsgroup-dependencies)) number headers header) (save-excursion (set-buffer nntp-server-buffer) + (subst-char-in-region (point-min) (point-max) ?\r ? t) ;; Allow the user to mangle the headers before parsing them. (gnus-run-hooks 'gnus-parse-headers-hook) (goto-char (point-min)) @@ -4581,7 +4713,7 @@ This is meant to be called in `gnus-article-internal-prepare-hook'." (save-restriction (nnheader-narrow-to-headers) (goto-char (point-min)) - (when (or (and (eq (downcase (following-char)) ?x) + (when (or (and (eq (downcase (char-after)) ?x) (looking-at "Xref:")) (search-forward "\nXref:" nil t)) (goto-char (1+ (match-end 0))) @@ -4596,14 +4728,14 @@ the subject line on." (let* ((line (and (numberp old-header) old-header)) (old-header (and (vectorp old-header) old-header)) (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) + 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)) + d) (when header ;; Rebuild the thread that this article is part of and go to the ;; article we have fetched. @@ -4845,7 +4977,9 @@ displayed, no centering will be performed." ;; Recenter only when requested. Suggested by popovich@park.cs.columbia.edu. (let* ((top (cond ((< (window-height) 4) 0) ((< (window-height) 7) 1) - (t 2))) + (t (if (numberp gnus-auto-center-summary) + gnus-auto-center-summary + 2)))) (height (1- (window-height))) (bottom (save-excursion (goto-char (point-max)) (forward-line (- height)) @@ -4901,12 +5035,12 @@ displayed, no centering will be performed." ;; first unread article is the article after the last read ;; article. Sounds logical, doesn't it? (if (not (listp (cdr read))) - (setq first (1+ (cdr read))) + (setq first (max (car active) (1+ (cdr read)))) ;; `read' is a list of ranges. (when (/= (setq nlast (or (and (numberp (car read)) (car read)) (caar read))) 1) - (setq first 1)) + (setq first (car active))) (while read (when first (while (< first nlast) @@ -5027,7 +5161,7 @@ The prefix argument ALL means to select all articles." (gnus-update-read-articles group (append gnus-newsgroup-unreads gnus-newsgroup-unselected)) ;; Set the current article marks. - (let ((gnus-newsgroup-scored + (let ((gnus-newsgroup-scored (if (and (not gnus-save-score) (not non-destructive)) nil @@ -5126,12 +5260,12 @@ gnus-exit-group-hook is called with no arguments if that value is non-nil." (gnus-kill-buffer buf))) (setq gnus-current-select-method gnus-select-method) (pop-to-buffer gnus-group-buffer) - ;; Clear the current group name. (if (not quit-config) (progn (goto-char group-point) (gnus-configure-windows 'group 'force)) (gnus-handle-ephemeral-exit quit-config)) + ;; Clear the current group name. (unless quit-config (setq gnus-newsgroup-name nil))))) @@ -5145,7 +5279,8 @@ gnus-exit-group-hook is called with no arguments if that value is non-nil." 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) + (gnus-run-hooks (delq 'gnus-summary-expire-articles + (copy-list 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) @@ -5218,12 +5353,6 @@ The state which existed when entering the ephemeral is reset." (select-window (get-buffer-window 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) @@ -5793,6 +5922,12 @@ Argument LINES specifies lines to be scrolled up (or down if negative)." (gnus-summary-recenter) (gnus-summary-position-point)) +(defun gnus-summary-scroll-down (lines) + "Scroll down (or up) one line current article. +Argument LINES specifies lines to be scrolled down (or up if negative)." + (interactive "p") + (gnus-summary-scroll-up (- lines))) + (defun gnus-summary-next-same-subject () "Select next article which has the same subject as current one." (interactive) @@ -5824,15 +5959,25 @@ Return nil if there are no unread articles." (gnus-summary-display-article (gnus-summary-article-number))) (gnus-summary-position-point))) +(defun gnus-summary-first-unread-subject () + "Place the point on the subject line of the first unread article. +Return nil if there are no unread articles." + (interactive) + (prog1 + (when (gnus-summary-first-subject t) + (gnus-summary-show-thread) + (gnus-summary-first-subject t)) + (gnus-summary-position-point))) + (defun gnus-summary-first-article () "Select the first article. Return nil if there are no articles." (interactive) (prog1 (when (gnus-summary-first-subject) - (gnus-summary-show-thread) - (gnus-summary-first-subject) - (gnus-summary-display-article (gnus-summary-article-number))) + (gnus-summary-show-thread) + (gnus-summary-first-subject) + (gnus-summary-display-article (gnus-summary-article-number))) (gnus-summary-position-point))) (defun gnus-summary-best-unread-article () @@ -5957,13 +6102,13 @@ articles that are younger than AGE days." (interactive "nTime in days: \nP") (prog1 (let ((data gnus-newsgroup-data) - (cutoff (nnmail-days-to-time age)) + (cutoff (days-to-time age)) articles d date is-younger) (while (setq d (pop data)) (when (and (vectorp (gnus-data-header d)) (setq date (mail-header-date (gnus-data-header d)))) - (setq is-younger (nnmail-time-less - (nnmail-time-since (nnmail-date-to-time date)) + (setq is-younger (time-less-p + (time-since (date-to-time date)) cutoff)) (when (if younger-p is-younger @@ -6152,6 +6297,7 @@ If ALL, mark even excluded ticked and dormants as read." ;; after the current one. (goto-char (point-max)) (gnus-summary-find-prev)) + (gnus-set-mode-line 'summary) ;; We return how many articles were removed from the summary ;; buffer as a result of the new limit. (- total (length gnus-newsgroup-data)))) @@ -6167,7 +6313,7 @@ If ALL, mark even excluded ticked and dormants as read." (defsubst gnus-cut-thread (thread) "Go forwards in the thread until we find an article that we want to display." (when (or (eq gnus-fetch-old-headers 'some) - (eq gnus-fetch-old-headers 'invisible) + (eq gnus-fetch-old-headers 'invisible) (eq gnus-build-sparse-threads 'some) (eq gnus-build-sparse-threads 'more)) ;; Deal with old-fetched headers and sparse threads. @@ -6401,8 +6547,7 @@ of what's specified by the `gnus-refer-thread-limit' variable." (interactive "P") (let ((id (mail-header-id (gnus-summary-article-header))) (limit (if limit (prefix-numeric-value limit) - gnus-refer-thread-limit)) - fmethod root) + gnus-refer-thread-limit))) ;; We want to fetch LIMIT *old* headers, but we also have to ;; re-fetch all the headers in the current buffer, because many of ;; them may be undisplayed. So we adjust LIMIT. @@ -6437,8 +6582,7 @@ 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))) - h) + gnus-newsgroup-limit)))) (cond ;; If the article is present in the buffer we just go to it. ((and header @@ -6473,6 +6617,11 @@ or `gnus-select-method', no matter what backend the article comes from." (interactive) (gnus-group-edit-group gnus-newsgroup-name 'params)) +(defun gnus-summary-customize-parameters () + "Customize the group parameters of the current group." + (interactive) + (gnus-group-customize gnus-newsgroup-name)) + (defun gnus-summary-enter-digest-group (&optional force) "Enter an nndoc group based on the current article. If FORCE, force a digest interpretation. If not, try @@ -6537,7 +6686,7 @@ Obeys the standard process/prefix convention." (gnus-summary-remove-process-mark article) (when (gnus-summary-display-article article) (save-excursion - (nnheader-temp-write nil + (with-temp-buffer (insert-buffer-substring gnus-original-article-buffer) ;; Remove some headers that may lead nndoc to make ;; the wrong guess. @@ -6617,6 +6766,7 @@ Optional argument BACKWARD means do search for backward. ;; We have to require this here to make sure that the following ;; dynamic binding isn't shadowed by autoloading. (require 'gnus-async) + (require 'gnus-art) (let ((gnus-select-article-hook nil) ;Disable hook. (gnus-article-display-hook nil) (gnus-mark-article-hook nil) ;Inhibit marking as read. @@ -6771,14 +6921,14 @@ to save in." (set-buffer buffer) (gnus-article-delete-invisible-text) (let ((ps-left-header - (list + (list (concat "(" (mail-header-subject gnus-current-headers) ")") (concat "(" (mail-header-from gnus-current-headers) ")"))) - (ps-right-header - (list - "/pagenumberstring load" + (ps-right-header + (list + "/pagenumberstring load" (concat "(" (mail-header-date gnus-current-headers) ")")))) (gnus-run-hooks 'gnus-ps-print-hook) @@ -6794,10 +6944,15 @@ article massaging functions being run." (if (not arg) ;; Select the article the normal way. (gnus-summary-select-article nil 'force) + ;; We have to require this here to make sure that the following + ;; dynamic binding isn't shadowed by autoloading. + (require 'gnus-async) + (require 'gnus-art) ;; Bind the article treatment functions to nil. (let ((gnus-have-all-headers t) gnus-article-display-hook gnus-article-prepare-hook + gnus-article-decode-hook gnus-break-pages gnus-show-mime gnus-visual) @@ -6962,7 +7117,7 @@ and `request-accept' functions." gnus-newsgroup-name)) ; Server (list 'gnus-request-accept-article to-newsgroup (list 'quote select-method) - (not articles)) ; Accept form + (not articles) t) ; Accept form (not articles))) ; Only save nov last time ;; Copy the article. ((eq action 'copy) @@ -6970,7 +7125,7 @@ and `request-accept' functions." (set-buffer copy-buf) (when (gnus-request-article-this-buffer article gnus-newsgroup-name) (gnus-request-accept-article - to-newsgroup select-method (not articles))))) + to-newsgroup select-method (not articles) t)))) ;; Crosspost the article. ((eq action 'crosspost) (let ((xref (message-tokenize-header @@ -7010,15 +7165,10 @@ and `request-accept' functions." (gnus-summary-mark-article article gnus-canceled-mark) (gnus-message 4 "Deleted article %s" article)) (t - (let* ((entry - (or - (gnus-gethash (car art-group) gnus-newsrc-hashtb) - (gnus-gethash - (gnus-group-prefixed-name - (car art-group) - (or select-method - (gnus-find-method-for-group to-newsgroup))) - gnus-newsrc-hashtb))) + (let* ((pto-group (gnus-group-prefixed-name + (car art-group) to-method)) + (entry + (gnus-gethash pto-group gnus-newsrc-hashtb)) (info (nth 2 entry)) (to-group (gnus-info-group info))) ;; Update the group that has been moved to. @@ -7089,7 +7239,7 @@ and `request-accept' functions." ;;;!!!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)))) @@ -7122,7 +7272,7 @@ re-spool using this method." (defcustom gnus-summary-respool-default-method nil "Default method for respooling an article. If nil, use to the current newsgroup method." - :type `(choice (gnus-select-method :value (nnml "")) + :type '(choice (gnus-select-method :value (nnml "")) (const nil)) :group 'gnus-summary-mail) @@ -7182,8 +7332,7 @@ latter case, they will be copied into the relevant groups." (not (file-regular-p file)) (error "Can't read %s" file)) (save-excursion - (set-buffer (get-buffer-create " *import file*")) - (buffer-disable-undo (current-buffer)) + (set-buffer (gnus-get-buffer-create " *import file*")) (erase-buffer) (nnheader-insert-file-contents file) (goto-char (point-min)) @@ -7193,10 +7342,7 @@ latter case, they will be copied into the relevant groups." lines (count-lines (point-min) (point-max))) (insert "From: " (read-string "From: ") "\n" "Subject: " (read-string "Subject: ") "\n" - "Date: " (timezone-make-date-arpa-standard - (current-time-string (nth 5 atts)) - (current-time-zone now) - (current-time-zone now)) + "Date: " (message-make-date (nth 5 atts)) "\n" "Message-ID: " (message-make-message-id) "\n" "Lines: " (int-to-string lines) "\n" @@ -7347,7 +7493,7 @@ groups." (interactive) ;; Replace the article. (let ((buf (current-buffer))) - (nnheader-temp-write nil + (with-temp-buffer (insert-buffer buf) (if (and (not read-only) (not (gnus-request-replace-article @@ -7365,7 +7511,7 @@ groups." (message-narrow-to-head) (let ((head (buffer-string)) header) - (nnheader-temp-write nil + (with-temp-buffer (insert (format "211 %d Article retrieved.\n" (cdr gnus-article-current))) (insert head) @@ -7553,7 +7699,7 @@ the actual number of articles marked is returned." "Mark ARTICLE replied and update the summary line." (push article gnus-newsgroup-replied) (let ((buffer-read-only nil)) - (when (gnus-summary-goto-subject article) + (when (gnus-summary-goto-subject article nil t) (gnus-summary-update-secondary-mark article)))) (defun gnus-summary-set-bookmark (article) @@ -7612,6 +7758,7 @@ the actual number of articles marked is returned." (delq article gnus-newsgroup-processable))) (when (gnus-summary-goto-subject article) (gnus-summary-show-thread) + (gnus-summary-goto-subject article) (gnus-summary-update-secondary-mark article))) (defun gnus-summary-remove-process-mark (article) @@ -7619,6 +7766,7 @@ the actual number of articles marked is returned." (setq gnus-newsgroup-processable (delq article gnus-newsgroup-processable)) (when (gnus-summary-goto-subject article) (gnus-summary-show-thread) + (gnus-summary-goto-subject article) (gnus-summary-update-secondary-mark article))) (defun gnus-summary-set-saved-mark (article) @@ -7633,6 +7781,7 @@ If N is negative, mark backwards instead. Mark with MARK, ?r by default. The difference between N and the actual number of articles marked is returned." (interactive "p") + (gnus-summary-show-thread) (let ((backward (< n 0)) (gnus-summary-goto-unread (and gnus-summary-goto-unread @@ -7670,12 +7819,10 @@ returned." (setq mark (gnus-request-update-mark gnus-newsgroup-name article mark)) ;; Check for auto-expiry. (when (and gnus-newsgroup-auto-expire - (or (= mark gnus-killed-mark) (= mark gnus-del-mark) - (= mark gnus-catchup-mark) (= mark gnus-low-score-mark) - (= mark gnus-ancient-mark) - (= mark gnus-read-mark) (= mark gnus-souped-mark) - (= mark gnus-duplicate-mark))) + (memq mark gnus-auto-expirable-marks)) (setq mark gnus-expirable-mark) + ;; Let the backend know about the mark change. + (setq mark (gnus-request-update-mark gnus-newsgroup-name article mark)) (push article gnus-newsgroup-expirable)) ;; Set the mark in the buffer. (gnus-summary-update-mark mark 'unread) @@ -7685,6 +7832,8 @@ returned." "Mark the current article quickly as unread with MARK." (let* ((article (gnus-summary-article-number)) (old-mark (gnus-summary-article-mark article))) + ;; Allow the backend to change the mark. + (setq mark (gnus-request-update-mark gnus-newsgroup-name article mark)) (if (eq mark old-mark) t (if (<= article 0) @@ -7721,25 +7870,23 @@ returned." "Mark ARTICLE with MARK. MARK can be any character. Four MARK strings are reserved: `? ' (unread), `?!' (ticked), `??' (dormant) and `?E' (expirable). -If MARK is nil, then the default character `?D' is used. +If MARK is nil, then the default character `?r' is used. If ARTICLE is nil, then the article on the current line will be marked." ;; The mark might be a string. (when (stringp mark) (setq mark (aref mark 0))) ;; If no mark is given, then we check auto-expiring. - (and (not no-expire) - gnus-newsgroup-auto-expire - (or (not mark) - (and (gnus-characterp mark) - (or (= mark gnus-killed-mark) (= mark gnus-del-mark) - (= mark gnus-catchup-mark) (= mark gnus-low-score-mark) - (= mark gnus-read-mark) (= mark gnus-souped-mark) - (= mark gnus-duplicate-mark)))) - (setq mark gnus-expirable-mark)) - (let* ((mark (or mark gnus-del-mark)) - (article (or article (gnus-summary-article-number))) - (old-mark (gnus-summary-article-mark article))) + (when (null mark) + (setq mark gnus-del-mark)) + (when (and (not no-expire) + gnus-newsgroup-auto-expire + (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))) + ;; Allow the backend to change the mark. + (setq mark (gnus-request-update-mark gnus-newsgroup-name article mark)) (if (eq mark old-mark) t (unless article @@ -7789,19 +7936,19 @@ marked." (let ((forward (cdr (assq type gnus-summary-mark-positions))) (buffer-read-only nil)) (re-search-backward "[\n\r]" (gnus-point-at-bol) 'move-to-limit) - (when (looking-at "\r") - (incf forward)) - (when (and forward - (<= (+ forward (point)) (point-max))) - ;; Go to the right position on the line. - (goto-char (+ forward (point))) - ;; Replace the old mark with the new mark. - (subst-char-in-region (point) (1+ (point)) (following-char) mark) - ;; Optionally update the marks by some user rule. - (when (eq type 'unread) - (gnus-data-set-mark - (gnus-data-find (gnus-summary-article-number)) mark) - (gnus-summary-update-line (eq mark gnus-unread-mark)))))) + (when forward + (when (looking-at "\r") + (incf forward)) + (when (<= (+ forward (point)) (point-max)) + ;; Go to the right position on the line. + (goto-char (+ forward (point))) + ;; Replace the old mark with the new mark. + (subst-char-in-region (point) (1+ (point)) (char-after) mark) + ;; Optionally update the marks by some user rule. + (when (eq type 'unread) + (gnus-data-set-mark + (gnus-data-find (gnus-summary-article-number)) mark) + (gnus-summary-update-line (eq mark gnus-unread-mark))))))) (defun gnus-mark-article-as-read (article &optional mark) "Enter ARTICLE in the pertinent lists and remove it from others." @@ -7882,14 +8029,14 @@ If N is negative, mark backwards instead. The difference between N and the actual number of articles marked is returned." (interactive "p") - (gnus-summary-mark-forward n gnus-del-mark t)) + (gnus-summary-mark-forward n gnus-del-mark gnus-inhibit-user-auto-expire)) (defun gnus-summary-mark-as-read-backward (n) "Mark the N articles as read backwards. The difference between N and the actual number of articles marked is returned." (interactive "p") - (gnus-summary-mark-forward (- n) gnus-del-mark t)) + (gnus-summary-mark-forward (- n) gnus-del-mark gnus-inhibit-user-auto-expire)) (defun gnus-summary-mark-as-read (&optional article mark) "Mark current article as read. @@ -8177,7 +8324,7 @@ is non-nil or the Subject: of both articles are the same." (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 + (with-temp-buffer (insert buf) (goto-char (point-min)) (if (re-search-forward "^References: " nil t) @@ -8434,17 +8581,15 @@ Argument REVERSE means reverse order." (let* ((thread (intern (format "gnus-thread-sort-by-%s" predicate))) (article (intern (format "gnus-article-sort-by-%s" predicate))) (gnus-thread-sort-functions - (list - (if (not reverse) - thread - `(lambda (t1 t2) - (,thread t2 t1))))) + (if (not reverse) + thread + `(lambda (t1 t2) + (,thread t2 t1)))) (gnus-article-sort-functions - (list - (if (not reverse) - article - `(lambda (t1 t2) - (,article t2 t1))))) + (if (not reverse) + article + `(lambda (t1 t2) + (,article t2 t1)))) (buffer-read-only) (gnus-summary-prepare-hook nil)) ;; We do the sorting by regenerating the threads. @@ -8557,8 +8702,7 @@ save those articles instead." "Pipe the current article through PROGRAM." (interactive "sProgram: ") (gnus-summary-select-article) - (let ((mail-header-separator "") - (art-buf (get-buffer gnus-article-buffer))) + (let ((mail-header-separator "")) (gnus-eval-in-buffer-window gnus-article-buffer (save-restriction (widen) @@ -8606,6 +8750,7 @@ save those articles instead." (defun gnus-valid-move-group-p (group) (and (boundp group) (symbol-name group) + (symbol-value group) (memq 'respool (assoc (symbol-name (car (gnus-find-method-for-group @@ -8940,8 +9085,9 @@ save those articles instead." (setq unread (cdr unread))) (when (<= prev (cdr active)) (push (cons prev (cdr active)) read)) + (setq read (if (> (length read) 1) (nreverse read) read)) (if compute - (if (> (length read) 1) (nreverse read) read) + read (save-excursion (set-buffer gnus-group-buffer) (gnus-undo-register @@ -8951,8 +9097,7 @@ save those articles instead." (gnus-get-unread-articles-in-group ',info (gnus-active ,group)) (gnus-group-update-group ,group t)))) ;; Enter this list into the group info. - (gnus-info-set-read - info (if (> (length read) 1) (nreverse read) read)) + (gnus-info-set-read info read) ;; Set the number of unread articles in gnus-newsrc-hashtb. (gnus-get-unread-articles-in-group info (gnus-active group)) t)))) @@ -9017,6 +9162,53 @@ save those articles instead." ;;; @ end ;;; +(defun gnus-newsgroup-setup-default-charset () + "Setup newsgroup default charset." + (let ((name (and gnus-newsgroup-name + (string-match "[^:]+$" gnus-newsgroup-name) + (match-string 0 gnus-newsgroup-name)))) + (setq gnus-newsgroup-default-charset + (or (and gnus-newsgroup-name + (or (gnus-group-find-parameter + gnus-newsgroup-name 'charset) + (let ((alist gnus-newsgroup-default-charset-alist) + elem (charset nil)) + (while alist + (if (and name + (string-match + (car (setq elem (pop alist))) + name)) + (setq alist nil + charset (cdr elem)))) + charset))) + rfc2047-default-charset)) + (setq gnus-newsgroup-iso-8859-1-forced + (and gnus-newsgroup-name + (or (gnus-group-find-parameter + gnus-newsgroup-name 'iso-8859-1-forced) + (and name + (string-match gnus-newsgroup-iso-8859-1-forced-regexp + name)))))) + (if (stringp gnus-newsgroup-default-charset) + (setq gnus-newsgroup-default-charset + (intern (downcase gnus-newsgroup-default-charset)))) + (setq gnus-newsgroup-iso-8859-1-forced + (if (stringp gnus-newsgroup-iso-8859-1-forced) + (intern (downcase gnus-newsgroup-iso-8859-1-forced)) + (and gnus-newsgroup-iso-8859-1-forced + gnus-newsgroup-default-charset)))) + +;;; +;;; MIME Commands +;;; + +(defun gnus-summary-display-buttonized (&optional arg) + "Display the current buffer fully MIME-buttonized." + (interactive "P") + (require 'gnus-art) + (let ((gnus-unbuttonized-mime-types nil)) + (gnus-summary-show-article arg))) + (gnus-ems-redefine) (provide 'gnus-sum)