X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fgnus-sum.el;h=6b93380956c9af29ec0d392e7bec8030f0e77626;hb=refs%2Ftags%2Ft-gnus-6_15_3-06-last-;hp=1570b81449fd0bf65504d83f8920e64842a1997b;hpb=3c19a9d1054e341f806d39714ddf1d70b03ef142;p=elisp%2Fgnus.git- diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el index 1570b81..6b93380 100644 --- a/lisp/gnus-sum.el +++ b/lisp/gnus-sum.el @@ -1,9 +1,11 @@ -;;; gnus-sum.el --- summary mode commands for Gnus -;; Copyright (C) 1996, 1997, 1998, 1999, 2000 +;;; gnus-sum.el --- summary mode commands for Semi-gnus +;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001 ;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen -;; Keywords: news +;; MORIOKA Tomohiko +;; Katsumi Yamaoka +;; Keywords: mail, news, MIME ;; This file is part of GNU Emacs. @@ -27,6 +29,7 @@ ;;; Code: (eval-when-compile (require 'cl)) +(eval-when-compile (require 'gnus-clfns)) (require 'gnus) (require 'gnus-group) @@ -35,8 +38,25 @@ (require 'gnus-int) (require 'gnus-undo) (require 'gnus-util) -(require 'mm-decode) +;; Recursive :-(. +;; (require 'gnus-art) +(require 'nnoo) +(require 'mime-view) + +(eval-when-compile + (require 'mime-play) + (require 'static)) + +(eval-and-compile + (autoload 'pgg-decrypt-region "pgg" nil t) + (autoload 'pgg-verify-region "pgg" nil t)) + (autoload 'gnus-summary-limit-include-cached "gnus-cache" nil t) +(autoload 'gnus-cache-write-active "gnus-cache") +(autoload 'gnus-set-summary-default-charset "gnus-i18n" nil t) +(autoload 'gnus-mailing-list-insinuate "gnus-ml" nil t) +(autoload 'turn-on-gnus-mailing-list-mode "gnus-ml" nil t) +(autoload 'mm-uu-dissect "mm-uu") (defcustom gnus-kill-summary-on-exit t "*If non-nil, kill the summary buffer when you exit from it. @@ -277,6 +297,14 @@ in some newsgroups, set the variable to nil in (function-item gnus-summary-first-unread-article) (function-item gnus-summary-best-unread-article))) +(defcustom gnus-dont-select-after-jump-to-other-group nil + "If non-nil, don't select the first unread article after entering the +other group by the command `gnus-summary-jump-to-other-group'. If nil, +it is depend on the value of `gnus-auto-select-first' whether to select +or not." + :group 'gnus-group-select + :type 'boolean) + (defcustom gnus-auto-select-next t "*If non-nil, offer to go to the next group from the end of the previous. If the value is t and the next newsgroup is empty, Gnus will exit @@ -343,15 +371,24 @@ variable." :group 'gnus-article-various :type 'boolean) +(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-article-display-method-for-mime'." + :group 'gnus-article-mime + :type 'boolean) + (defcustom gnus-move-split-methods nil "*Variable used to suggest where articles are to be moved to. -It uses the same syntax as the `gnus-split-methods' variable." +It uses the same syntax as the `gnus-split-methods' variable. +However, whereas `gnus-split-methods' specifies file names as targets, +this variable specifies group names." :group 'gnus-summary-mail :type '(repeat (choice (list :value (fun) function) (cons :value ("" "") regexp (repeat string)) (sexp :value nil)))) -(defcustom gnus-unread-mark ? ;Whitespace +(defcustom gnus-unread-mark ?\ ;;;Whitespace "*Mark used for unread articles." :group 'gnus-summary-marks :type 'character) @@ -387,7 +424,7 @@ It uses the same syntax as the `gnus-split-methods' variable." :type 'character) (defcustom gnus-souped-mark ?F - "*Mark used for killed articles." + "*Mark used for souped articles." :group 'gnus-summary-marks :type 'character) @@ -411,6 +448,11 @@ It uses the same syntax as the `gnus-split-methods' variable." :group 'gnus-summary-marks :type 'character) +(defcustom gnus-forwarded-mark ?O + "*Mark used for articles that have been forwarded." + :group 'gnus-summary-marks + :type 'character) + (defcustom gnus-cached-mark ?* "*Mark used for articles that are in the cache." :group 'gnus-summary-marks @@ -421,6 +463,11 @@ It uses the same syntax as the `gnus-split-methods' variable." :group 'gnus-summary-marks :type 'character) +(defcustom gnus-no-mark ?\ ;;;Whitespace + "*Mark used for articles that have no other secondary mark." + :group 'gnus-summary-marks + :type 'character) + (defcustom gnus-ancient-mark ?O "*Mark used for ancient articles." :group 'gnus-summary-marks @@ -466,7 +513,7 @@ It uses the same syntax as the `gnus-split-methods' variable." :group 'gnus-summary-marks :type 'character) -(defcustom gnus-empty-thread-mark ? ;Whitespace +(defcustom gnus-empty-thread-mark ?\ ;;;Whitespace "*There is no thread under the article." :group 'gnus-summary-marks :type 'character) @@ -486,11 +533,13 @@ It uses the same syntax as the `gnus-split-methods' variable." 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." + :version "21.1" :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." + :version "21.1" :group 'gnus-summary :type 'boolean) @@ -551,6 +600,7 @@ with some simple extensions: (defcustom gnus-list-identifiers nil "Regexp that matches list identifiers to be removed from subject. This can also be a list of regexps." + :version "21.1" :group 'gnus-summary-format :group 'gnus-article-hiding :type '(choice (const :tag "none" nil) @@ -566,7 +616,22 @@ score file." (defcustom gnus-article-sort-functions '(gnus-article-sort-by-number) "*List of functions used for sorting articles in the summary buffer. -This variable is only used when not using a threaded display." + +Each function takes two articles and returns non-nil if the first +article should be sorted before the other. If you use more than one +function, the primary sort function should be the last. You should +probably always include `gnus-article-sort-by-number' in the list of +sorting functions -- preferably first. Also note that sorting by date +is often much slower than sorting by number, and the sorting order is +very similar. (Sorting by date means sorting by the time the message +was sent, sorting by number means sorting by arrival time.) + +Ready-made functions include `gnus-article-sort-by-number', +`gnus-article-sort-by-author', `gnus-article-sort-by-subject', +`gnus-article-sort-by-date' and `gnus-article-sort-by-score'. + +When threading is turned on, the variable `gnus-thread-sort-functions' +controls how articles are sorted." :group 'gnus-summary-sort :type '(repeat (choice (function-item gnus-article-sort-by-number) (function-item gnus-article-sort-by-author) @@ -579,16 +644,22 @@ This variable is only used when not using a threaded display." "*List of functions used for sorting threads in the summary buffer. By default, threads are sorted by article number. -Each function takes two threads and return non-nil if the first thread -should be sorted before the other. If you use more than one function, -the primary sort function should be the last. You should probably -always include `gnus-thread-sort-by-number' in the list of sorting -functions -- preferably first. +Each function takes two threads and returns non-nil if the first +thread should be sorted before the other. If you use more than one +function, the primary sort function should be the last. You should +probably always include `gnus-thread-sort-by-number' in the list of +sorting functions -- preferably first. Also note that sorting by date +is often much slower than sorting by number, and the sorting order is +very similar. (Sorting by date means sorting by the time the message +was sent, sorting by number means sorting by arrival time.) Ready-made functions include `gnus-thread-sort-by-number', `gnus-thread-sort-by-author', `gnus-thread-sort-by-subject', `gnus-thread-sort-by-date', `gnus-thread-sort-by-score' and -`gnus-thread-sort-by-total-score' (see `gnus-thread-score-function')." +`gnus-thread-sort-by-total-score' (see `gnus-thread-score-function'). + +When threading is turned off, the variable +`gnus-article-sort-functions' controls how articles are sorted." :group 'gnus-summary-sort :type '(repeat (choice (function-item gnus-thread-sort-by-number) (function-item gnus-thread-sort-by-author) @@ -629,9 +700,17 @@ This variable is local to the summary buffers." (defcustom gnus-summary-mode-hook nil "*A hook for Gnus summary mode. This hook is run before any variables are set in the summary buffer." + :options '(turn-on-gnus-mailing-list-mode) :group 'gnus-summary-various :type 'hook) +;; Extracted from gnus-xmas-redefine in order to preserve user settings +(when (featurep 'xemacs) + (add-hook 'gnus-summary-mode-hook 'gnus-xmas-summary-menu-add) + (add-hook 'gnus-summary-mode-hook 'gnus-xmas-setup-summary-toolbar) + (add-hook 'gnus-summary-mode-hook + 'gnus-xmas-switch-horizontal-scrollbar-off)) + (defcustom gnus-summary-menu-hook nil "*Hook run after the creation of the summary mode menu." :group 'gnus-summary-visual @@ -693,7 +772,7 @@ is not run if `gnus-visual' is nil." :group 'gnus-summary-visual :type 'hook) -(defcustom gnus-parse-headers-hook nil +(defcustom gnus-parse-headers-hook '(gnus-set-summary-default-charset) "*A hook called before parsing the headers." :group 'gnus-various :type 'hook) @@ -761,6 +840,9 @@ automatically when it is selected." . gnus-summary-high-unread-face) ((and (< score default) (= mark gnus-unread-mark)) . gnus-summary-low-unread-face) + ((and (memq article gnus-newsgroup-incorporated) + (= mark gnus-unread-mark)) + . gnus-summary-incorporated-face) ((= mark gnus-unread-mark) . gnus-summary-normal-unread-face) ((and (> score default) (memq mark (list gnus-downloadable-mark @@ -769,8 +851,11 @@ automatically when it is selected." ((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)) + ((and (memq mark (list gnus-downloadable-mark gnus-undownloaded-mark)) + (memq article gnus-newsgroup-unreads)) . gnus-summary-normal-unread-face) + ((memq mark (list gnus-downloadable-mark gnus-undownloaded-mark)) + . gnus-summary-normal-read-face) ((> score default) . gnus-summary-high-read-face) ((< score default) @@ -799,84 +884,106 @@ mark: The articles mark." The function is called with one parameter, the article header vector, which it may alter in any way.") -(defvar gnus-decode-encoded-word-function 'mail-decode-encoded-word-string +(defvar gnus-decode-encoded-word-function + (mime-find-field-decoder 'From 'nov) "Variable that says which function should be used to decode a string with encoded words.") (defcustom gnus-extra-headers nil "*Extra headers to parse." + :version "21.1" :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." + :version "21.1" :group 'gnus-summary :type 'regexp) -(defcustom gnus-group-charset-alist - '(("^hk\\>\\|^tw\\>\\|\\" cn-big5) - ("^cn\\>\\|\\" cn-gb-2312) - ("^fj\\>\\|^japan\\>" iso-2022-jp-2) - ("^tnn\\>\\|^pin\\>\\|^sci.lang.japan" iso-2022-7bit) - ("^relcom\\>" koi8-r) - ("^fido7\\>" koi8-r) - ("^\\(cz\\|hun\\|pl\\|sk\\|hr\\)\\>" iso-8859-2) - ("^israel\\>" iso-8859-1) - ("^han\\>" euc-kr) - ("^alt.chinese.text.big5\\>" chinese-big5) - ("^soc.culture.vietnamese\\>" vietnamese-viqr) - ("^\\(comp\\|rec\\|alt\\|sci\\|soc\\|news\\|gnu\\|bofh\\)\\>" iso-8859-1) - (".*" iso-8859-1)) - "Alist of regexps (to match group names) and default charsets to be used when reading." - :type '(repeat (list (regexp :tag "Group") - (symbol :tag "Charset"))) - :group 'gnus-charset) - (defcustom gnus-newsgroup-ignored-charsets '(unknown-8bit x-unknown) "List of charsets that should be ignored. When these charsets are used in the \"charset\" parameter, the default charset will be used instead." + :version "21.1" :type '(repeat symbol) :group 'gnus-charset) -(defcustom gnus-group-ignored-charsets-alist - '(("alt\\.chinese\\.text" iso-8859-1)) - "Alist of regexps (to match group names) and charsets that should be ignored. +(gnus-define-group-parameter + ignored-charsets + :type list + :function-document + "Return the ignored charsets of GROUP." + :variable gnus-group-ignored-charsets-alist + :variable-default + '(("alt\\.chinese\\.text" iso-8859-1)) + :variable-document + "Alist of regexps (to match group names) and charsets that should be ignored. When these charsets are used in the \"charset\" parameter, the default charset will be used instead." - :type '(repeat (cons (regexp :tag "Group") - (repeat symbol))) - :group 'gnus-charset) + :variable-group gnus-charset + :variable-type '(repeat (cons (regexp :tag "Group") + (repeat symbol))) + :parameter-type '(choice :tag "Ignored charsets" + :value nil + (repeat (symbol))) + :parameter-document "\ +List of charsets that should be ignored. + +When these charsets are used in the \"charset\" parameter, the +default charset will be used instead.") (defcustom gnus-group-highlight-words-alist nil "Alist of group regexps and highlight regexps. This variable uses the same syntax as `gnus-emphasis-alist'." + :version "21.1" :type '(repeat (cons (regexp :tag "Group") (repeat (list (regexp :tag "Highlight regexp") (number :tag "Group for entire word" 0) (number :tag "Group for displayed part" 0) - (symbol :tag "Face" + (symbol :tag "Face" gnus-emphasis-highlight-words))))) :group 'gnus-summary-visual) +(defcustom gnus-use-wheel nil + "Use Intelli-mouse on summary movement" + :type 'boolean + :group 'gnus-summary-maneuvering) + +(defcustom gnus-wheel-scroll-amount '(5 . 1) + "Amount to scroll messages by spinning the mouse wheel. +This is actually a cons cell, where the first item is the amount to scroll +on a normal wheel event, and the second is the amount to scroll when the +wheel is moved with the shift key depressed." + :type '(cons (integer :tag "Shift") integer) + :group 'gnus-summary-maneuvering) + +(defcustom gnus-wheel-edge-resistance 2 + "How hard it should be to change the current article +by moving the mouse over the edge of the article window." + :type 'integer + :group 'gnus-summary-maneuvering) + (defcustom gnus-summary-show-article-charset-alist nil "Alist of number and charset. The article will be shown with the charset corresponding to the numbered argument. For example: ((1 . cn-gb-2312) (2 . big5))." + :version "21.1" :type '(repeat (cons (number :tag "Argument" 1) (symbol :tag "Charset"))) :group 'gnus-charset) (defcustom gnus-preserve-marks t "Whether marks are preserved when moving, copying and respooling messages." + :version "21.1" :type 'boolean :group 'gnus-summary-marks) (defcustom gnus-alter-articles-to-read-function nil "Function to be called to alter the list of articles to be selected." - :type 'function + :type '(choice (const nil) function) :group 'gnus-summary) (defcustom gnus-orphan-score nil @@ -885,10 +992,35 @@ For example: ((1 . cn-gb-2312) (2 . big5))." :type '(choice (const nil) integer)) +(defcustom gnus-summary-save-parts-default-mime "image/.*" + "*A regexp to match MIME parts when saving multiple parts of a message +with gnus-summary-save-parts (X m). This regexp will be used by default +when prompting the user for which type of files to save." + :group 'gnus-summary + :type 'regexp) + + +(defcustom gnus-summary-save-parts-default-mime "image/.*" + "*A regexp to match MIME parts when saving multiple parts of a message +with gnus-summary-save-parts (X m). This regexp will be used by default +when prompting the user for which type of files to save." + :group 'gnus-summary + :type 'regexp) + +(defcustom gnus-read-all-available-headers nil + "Whether Gnus should parse all headers made available to it. +This is mostly relevant for slow backends where the user may +wish to widen the summary buffer to include all headers +that were fetched. Say, for nnultimate groups." + :group 'gnus-summary + :type '(choice boolean regexp)) + ;;; Internal variables (defvar gnus-article-mime-handles nil) (defvar gnus-article-decoded-p nil) +(defvar gnus-article-charset nil) +(defvar gnus-article-ignored-charsets nil) (defvar gnus-scores-exclude-files nil) (defvar gnus-page-broken nil) (defvar gnus-inhibit-mime-unbuttonizing nil) @@ -902,6 +1034,12 @@ For example: ((1 . cn-gb-2312) (2 . big5))." (defvar gnus-sort-gathered-threads-function 'gnus-thread-sort-by-number "Function called to sort the articles within a thread after it has been gathered together.") +(defvar gnus-summary-save-parts-type-history nil) +(defvar gnus-summary-save-parts-last-directory nil) + +(defvar gnus-summary-save-parts-type-history nil) +(defvar gnus-summary-save-parts-last-directory nil) + ;; Avoid highlighting in kill files. (defvar gnus-summary-inhibit-highlight nil) (defvar gnus-newsgroup-selected-overlay nil) @@ -923,9 +1061,10 @@ For example: ((1 . cn-gb-2312) (2 . big5))." (?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-entity-read-field gnus-tmp-header 'From))) ?s) + (?a (or (std11-full-name-string + (car (mime-entity-read-field gnus-tmp-header 'From))) gnus-tmp-from) ?s) (?F gnus-tmp-from ?s) (?x ,(macroexpand '(mail-header-xref gnus-tmp-header)) ?s) @@ -935,7 +1074,7 @@ For example: ((1 . cn-gb-2312) (2 . big5))." (?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) - (?L gnus-tmp-lines ?d) + (?L gnus-tmp-lines ?s) (?I gnus-tmp-indentation ?s) (?T (if (= gnus-tmp-level 0) "" (make-string (frame-width) ? )) ?s) (?R gnus-tmp-replied ?c) @@ -957,9 +1096,9 @@ For example: ((1 . cn-gb-2312) (2 . big5))." ?c) (?u gnus-tmp-user-defined ?s) (?P (gnus-pick-line-number) ?d)) - "An alist of format specifications that can appear in summary lines, -and what variables they correspond with, along with the type of the -variable (string, integer, character, etc).") + "An alist of format specifications that can appear in summary lines. +These are paired with what variables they correspond with, along with +the type of the variable (string, integer, character, etc).") (defvar gnus-summary-dummy-line-format-alist `((?S gnus-tmp-subject ?s) @@ -987,6 +1126,11 @@ variable (string, integer, character, etc).") (defvar gnus-last-search-regexp nil "Default regexp for article search command.") +(defvar gnus-summary-search-article-matched-data nil + "Last matched data of article search command. It is the local variable +in `gnus-article-buffer' which consists of the list of start position, +end position and text.") + (defvar gnus-last-shell-command nil "Default shell command on article.") @@ -1032,6 +1176,9 @@ variable (string, integer, character, etc).") (defvar gnus-newsgroup-replied nil "List of articles that have been replied to in the current newsgroup.") +(defvar gnus-newsgroup-forwarded nil + "List of articles that have been forwarded in the current newsgroup.") + (defvar gnus-newsgroup-expirable nil "List of articles in the current newsgroup that can be expired.") @@ -1056,6 +1203,9 @@ variable (string, integer, character, etc).") (defvar gnus-newsgroup-scored nil "List of scored articles in the current newsgroup.") +(defvar gnus-newsgroup-incorporated nil + "List of incorporated articles in the current newsgroup.") + (defvar gnus-newsgroup-headers nil "List of article headers in the current newsgroup.") @@ -1079,6 +1229,8 @@ variable (string, integer, character, etc).") (defvar gnus-newsgroup-ephemeral-charset nil) (defvar gnus-newsgroup-ephemeral-ignored-charsets nil) +(defvar gnus-article-before-search nil) + (defconst gnus-summary-local-variables '(gnus-newsgroup-name gnus-newsgroup-begin gnus-newsgroup-end @@ -1087,7 +1239,8 @@ variable (string, integer, character, etc).") gnus-newsgroup-auto-expire gnus-newsgroup-unreads gnus-newsgroup-unselected gnus-newsgroup-marked gnus-newsgroup-reads gnus-newsgroup-saved - gnus-newsgroup-replied gnus-newsgroup-expirable + gnus-newsgroup-replied gnus-newsgroup-forwarded + gnus-newsgroup-expirable gnus-newsgroup-processable gnus-newsgroup-killed gnus-newsgroup-downloadable gnus-newsgroup-undownloaded gnus-newsgroup-unsendable @@ -1112,55 +1265,20 @@ variable (string, integer, character, etc).") gnus-cache-removable-articles gnus-newsgroup-cached gnus-newsgroup-data gnus-newsgroup-data-reverse gnus-newsgroup-limit gnus-newsgroup-limits - gnus-newsgroup-charset) + gnus-newsgroup-charset + gnus-newsgroup-incorporated) "Variables that are buffer-local to the summary buffers.") +(defvar gnus-newsgroup-variables nil + "Variables that have separate values in the newsgroups.") + ;; Byte-compiler warning. -(defvar gnus-article-mode-map) - -;; MIME stuff. - -(defvar gnus-decode-encoded-word-methods - '(mail-decode-encoded-word-string) - "List of methods used to decode encoded words. - -This variable is a list of FUNCTION or (REGEXP . FUNCTION). If item is -FUNCTION, FUNCTION will be apply to all newsgroups. If item is a -(REGEXP . FUNCTION), FUNCTION will be only apply to thes newsgroups -whose names match REGEXP. - -For example: -((\"chinese\" . gnus-decode-encoded-word-string-by-guess) - mail-decode-encoded-word-string - (\"chinese\" . rfc1843-decode-string)) -") - -(defvar gnus-decode-encoded-word-methods-cache nil) - -(defun gnus-multi-decode-encoded-word-string (string) - "Apply the functions from `gnus-encoded-word-methods' that match." - (unless (and gnus-decode-encoded-word-methods-cache - (eq gnus-newsgroup-name - (car gnus-decode-encoded-word-methods-cache))) - (setq gnus-decode-encoded-word-methods-cache (list gnus-newsgroup-name)) - (mapcar (lambda (x) - (if (symbolp x) - (nconc gnus-decode-encoded-word-methods-cache (list x)) - (if (and gnus-newsgroup-name - (string-match (car x) gnus-newsgroup-name)) - (nconc gnus-decode-encoded-word-methods-cache - (list (cdr x)))))) - gnus-decode-encoded-word-methods)) - (let ((xlist gnus-decode-encoded-word-methods-cache)) - (pop xlist) - (while xlist - (setq string (funcall (pop xlist) string)))) - string) +(eval-when-compile (defvar gnus-article-mode-map)) ;; Subject simplification. (defun gnus-simplify-whitespace (str) - "Remove excessive whitespace." + "Remove excessive whitespace from STR." (let ((mystr str)) ;; Multiple spaces. (while (string-match "[ \t][ \t]+" mystr) @@ -1177,7 +1295,7 @@ For example: (defsubst gnus-simplify-subject-re (subject) "Remove \"Re:\" from subject lines." - (if (string-match "^[Rr][Ee]: *" subject) + (if (string-match message-subject-re-regexp subject) (substring subject (match-end 0)) subject)) @@ -1213,7 +1331,7 @@ The string in the accessible portion of the current buffer is simplified. It is assumed to be a single-line subject. Whitespace is generally cleaned up, and miscellaneous leading/trailing matter is removed. Additional things can be deleted by setting -gnus-simplify-subject-fuzzy-regexp." +`gnus-simplify-subject-fuzzy-regexp'." (let ((case-fold-search t) (modified-tick)) (gnus-simplify-buffer-fuzzy-step "\t" " ") @@ -1290,6 +1408,8 @@ increase the score of each group you read." (put 'gnus-summary-mode 'mode-class 'special) +(defvar gnus-article-commands-menu) + (when t ;; Non-orthogonal keys @@ -1354,11 +1474,13 @@ increase the score of each group you read." "\C-c\C-s\C-s" gnus-summary-sort-by-subject "\C-c\C-s\C-d" gnus-summary-sort-by-date "\C-c\C-s\C-i" gnus-summary-sort-by-score + "\C-c\C-s\C-o" gnus-summary-sort-by-original "=" gnus-summary-expand-window "\C-x\C-s" gnus-summary-reselect-current-group "\M-g" gnus-summary-rescan-group "w" gnus-summary-stop-page-breaking "\C-c\C-r" gnus-summary-caesar-message + "\M-t" gnus-summary-toggle-mime "f" gnus-summary-followup "F" gnus-summary-followup-with-original "C" gnus-summary-cancel-article @@ -1380,15 +1502,17 @@ increase the score of each group you read." "a" gnus-summary-post-news "x" gnus-summary-limit-to-unread "s" gnus-summary-isearch-article - "t" gnus-summary-toggle-header + "t" gnus-article-toggle-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 "\M-\C-a" gnus-summary-customize-parameters "\C-c\C-b" gnus-bug + "\C-c\C-n" gnus-namazu-search "*" gnus-cache-enter-article "\M-*" gnus-cache-remove-article "\M-&" gnus-summary-universal-argument @@ -1398,9 +1522,6 @@ increase the score of each group you read." "\M-i" gnus-symbolic-argument "h" gnus-summary-select-article-buffer - "b" gnus-article-view-part - "\M-t" gnus-summary-toggle-display-buttonized - "V" gnus-summary-score-map "X" gnus-uu-extract-map "S" gnus-summary-send-map) @@ -1449,10 +1570,12 @@ increase the score of each group you read." "T" gnus-summary-limit-include-thread "d" gnus-summary-limit-exclude-dormant "t" gnus-summary-limit-to-age - "x" gnus-summary-limit-to-extra + "x" gnus-summary-limit-to-extra "E" gnus-summary-limit-include-expunged "c" gnus-summary-limit-exclude-childless-dormant - "C" gnus-summary-limit-mark-excluded-as-read) + "C" gnus-summary-limit-mark-excluded-as-read + "o" gnus-summary-insert-old-articles + "N" gnus-summary-insert-new-articles) (gnus-define-keys (gnus-summary-goto-map "G" gnus-summary-mode-map) "n" gnus-summary-next-unread-article @@ -1497,6 +1620,7 @@ increase the score of each group you read." "c" gnus-summary-catchup-and-exit "C" gnus-summary-catchup-all-and-exit "E" gnus-summary-exit-no-update + "J" gnus-summary-jump-to-other-group "Q" gnus-summary-exit "Z" gnus-summary-exit "n" gnus-summary-catchup-and-goto-next-group @@ -1526,6 +1650,7 @@ increase the score of each group you read." "g" gnus-summary-show-article "s" gnus-summary-isearch-article "P" gnus-summary-print-article + "M" gnus-mailing-list-insinuate "t" gnus-article-babel) (gnus-define-keys (gnus-summary-wash-map "W" gnus-summary-mode-map) @@ -1537,21 +1662,21 @@ increase the score of each group you read." "Q" gnus-article-fill-long-lines "C" gnus-article-capitalize-sentences "c" gnus-article-remove-cr - "q" gnus-article-de-quoted-unreadable - "6" gnus-article-de-base64-unreadable "Z" gnus-article-decode-HZ - "h" gnus-article-wash-html "f" gnus-article-display-x-face "l" gnus-summary-stop-page-breaking "r" gnus-summary-caesar-message - "t" gnus-article-hide-headers + "t" gnus-article-toggle-headers "v" gnus-summary-verbose-headers - "H" gnus-article-strip-headers-in-body - "d" gnus-article-treat-dumbquotes) + "m" gnus-summary-toggle-mime + "a" gnus-article-strip-headers-in-body ;; mnemonic: wash archive + "p" gnus-article-verify-x-pgp-sig + "d" gnus-article-treat-dumbquotes + "s" gnus-smiley-display) (gnus-define-keys (gnus-summary-wash-hide-map "W" gnus-summary-wash-map) "a" gnus-article-hide - "h" gnus-article-hide-headers + "h" gnus-article-toggle-headers "b" gnus-article-hide-boring-headers "s" gnus-article-hide-signature "c" gnus-article-hide-citation @@ -1568,16 +1693,11 @@ increase the score of each group you read." "c" gnus-article-highlight-citation "s" gnus-article-highlight-signature) - (gnus-define-keys (gnus-summary-wash-mime-map "M" gnus-summary-wash-map) - "w" gnus-article-decode-mime-words - "c" gnus-article-decode-charset - "v" gnus-mime-view-all-parts - "b" gnus-article-view-part) - (gnus-define-keys (gnus-summary-wash-time-map "T" gnus-summary-wash-map) "z" gnus-article-date-ut "u" gnus-article-date-ut "l" gnus-article-date-local + "p" gnus-article-date-english "e" gnus-article-date-lapsed "o" gnus-article-date-original "i" gnus-article-date-iso8601 @@ -1590,7 +1710,8 @@ increase the score of each group you read." "a" gnus-article-strip-blank-lines "A" gnus-article-strip-all-blank-lines "s" gnus-article-strip-leading-space - "e" gnus-article-strip-trailing-space) + "e" gnus-article-strip-trailing-space + "w" gnus-article-remove-leading-whitespace) (gnus-define-keys (gnus-summary-help-map "H" gnus-summary-mode-map) "v" gnus-version @@ -1613,6 +1734,7 @@ increase the score of each group you read." "q" gnus-summary-respool-query "t" gnus-summary-respool-trace "i" gnus-summary-import-article + "I" gnus-summary-create-article "p" gnus-summary-article-posted-p) (gnus-define-keys (gnus-summary-save-map "O" gnus-summary-mode-map) @@ -1633,10 +1755,14 @@ increase the score of each group you read." "v" gnus-article-view-part "o" gnus-article-save-part "c" gnus-article-copy-part + "C" gnus-article-view-part-as-charset "e" gnus-article-externalize-part + "E" gnus-article-encrypt-body "i" gnus-article-inline-part "|" gnus-article-pipe-part)) +(defvar gnus-article-post-menu nil) + (defun gnus-summary-make-menu-bar () (gnus-turn-off-edit-menu 'summary) @@ -1648,7 +1774,6 @@ increase the score of each group you read." "Score" (nconc (list - ["Enter score..." gnus-summary-score-entry t] ["Customize" gnus-score-customize t]) (gnus-make-score-map 'increase) (gnus-make-score-map 'lower) @@ -1673,9 +1798,9 @@ increase the score of each group you read." ;; Define both the Article menu in the summary buffer and the equivalent ;; Commands menu in the article buffer here for consistency. (let ((innards - '(("Hide" + `(("Hide" ["All" gnus-article-hide t] - ["Headers" gnus-article-hide-headers t] + ["Headers" gnus-article-toggle-headers t] ["Signature" gnus-article-hide-signature t] ["Citation" gnus-article-hide-citation t] ["List identifiers" gnus-article-hide-list-identifiers t] @@ -1687,12 +1812,6 @@ increase the score of each group you read." ["Headers" gnus-article-highlight-headers t] ["Signature" gnus-article-highlight-signature t] ["Citation" gnus-article-highlight-citation t]) - ("MIME" - ["Words" gnus-article-decode-mime-words t] - ["Charset" gnus-article-decode-charset t] - ["QP" gnus-article-de-quoted-unreadable t] - ["Base64" gnus-article-de-base64-unreadable t] - ["View all" gnus-mime-view-all-parts t]) ("Date" ["Local" gnus-article-date-local t] ["ISO8601" gnus-article-date-iso8601 t] @@ -1708,7 +1827,9 @@ increase the score of each group you read." ["All of the above" gnus-article-strip-blank-lines t] ["All" gnus-article-strip-all-blank-lines t] ["Leading space" gnus-article-strip-leading-space t] - ["Trailing space" gnus-article-strip-trailing-space t]) + ["Trailing space" gnus-article-strip-trailing-space t] + ["Leading space in headers" + gnus-article-remove-leading-whitespace t]) ["Overstrike" gnus-article-treat-overstrike t] ["Dumb quotes" gnus-article-treat-dumbquotes t] ["Emphasis" gnus-article-emphasize t] @@ -1717,20 +1838,26 @@ increase the score of each group you read." ["Capitalize sentences" gnus-article-capitalize-sentences t] ["CR" gnus-article-remove-cr t] ["Show X-Face" gnus-article-display-x-face t] - ["Quoted-Printable" gnus-article-de-quoted-unreadable t] - ["Base64" gnus-article-de-base64-unreadable t] - ["Rot 13" gnus-summary-caesar-message t] + ["Rot 13" gnus-summary-caesar-message + ,@(if (featurep 'xemacs) '(t) + '(:help "\"Caesar rotate\" article by 13"))] ["Unix pipe" gnus-summary-pipe-message t] ["Add buttons" gnus-article-add-buttons t] ["Add buttons to head" gnus-article-add-buttons-to-head t] ["Stop page breaking" gnus-summary-stop-page-breaking t] + ["Toggle MIME" gnus-summary-toggle-mime t] ["Verbose header" gnus-summary-verbose-headers t] ["Toggle header" gnus-summary-toggle-header t] - ["Html" gnus-article-wash-html t] + ["Toggle smileys" gnus-smiley-display t] + ["Verify X-PGP-Sig" gnus-article-verify-x-pgp-sig t] ["HZ" gnus-article-decode-HZ t]) ("Output" - ["Save in default format" gnus-summary-save-article t] - ["Save in file" gnus-summary-save-article-file t] + ["Save in default format" gnus-summary-save-article + ,@(if (featurep 'xemacs) '(t) + '(:help "Save article using default method"))] + ["Save in file" gnus-summary-save-article-file + ,@(if (featurep 'xemacs) '(t) + '(:help "Save article in file"))] ["Save in Unix mail format" gnus-summary-save-article-mail t] ["Save in MH folder" gnus-summary-save-article-folder t] ["Save in VM folder" gnus-summary-save-article-vm t] @@ -1749,6 +1876,7 @@ increase the score of each group you read." (gnus-check-backend-function 'request-replace-article gnus-newsgroup-name)] ["Import file..." gnus-summary-import-article t] + ["Create article..." gnus-summary-create-article t] ["Check if posted" gnus-summary-article-posted-p t] ["Edit article" gnus-summary-edit-article (not (gnus-group-read-only-p))] @@ -1761,7 +1889,9 @@ increase the score of each group you read." (gnus-check-backend-function 'request-expire-articles gnus-newsgroup-name)]) ("Extract" - ["Uudecode" gnus-uu-decode-uu t] + ["Uudecode" gnus-uu-decode-uu + ,@(if (featurep 'xemacs) '(t) + '(:help "Decode uuencoded article(s)"))] ["Uudecode and save" gnus-uu-decode-uu-and-save t] ["Unshar" gnus-uu-decode-unshar t] ["Unshar and save" gnus-uu-decode-unshar-and-save t] @@ -1781,14 +1911,21 @@ increase the score of each group you read." ["Fetch referenced articles" gnus-summary-refer-references t] ["Fetch current thread" gnus-summary-refer-thread t] ["Fetch article with id..." gnus-summary-refer-article t] + ["Setup Mailing List Params" gnus-mailing-list-insinuate t] ["Redisplay" gnus-summary-show-article t]))) (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))) + (if (not (keymapp gnus-summary-article-menu)) + (easy-menu-define + gnus-article-commands-menu gnus-article-mode-map "" + (cons "Commands" innards)) + ;; in Emacs, don't share menu. + (setq gnus-article-commands-menu + (copy-keymap gnus-summary-article-menu)) + (define-key gnus-article-mode-map [menu-bar commands] + (cons "Commands" gnus-article-commands-menu)))) (easy-menu-define gnus-summary-thread-menu gnus-summary-mode-map "" @@ -1810,24 +1947,36 @@ increase the score of each group you read." (easy-menu-define gnus-summary-post-menu gnus-summary-mode-map "" - '("Post" - ["Post an article" gnus-summary-post-news t] - ["Followup" gnus-summary-followup t] - ["Followup and yank" gnus-summary-followup-with-original t] + `("Post" + ["Post an article" gnus-summary-post-news + ,@(if (featurep 'xemacs) '(t) + '(:help "Post an article"))] + ["Followup" gnus-summary-followup + ,@(if (featurep 'xemacs) '(t) + '(:help "Post followup to this article"))] + ["Followup and yank" gnus-summary-followup-with-original + ,@(if (featurep 'xemacs) '(t) + '(:help "Post followup to this article, quoting its contents"))] ["Supersede article" gnus-summary-supersede-article t] - ["Cancel article" gnus-summary-cancel-article t] + ["Cancel article" gnus-summary-cancel-article + ,@(if (featurep 'xemacs) '(t) + '(:help "Cancel an article you posted"))] ["Reply" gnus-summary-reply t] ["Reply and yank" gnus-summary-reply-with-original t] ["Wide reply" gnus-summary-wide-reply t] - ["Wide reply and yank" gnus-summary-wide-reply-with-original t] + ["Wide reply and yank" gnus-summary-wide-reply-with-original + ,@(if (featurep 'xemacs) '(t) + '(:help "Mail a reply, quoting this article"))] ["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-digest-mail-forward t] + ["Digest and post" gnus-summary-digest-post-forward 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] - ["Uuencode and post" gnus-uu-post-news t] + ["Uuencode and post" gnus-uu-post-news + ,@(if (featurep 'xemacs) '(t) + '(:help "Post a uuencoded article"))] ["Followup via news" gnus-summary-followup-to-mail t] ["Followup via news and yank" gnus-summary-followup-to-mail-with-original t] @@ -1836,15 +1985,27 @@ increase the score of each group you read." ;;["Send bounced" gnus-resend-bounced-mail t]) )) + (cond + ((not (keymapp gnus-summary-post-menu)) + (setq gnus-article-post-menu gnus-summary-post-menu)) + ((not gnus-article-post-menu) + ;; Don't share post menu. + (setq gnus-article-post-menu + (copy-keymap gnus-summary-post-menu)))) + (define-key gnus-article-mode-map [menu-bar post] + (cons "Post" gnus-article-post-menu)) + (easy-menu-define gnus-summary-misc-menu gnus-summary-mode-map "" - '("Misc" + `("Misc" ("Mark Read" ["Mark as read" gnus-summary-mark-as-read-forward t] ["Mark same subject and select" gnus-summary-kill-same-subject-and-select t] ["Mark same subject" gnus-summary-kill-same-subject t] - ["Catchup" gnus-summary-catchup t] + ["Catchup" gnus-summary-catchup + ,@(if (featurep 'xemacs) '(t) + '(:help "Mark unread articles in this group as read"))] ["Catchup all" gnus-summary-catchup-all t] ["Catchup to here" gnus-summary-catchup-to-here t] ["Catchup region" gnus-summary-mark-region-as-read t] @@ -1872,7 +2033,7 @@ increase the score of each group you read." gnus-summary-limit-exclude-childless-dormant t] ;;["Hide thread" gnus-summary-limit-exclude-thread t] ["Hide marked" gnus-summary-limit-exclude-marks t] - ["Show expunged" gnus-summary-show-all-expunged t]) + ["Show expunged" gnus-summary-limit-include-expunged t]) ("Process Mark" ["Set mark" gnus-summary-mark-as-processable t] ["Remove mark" gnus-summary-unmark-as-processable t] @@ -1894,8 +2055,12 @@ increase the score of each group you read." gnus-newsgroup-process-stack] ["Save" gnus-summary-save-process-mark t])) ("Scroll article" - ["Page forward" gnus-summary-next-page t] - ["Page backward" gnus-summary-prev-page t] + ["Page forward" gnus-summary-next-page + ,@(if (featurep 'xemacs) '(t) + '(:help "Show next page of article"))] + ["Page backward" gnus-summary-prev-page + ,@(if (featurep 'xemacs) '(t) + '(:help "Show previous page of article"))] ["Line forward" gnus-summary-scroll-up t]) ("Move" ["Next unread article" gnus-summary-next-unread-article t] @@ -1919,7 +2084,8 @@ increase the score of each group you read." ["Sort by date" gnus-summary-sort-by-date t] ["Sort by score" gnus-summary-sort-by-score t] ["Sort by lines" gnus-summary-sort-by-lines t] - ["Sort by characters" gnus-summary-sort-by-chars t]) + ["Sort by characters" gnus-summary-sort-by-chars t] + ["Original sort" gnus-summary-sort-by-original t]) ("Help" ["Fetch group FAQ" gnus-summary-fetch-faq t] ["Describe group" gnus-summary-describe-group t] @@ -1931,6 +2097,8 @@ increase the score of each group you read." ["Regenerate" gnus-summary-prepare t] ["Insert cached articles" gnus-summary-insert-cached-articles t] ["Toggle threading" gnus-summary-toggle-threads t]) + ["See old articles" gnus-summary-insert-old-articles t] + ["See new articles" gnus-summary-insert-new-articles t] ["Filter articles..." gnus-summary-execute-command t] ["Run command on subjects..." gnus-summary-universal-argument t] ["Search articles forward..." gnus-summary-search-article-forward t] @@ -1946,10 +2114,14 @@ increase the score of each group you read." ["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 and exit" gnus-summary-catchup-and-exit + ,@(if (featurep 'xemacs) '(t) + '(:help "Mark unread articles in this group as read, then exit"))] ["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" gnus-summary-exit + ,@(if (featurep 'xemacs) '(t) + '(:help "Exit current group, return to group selection mode"))] ["Exit group without updating" gnus-summary-exit-no-update t] ["Exit and goto next group" gnus-summary-next-group t] ["Exit and goto prev group" gnus-summary-prev-group t] @@ -1959,6 +2131,50 @@ increase the score of each group you read." (gnus-run-hooks 'gnus-summary-menu-hook))) +(defvar gnus-summary-tool-bar-map nil) + +;; Emacs 21 tool bar. Should be no-op otherwise. +(defun gnus-summary-make-tool-bar () + (if (and (fboundp 'tool-bar-add-item-from-menu) + (default-value 'tool-bar-mode) + (not gnus-summary-tool-bar-map)) + (setq gnus-summary-tool-bar-map + (let ((tool-bar-map (make-sparse-keymap)) + (load-path (mm-image-load-path))) + (tool-bar-add-item-from-menu + 'gnus-summary-prev-unread "prev-ur" gnus-summary-mode-map) + (tool-bar-add-item-from-menu + 'gnus-summary-next-unread "next-ur" gnus-summary-mode-map) + (tool-bar-add-item-from-menu + 'gnus-summary-post-news "post" gnus-summary-mode-map) + (tool-bar-add-item-from-menu + 'gnus-summary-followup-with-original "fuwo" gnus-summary-mode-map) + (tool-bar-add-item-from-menu + 'gnus-summary-followup "followup" gnus-summary-mode-map) + (tool-bar-add-item-from-menu + 'gnus-summary-reply-with-original "reply-wo" gnus-summary-mode-map) + (tool-bar-add-item-from-menu + 'gnus-summary-reply "reply" gnus-summary-mode-map) + (tool-bar-add-item-from-menu + 'gnus-summary-caesar-message "rot13" gnus-summary-mode-map) + (tool-bar-add-item-from-menu + 'gnus-uu-decode-uu "uu-decode" gnus-summary-mode-map) + (tool-bar-add-item-from-menu + 'gnus-summary-save-article-file "save-aif" gnus-summary-mode-map) + (tool-bar-add-item-from-menu + 'gnus-summary-save-article "save-art" gnus-summary-mode-map) + (tool-bar-add-item-from-menu + 'gnus-uu-post-news "uu-post" gnus-summary-mode-map) + (tool-bar-add-item-from-menu + 'gnus-summary-catchup "catchup" gnus-summary-mode-map) + (tool-bar-add-item-from-menu + 'gnus-summary-catchup-and-exit "cu-exit" gnus-summary-mode-map) + (tool-bar-add-item-from-menu + 'gnus-summary-exit "exit-summ" gnus-summary-mode-map) + tool-bar-map))) + (if gnus-summary-tool-bar-map + (set (make-local-variable 'tool-bar-map) gnus-summary-tool-bar-map))) + (defun gnus-score-set-default (var value) "A version of set that updates the GNU Emacs menu-bar." (set var value) @@ -2067,10 +2283,13 @@ The following commands are available: \\{gnus-summary-mode-map}" (interactive) - (when (gnus-visual-p 'summary-menu 'menu) - (gnus-summary-make-menu-bar)) (kill-all-local-variables) + (when (gnus-visual-p 'summary-menu 'menu) + (gnus-summary-make-menu-bar) + (gnus-summary-make-tool-bar)) (gnus-summary-make-local-variables) + (let ((gnus-summary-local-variables gnus-newsgroup-variables)) + (gnus-summary-make-local-variables)) (gnus-make-thread-indent-array) (gnus-simplify-mode-line) (setq major-mode 'gnus-summary-mode) @@ -2085,6 +2304,9 @@ The following commands are available: (gnus-summary-set-display-table) (gnus-set-default-directory) (setq gnus-newsgroup-name group) + (unless (gnus-news-group-p group) + (setq gnus-newsgroup-incorporated + (nnmail-new-mail-numbers (gnus-group-real-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) @@ -2093,7 +2315,7 @@ The following commands are available: (make-local-hook 'pre-command-hook) (add-hook 'pre-command-hook 'gnus-set-global-variables nil t) (gnus-run-hooks 'gnus-summary-mode-hook) - (mm-enable-multibyte) + (turn-on-gnus-mailing-list-mode) (gnus-update-format-specifications nil 'summary 'summary-mode 'summary-dummy) (gnus-update-summary-mark-positions)) @@ -2146,7 +2368,7 @@ The following commands are available: `(nth 3 ,data)) (defmacro gnus-data-set-header (data header) - `(setf (nth 3 ,data) ,header)) + `(setcar (nthcdr 3 ,data) ,header)) (defmacro gnus-data-level (data) `(nth 4 ,data)) @@ -2430,12 +2652,13 @@ marks of articles." (defun gnus-restore-hidden-threads-configuration (config) "Restore hidden threads configuration from CONFIG." - (let (point buffer-read-only) - (while (setq point (pop config)) - (when (and (< point (point-max)) - (goto-char point) - (eq (char-after) ?\n)) - (subst-char-in-region point (1+ point) ?\n ?\r))))) + (save-excursion + (let (point buffer-read-only) + (while (setq point (pop config)) + (when (and (< point (point-max)) + (goto-char point) + (eq (char-after) ?\n)) + (subst-char-in-region point (1+ point) ?\n ?\r)))))) ;; Various summary mode internalish functions. @@ -2445,9 +2668,10 @@ marks of articles." (gnus-summary-next-page nil t)) (defun gnus-summary-set-display-table () - ;; Change the display table. Odd characters have a tendency to mess - ;; up nicely formatted displays - we make all possible glyphs - ;; display only a single character. + "Change the display table. +Odd characters have a tendency to mess +up nicely formatted displays - we make all possible glyphs +display only a single character." ;; We start from the standard display table, if any. (let ((table (or (copy-sequence standard-display-table) @@ -2470,9 +2694,13 @@ marks of articles." (aset table i [??])))) (setq buffer-display-table table))) +(defun gnus-summary-buffer-name (group) + "Return the summary buffer name of GROUP." + (concat "*Summary " group "*")) + (defun gnus-summary-setup-buffer (group) "Initialize summary buffer." - (let ((buffer (concat "*Summary " group "*"))) + (let ((buffer (gnus-summary-buffer-name group))) (if (get-buffer buffer) (progn (set-buffer buffer) @@ -2488,12 +2716,14 @@ marks of articles." (make-local-variable 'gnus-article-current) (make-local-variable 'gnus-original-article-buffer)) (setq gnus-newsgroup-name group) + ;; Set any local variables in the group parameters. + (gnus-summary-set-local-parameters gnus-newsgroup-name) t))) (defun gnus-set-global-variables () - ;; Set the global equivalents of the summary buffer-local variables - ;; to the latest values they had. These reflect the summary buffer - ;; that was in action when the last article was fetched. + "Set the global equivalents of the buffer-local variables. +They are set to the latest values they had. These reflect the summary +buffer that was in action when the last article was fetched." (when (eq major-mode 'gnus-summary-mode) (setq gnus-summary-buffer (current-buffer)) (let ((name gnus-newsgroup-name) @@ -2507,7 +2737,15 @@ marks of articles." (gac gnus-article-current) (reffed gnus-reffed-article-number) (score-file gnus-current-score-file) - (default-charset gnus-newsgroup-charset)) + (default-charset gnus-newsgroup-charset) + vlist) + (let ((locals gnus-newsgroup-variables)) + (while locals + (if (consp (car locals)) + (push (eval (caar locals)) vlist) + (push (eval (car locals)) vlist)) + (setq locals (cdr locals))) + (setq vlist (nreverse vlist))) (save-excursion (set-buffer gnus-group-buffer) (setq gnus-newsgroup-name name @@ -2522,6 +2760,12 @@ marks of articles." gnus-reffed-article-number reffed gnus-current-score-file score-file gnus-newsgroup-charset default-charset) + (let ((locals gnus-newsgroup-variables)) + (while locals + (if (consp (car locals)) + (set (caar locals) (pop vlist)) + (set (car locals) (pop vlist))) + (setq locals (cdr locals)))) ;; The article buffer also has local variables. (when (gnus-buffer-live-p gnus-article-buffer) (set-buffer gnus-article-buffer) @@ -2571,7 +2815,10 @@ marks of articles." (let ((gnus-summary-line-format-spec spec) (gnus-newsgroup-downloadable '((0 . t)))) (gnus-summary-insert-line - [0 "" "" "" "" "" 0 0 "" nil] 0 nil 128 t nil "" nil 1) + (make-full-mail-header 0 "" "nobody" + "05 Apr 2001 23:33:09 +0400" + "" "" 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))))) @@ -2598,10 +2845,8 @@ marks of articles." (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)))) - (mail-parse-charset gnus-newsgroup-charset) - (mail-parse-ignored-charsets - (save-excursion (set-buffer gnus-summary-buffer) - gnus-newsgroup-ignored-charsets))) + (default-mime-charset (with-current-buffer gnus-summary-buffer + default-mime-charset))) (cond ((and to gnus-ignored-from-addresses @@ -2635,7 +2880,7 @@ marks of articles." (if (or (null gnus-summary-default-score) (<= (abs (- gnus-tmp-score gnus-summary-default-score)) gnus-summary-zcore-fuzz)) - ? ;Whitespace + ?\ ;;;Whitespace (if (< gnus-tmp-score gnus-summary-default-score) gnus-score-below-mark gnus-score-over-mark))) (gnus-tmp-replied @@ -2645,15 +2890,14 @@ marks of articles." (gnus-tmp-replied gnus-replied-mark) ((memq gnus-tmp-current gnus-newsgroup-saved) gnus-saved-mark) - (t gnus-unread-mark))) + (t gnus-no-mark))) (gnus-tmp-from (mail-header-from gnus-tmp-header)) (gnus-tmp-name (cond ((string-match "<[^>]+> *$" gnus-tmp-from) (let ((beg (match-beginning 0))) - (or (and (string-match "^\"[^\"]*\"" gnus-tmp-from) - (substring gnus-tmp-from (1+ (match-beginning 0)) - (1- (match-end 0)))) + (or (and (string-match "^\".+\"" gnus-tmp-from) + (substring gnus-tmp-from 1 (1- (match-end 0)))) (substring gnus-tmp-from 0 beg)))) ((string-match "(.+)" gnus-tmp-from) (substring gnus-tmp-from @@ -2667,8 +2911,10 @@ marks of articles." (when (string= gnus-tmp-name "") (setq gnus-tmp-name gnus-tmp-from)) (unless (numberp gnus-tmp-lines) - (setq gnus-tmp-lines 0)) - (gnus-put-text-property + (setq gnus-tmp-lines -1)) + (when (= gnus-tmp-lines -1) + (setq gnus-tmp-lines "?")) + (gnus-put-text-property-excluding-characters-with-faces (point) (progn (eval gnus-summary-line-format-spec) (point)) 'gnus-number gnus-tmp-number) @@ -2678,7 +2924,7 @@ marks of articles." (forward-line 1)))) (defun gnus-summary-update-line (&optional dont-update) - ;; Update summary line after change. + "Update summary line after change." (when (and gnus-summary-default-score (not gnus-summary-inhibit-highlight)) (let* ((gnus-summary-inhibit-highlight t) ; Prevent recursion. @@ -2700,7 +2946,7 @@ marks of articles." (if (or (null gnus-summary-default-score) (<= (abs (- score gnus-summary-default-score)) gnus-summary-zcore-fuzz)) - ? ;Whitespace + ?\ ;;;Whitespace (if (< score gnus-summary-default-score) gnus-score-below-mark gnus-score-over-mark)) 'score)) @@ -2782,14 +3028,35 @@ If NO-DISPLAY, don't generate a summary buffer." (setq group nil))) result)) +(defun gnus-summary-jump-to-other-group (group &optional show-all) + "Directly jump to the other GROUP from summary buffer. +If SHOW-ALL is non-nil, already read articles are also listed." + (interactive + (if (eq gnus-summary-buffer (current-buffer)) + (list (completing-read + "Group: " gnus-active-hashtb nil t + (when (and gnus-newsgroup-name + (string-match "[.:][^.:]+$" gnus-newsgroup-name)) + (substring gnus-newsgroup-name 0 (1+ (match-beginning 0)))) + 'gnus-group-history) + current-prefix-arg) + (error "%s must be invoked from a gnus summary buffer." this-command))) + (unless (or (zerop (length group)) + (and gnus-newsgroup-name + (string-equal gnus-newsgroup-name group))) + (gnus-summary-exit) + (gnus-summary-read-group group show-all + gnus-dont-select-after-jump-to-other-group))) + (defun gnus-summary-read-group-1 (group show-all no-article 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))) - (error "Dead non-native groups can't be entered")) - (gnus-message 5 "Retrieving newsgroup: %s..." group) + ;; (when (and (not (gnus-group-native-p group)) + ;; (not (gnus-gethash group gnus-newsrc-hashtb))) + ;; (error "Dead non-native groups can't be entered")) + (gnus-message 5 "Retrieving newsgroup: %s..." + (gnus-group-decoded-name group)) (let* ((new-group (gnus-summary-setup-buffer group)) (quit-config (gnus-group-quit-config group)) (did-select (and new-group (gnus-select-newsgroup @@ -2819,7 +3086,11 @@ If NO-DISPLAY, don't generate a summary buffer." (gnus-group-jump-to-group group) (gnus-group-next-unread-group 1)) (gnus-handle-ephemeral-exit quit-config))) - (gnus-message 3 "Can't select group") + (let ((grpinfo (gnus-get-info group))) + (if (null (gnus-info-read grpinfo)) + (gnus-message 3 "Group %s contains no messages" + (gnus-group-decoded-name group)) + (gnus-message 3 "Can't select group"))) nil) ;; The user did a `C-g' while prompting for number of articles, ;; so we exit this group. @@ -2847,8 +3118,6 @@ If NO-DISPLAY, don't generate a summary buffer." (gnus-active gnus-newsgroup-name))) ;; You can change the summary buffer in some way with this 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 nil 'summary 'summary-mode 'summary-dummy) (gnus-update-summary-mark-positions) @@ -2989,7 +3258,8 @@ If NO-DISPLAY, don't generate a summary buffer." "Query where the respool algorithm would put this article." (interactive) (gnus-summary-select-article) - (message (gnus-general-simplify-subject (gnus-summary-article-subject)))) + (message "%s" + (gnus-general-simplify-subject (gnus-summary-article-subject)))) (defun gnus-gather-threads-by-subject (threads) "Gather threads by looking at Subject headers." @@ -3063,7 +3333,7 @@ If NO-DISPLAY, don't generate a summary buffer." result)) (defun gnus-sort-gathered-threads (threads) - "Sort subtreads inside each gathered thread by article number." + "Sort subtreads inside each gathered thread by `gnus-sort-gathered-threads-function'." (let ((result threads)) (while threads (when (stringp (caar threads)) @@ -3237,7 +3507,7 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." (mapcar (lambda (relation) (when (gnus-dependencies-add-header - (make-full-mail-header + (make-full-mail-header-from-decoded-header gnus-reffed-article-number (nth 3 relation) "" (or (nth 4 relation) "") (nth 1 relation) @@ -3288,19 +3558,19 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." (setq header (make-full-mail-header - number ; number - (funcall gnus-decode-encoded-word-function - (nnheader-nov-field)) ; subject - (funcall gnus-decode-encoded-word-function - (nnheader-nov-field)) ; from - (nnheader-nov-field) ; date + number ; number + (nnheader-nov-field) ; subject + (nnheader-nov-field) ; from + (nnheader-nov-field) ; date (nnheader-nov-read-message-id) ; id - (nnheader-nov-field) ; refs - (nnheader-nov-read-integer) ; chars - (nnheader-nov-read-integer) ; lines + (nnheader-nov-field) ; refs + (nnheader-nov-read-integer) ; chars + (nnheader-nov-read-integer) ; lines (unless (eobp) - (nnheader-nov-field)) ; misc - (nnheader-nov-parse-extra)))) ; extra + (if (looking-at "Xref: ") + (goto-char (match-end 0))) + (nnheader-nov-field)) ; Xref + (nnheader-nov-parse-extra)))) ; extra (widen)) @@ -3309,9 +3579,9 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." (gnus-dependencies-add-header header dependencies force-new))) (defun gnus-build-get-header (id) - ;; 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). + "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) (prog1 @@ -3638,13 +3908,22 @@ If LINE, insert the rebuilt thread starting on line LINE." (1+ (gnus-point-at-eol)) (gnus-delete-line))))))) +(defun gnus-sort-threads-1 (threads func) + (sort (mapcar (lambda (thread) + (cons (car thread) + (and (cdr thread) + (gnus-sort-threads-1 (cdr thread) func)))) + threads) func)) + (defun gnus-sort-threads (threads) "Sort THREADS." (if (not gnus-thread-sort-functions) threads (gnus-message 8 "Sorting threads...") (prog1 - (sort threads (gnus-make-sort-function gnus-thread-sort-functions)) + (gnus-sort-threads-1 + threads + (gnus-make-sort-function gnus-thread-sort-functions)) (gnus-message 8 "Sorting threads...done")))) (defun gnus-sort-articles (articles) @@ -3659,12 +3938,12 @@ If LINE, insert the rebuilt thread starting on line LINE." ;; Written by Hallvard B Furuseth . (defmacro gnus-thread-header (thread) - ;; Return header of first article in THREAD. - ;; Note that THREAD must never, ever be anything else than a variable - - ;; using some other form will lead to serious barfage. + "Return header of first article in THREAD. +Note that THREAD must never, ever be anything else than a variable - +using some other form will lead to serious barfage." (or (symbolp thread) (signal 'wrong-type-argument '(symbolp thread))) ;; (8% speedup to gnus-summary-prepare, just for fun :-) - (list 'byte-code "\10\211:\203\17\0\211@;\203\16\0A@@\207" + (list 'byte-code "\10\211:\203\17\0\211@;\203\16\0A@@\207" (vector thread) 2)) (defsubst gnus-article-sort-by-number (h1 h2) @@ -3700,14 +3979,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 (car (mime-entity-read-field h1 'From)))) + (or (std11-full-name-string addr) + (std11-address-string addr) + "")) + (let ((addr (car (mime-entity-read-field h2 'From)))) + (or (std11-full-name-string addr) + (std11-address-string addr) + "")) + )) (defun gnus-thread-sort-by-author (h1 h2) "Sort threads by root author." @@ -3788,7 +4068,7 @@ 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) +(eval-when-compile (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)))) @@ -3991,7 +4271,7 @@ or a straight list of headers." (if (or (null gnus-summary-default-score) (<= (abs (- gnus-tmp-score gnus-summary-default-score)) gnus-summary-zcore-fuzz)) - ? ;Whitespace + ?\ ;;;Whitespace (if (< gnus-tmp-score gnus-summary-default-score) gnus-score-below-mark gnus-score-over-mark)) gnus-tmp-replied @@ -4001,17 +4281,18 @@ or a straight list of headers." gnus-cached-mark) ((memq number gnus-newsgroup-replied) gnus-replied-mark) + ((memq number gnus-newsgroup-forwarded) + gnus-forwarded-mark) ((memq number gnus-newsgroup-saved) gnus-saved-mark) - (t gnus-unread-mark)) + (t gnus-no-mark)) gnus-tmp-from (mail-header-from gnus-tmp-header) gnus-tmp-name (cond ((string-match "<[^>]+> *$" gnus-tmp-from) (setq beg-match (match-beginning 0)) - (or (and (string-match "^\"[^\"]*\"" gnus-tmp-from) - (substring gnus-tmp-from (1+ (match-beginning 0)) - (1- (match-end 0)))) + (or (and (string-match "^\".+\"" gnus-tmp-from) + (substring gnus-tmp-from 1 (1- (match-end 0)))) (substring gnus-tmp-from 0 beg-match))) ((string-match "(.+)" gnus-tmp-from) (substring gnus-tmp-from @@ -4020,7 +4301,9 @@ or a straight list of headers." (when (string= gnus-tmp-name "") (setq gnus-tmp-name gnus-tmp-from)) (unless (numberp gnus-tmp-lines) - (setq gnus-tmp-lines 0)) + (setq gnus-tmp-lines -1)) + (when (= gnus-tmp-lines -1) + (setq gnus-tmp-lines "?")) (gnus-put-text-property (point) (progn (eval gnus-summary-line-format-spec) (point)) @@ -4077,21 +4360,50 @@ or a straight list of headers." (defun gnus-summary-remove-list-identifiers () "Remove list identifiers in `gnus-list-identifiers' from articles in the current group." - (let ((regexp (if (stringp gnus-list-identifiers) - gnus-list-identifiers - (mapconcat 'identity gnus-list-identifiers " *\\|")))) - (dolist (header gnus-newsgroup-headers) - (when (string-match (concat "\\(\\(\\(Re: +\\)?\\(" regexp - " *\\)\\)+\\(Re: +\\)?\\)") - (mail-header-subject header)) - (mail-header-set-subject - header (concat (substring (mail-header-subject header) - 0 (match-beginning 1)) - (or - (match-string 3 (mail-header-subject header)) - (match-string 5 (mail-header-subject header))) - (substring (mail-header-subject header) - (match-end 1)))))))) + (let ((regexp (if (consp gnus-list-identifiers) + (mapconcat 'identity gnus-list-identifiers " *\\|") + gnus-list-identifiers)) + changed subject) + (when regexp + (dolist (header gnus-newsgroup-headers) + (setq subject (mail-header-subject header) + changed nil) + (while (string-match + (concat "^\\(R[Ee]: +\\)*\\(" regexp " *\\)") + subject) + (setq subject + (concat (substring subject 0 (match-beginning 2)) + (substring subject (match-end 0))) + changed t)) + (when (and changed + (string-match + "^\\(\\(R[Ee]: +\\)+\\)R[Ee]: +" subject)) + (setq subject + (concat (substring subject 0 (match-beginning 1)) + (substring subject (match-end 1))))) + (when changed + (mail-header-set-subject header subject)))))) + +(defun gnus-fetch-headers (articles) + "Fetch headers of ARTICLES." + (let ((name (gnus-group-decoded-name gnus-newsgroup-name))) + (gnus-message 5 "Fetching headers for %s..." name) + (prog1 + (if (eq 'nov + (setq gnus-headers-retrieved-by + (gnus-retrieve-headers + articles gnus-newsgroup-name + ;; We might want to fetch old headers, but + ;; not if there is only 1 article. + (and (or (and + (not (eq gnus-fetch-old-headers 'some)) + (not (numberp gnus-fetch-old-headers))) + (> (length articles) 1)) + gnus-fetch-old-headers)))) + (gnus-get-newsgroup-headers-xover + articles nil nil gnus-newsgroup-name t) + (gnus-get-newsgroup-headers)) + (gnus-message 5 "Fetching headers for %s...done" name)))) (defun gnus-select-newsgroup (group &optional read-all select-articles) "Select newsgroup GROUP. @@ -4116,7 +4428,7 @@ If SELECT-ARTICLES, only select those articles from GROUP." (progn ; Or we bug out. (when (equal major-mode 'gnus-summary-mode) (kill-buffer (current-buffer))) - (error "Couldn't request group %s: %s" + (error "Couldn't activate group %s: %s" group (gnus-status-message group)))) (unless (gnus-request-group group t) @@ -4165,23 +4477,7 @@ If SELECT-ARTICLES, only select those articles from GROUP." (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 - (if (eq 'nov - (setq gnus-headers-retrieved-by - (gnus-retrieve-headers - articles gnus-newsgroup-name - ;; We might want to fetch old headers, but - ;; not if there is only 1 article. - (and (or (and - (not (eq gnus-fetch-old-headers 'some)) - (not (numberp gnus-fetch-old-headers))) - (> (length articles) 1)) - gnus-fetch-old-headers)))) - (gnus-get-newsgroup-headers-xover - articles nil nil gnus-newsgroup-name t) - (gnus-get-newsgroup-headers))) - (gnus-message 5 "Fetching headers for %s...done" gnus-newsgroup-name) + (setq gnus-newsgroup-headers (gnus-fetch-headers articles)) ;; Kludge to avoid having cached articles nixed out in virtual groups. (when cached @@ -4232,7 +4528,7 @@ If SELECT-ARTICLES, only select those articles from GROUP." (or gnus-newsgroup-headers t))))) (defun gnus-articles-to-read (group &optional read-all) - ;; Find out what articles the user wants to read. + "Find out what articles the user wants to read." (let* ((articles ;; Select all articles if `read-all' is non-nil, or if there ;; are no unread articles. @@ -4260,15 +4556,19 @@ If SELECT-ARTICLES, only select those articles from GROUP." (condition-case () (cond ((and (or (<= scored marked) (= scored number)) - (numberp gnus-large-newsgroup) + (natnump gnus-large-newsgroup) (> number gnus-large-newsgroup)) - (let ((input - (read-string - (format - "How many articles from %s (default %d): " - (gnus-limit-string gnus-newsgroup-name 35) - number)))) - (if (string-match "^[ \t]*$" input) number input))) + (let* ((cursor-in-echo-area nil) + (input (read-from-minibuffer + (format + "How many articles from %s (max %d): " + (gnus-limit-string gnus-newsgroup-name 35) + number) + (cons (number-to-string gnus-large-newsgroup) + 0)))) + (if (string-match "^[ \t]*$" input) + number + input))) ((and (> scored marked) (< scored number) (> (- scored number) 20)) (let ((input @@ -4279,7 +4579,9 @@ If SELECT-ARTICLES, only select those articles from GROUP." (if (string-match "^[ \t]*$" input) number input))) (t number)) - (quit nil)))))) + (quit + (message "Quit getting the articles to read") + nil)))))) (setq select (if (stringp select) (string-to-number select) select)) (if (or (null select) (zerop select)) select @@ -4301,7 +4603,7 @@ If SELECT-ARTICLES, only select those articles from GROUP." (gnus-sorted-complement gnus-newsgroup-unreads articles))) (when gnus-alter-articles-to-read-function (setq gnus-newsgroup-unreads - (sort + (sort (funcall gnus-alter-articles-to-read-function gnus-newsgroup-name gnus-newsgroup-unreads) '<))) @@ -4413,12 +4715,17 @@ If SELECT-ARTICLES, only select those articles from GROUP." (unless (memq (cdr type) uncompressed) (setq list (gnus-compress-sequence (set symbol (sort list '<)) t))) - + (when (gnus-check-backend-function 'request-set-mark gnus-newsgroup-name) + ;; propagate flags to server, with the following exceptions: ;; uncompressed:s are not proper flags (they are cons cells) ;; cache is a internal gnus flag - (unless (memq (cdr type) (cons 'cache uncompressed)) + ;; download are local to one gnus installation (well) + ;; unsend are for nndraft groups only + ;; xxx: generality of this? this suits nnimap anyway + (unless (memq (cdr type) (append '(cache download unsend) + uncompressed)) (let* ((old (cdr (assq (cdr type) (gnus-info-marks info)))) (del (gnus-remove-from-range (gnus-copy-sequence old) list)) (add (gnus-remove-from-range @@ -4427,7 +4734,7 @@ If SELECT-ARTICLES, only select those articles from GROUP." (push (list add 'add (list (cdr type))) delta-marks)) (when del (push (list del 'del (list (cdr type))) delta-marks))))) - + (when list (push (cons (cdr type) list) newmarked))) @@ -4435,7 +4742,7 @@ If SELECT-ARTICLES, only select those articles from GROUP." (unless (gnus-check-group gnus-newsgroup-name) (error "Can't open server for %s" gnus-newsgroup-name)) (gnus-request-set-mark gnus-newsgroup-name delta-marks)) - + ;; Enter these new marks into the info of the group. (if (nthcdr 3 info) (setcar (nthcdr 3 info) newmarked) @@ -4451,7 +4758,7 @@ If SELECT-ARTICLES, only select those articles from GROUP." (setcdr (nthcdr i info) nil))))))) (defun gnus-set-mode-line (where) - "This function sets the mode line of the article or summary buffers. + "Set 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 (and (memq where gnus-updated-mode-lines) @@ -4467,11 +4774,8 @@ If WHERE is `summary', the summary mode line format will be used." (let* ((mformat (symbol-value (intern (format "gnus-%s-mode-line-format-spec" where)))) - (gnus-tmp-group-name (gnus-group-name-decode - gnus-newsgroup-name - (gnus-group-name-charset - nil - gnus-newsgroup-name))) + (gnus-tmp-group-name (gnus-group-decoded-name + gnus-newsgroup-name)) (gnus-tmp-article-number (or gnus-current-article 0)) (gnus-tmp-unread gnus-newsgroup-unreads) (gnus-tmp-unread-and-unticked (length gnus-newsgroup-unreads)) @@ -4510,7 +4814,7 @@ If WHERE is `summary', the summary mode line format will be used." ;; We might have to chop a bit of the string off... (when (> (length mode-string) max-len) (setq mode-string - (concat (truncate-string-to-width mode-string (- max-len 3)) + (concat (gnus-truncate-string mode-string (- max-len 3)) "..."))) ;; Pad the mode string a bit. (setq mode-string (format (format "%%-%ds" max-len) mode-string)))) @@ -4667,7 +4971,7 @@ The resulting hash table is returned, or nil if no Xrefs were found." gnus-newsgroup-dependencies))) headers id end ref (mail-parse-charset gnus-newsgroup-charset) - (mail-parse-ignored-charsets + (mail-parse-ignored-charsets (save-excursion (condition-case nil (set-buffer gnus-summary-buffer) (error)) @@ -4679,7 +4983,7 @@ The resulting hash table is returned, or nil if no Xrefs were found." (subst-char-in-region (point-min) (point-max) ?\r ? t) (gnus-run-hooks 'gnus-parse-headers-hook) (let ((case-fold-search t) - 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. @@ -4694,7 +4998,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) @@ -4708,21 +5012,21 @@ The resulting hash table is returned, or nil if no Xrefs were found." (progn (goto-char p) (if (search-forward "\nsubject: " nil t) - (funcall gnus-decode-encoded-word-function - (nnheader-header-value)) + (nnheader-header-value) "(none)")) ;; From. (progn (goto-char p) - (if (search-forward "\nfrom: " nil t) - (funcall gnus-decode-encoded-word-function - (nnheader-header-value)) + (if (or (search-forward "\nfrom: " nil t) + (search-forward "\nfrom:" nil t)) + (nnheader-header-value) "(nobody)")) ;; Date. (progn (goto-char p) (if (search-forward "\ndate: " nil t) - (nnheader-header-value) "")) + (nnheader-header-value) + "")) ;; Message-ID. (progn (goto-char p) @@ -4746,7 +5050,7 @@ The resulting hash table is returned, or nil if no Xrefs were found." (setq ref (buffer-substring (progn - (end-of-line) + ;; (end-of-line) (search-backward ">" end t) (1+ (point))) (progn @@ -4773,15 +5077,15 @@ The resulting hash table is returned, or nil if no Xrefs were found." (goto-char p) (if (search-forward "\nchars: " nil t) (if (numberp (setq chars (ignore-errors (read cur)))) - chars 0) - 0)) + chars -1) + -1)) ;; Lines. (progn (goto-char p) (if (search-forward "\nlines: " nil t) (if (numberp (setq lines (ignore-errors (read cur)))) - lines 0) - 0)) + lines -1) + -1)) ;; Xref. (progn (goto-char p) @@ -4795,10 +5099,14 @@ The resulting hash table is returned, or nil if no Xrefs were found." (goto-char p) (when (search-forward (concat "\n" (symbol-name (car extra)) ": ") nil t) - (push (cons (car extra) (nnheader-header-value)) - out)) + (push (cons (car extra) (nnheader-header-value)) out)) (pop extra)) out)))) + (goto-char p) + (if (and (search-forward "\ncontent-type: " nil t) + (setq ctype (nnheader-header-value))) + (mime-entity-set-content-type-internal + header (mime-parse-Content-Type ctype))) (when (equal id ref) (setq ref nil)) @@ -4819,8 +5127,9 @@ The resulting hash table is returned, or nil if no Xrefs were found." (defun gnus-get-newsgroup-headers-xover (sequence &optional force-new dependencies group also-fetch-heads) - "Parse the news overview data in the server buffer, and return a -list of headers that match SEQUENCE (see `nntp-retrieve-headers')." + "Parse the news overview data in the server buffer. +Return a 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)) @@ -4828,6 +5137,13 @@ list of headers that match SEQUENCE (see `nntp-retrieve-headers')." (mail-parse-ignored-charsets gnus-newsgroup-ignored-charsets) (cur nntp-server-buffer) (dependencies (or dependencies gnus-newsgroup-dependencies)) + (allp (cond + ((eq gnus-read-all-available-headers t) + t) + ((stringp gnus-read-all-available-headers) + (string-match gnus-read-all-available-headers group)) + (t + nil))) number headers header) (save-excursion (set-buffer nntp-server-buffer) @@ -4837,19 +5153,22 @@ list of headers that match SEQUENCE (see `nntp-retrieve-headers')." (goto-char (point-min)) (while (not (eobp)) (condition-case () - (while (and sequence (not (eobp))) + (while (and (or sequence allp) + (not (eobp))) (setq number (read cur)) - (while (and sequence - (< (car sequence) number)) - (setq sequence (cdr sequence))) - (and sequence - (eq number (car sequence)) - (progn - (setq sequence (cdr sequence)) - (setq header (inline - (gnus-nov-parse-line - number dependencies force-new)))) - (push header headers)) + (when (not allp) + (while (and sequence + (< (car sequence) number)) + (setq sequence (cdr sequence)))) + (when (and (or allp + (and sequence + (eq number (car sequence)))) + (progn + (setq sequence (cdr sequence)) + (setq header (inline + (gnus-nov-parse-line + number dependencies force-new))))) + (push header headers)) (forward-line 1)) (error (gnus-error 4 "Strange nov line (%d)" @@ -4868,7 +5187,7 @@ list of headers that match SEQUENCE (see `nntp-retrieve-headers')." (let ((gnus-nov-is-evil t)) (nconc (nreverse headers) - (when (gnus-retrieve-headers sequence group) + (when (eq (gnus-retrieve-headers sequence group) 'headers) (gnus-get-newsgroup-headers)))))))) (defun gnus-article-get-xrefs () @@ -4978,7 +5297,7 @@ current article will be taken into consideration." (let ((max (max (point) (mark))) articles article) (save-excursion - (goto-char (min (min (point) (mark)))) + (goto-char (min (point) (mark))) (while (and (push (setq article (gnus-summary-article-number)) articles) @@ -5138,8 +5457,7 @@ articles with that subject. If BACKWARD, search backward instead." "Center point in window and redisplay frame. Also do horizontal recentering." (interactive "P") - (when (and nil - gnus-auto-center-summary + (when (and gnus-auto-center-summary (not (eq gnus-auto-center-summary 'vertical))) (gnus-horizontal-recenter)) (recenter n)) @@ -5168,10 +5486,22 @@ displayed, no centering will be performed." ;; Set the window start to either `bottom', which is the biggest ;; possible valid number, or the second line from the top, ;; whichever is the least. - (set-window-start - window (min bottom (save-excursion - (forward-line (- top)) (point))) - t)) + (let ((top-pos (save-excursion (forward-line (- top)) (point)))) + (if (> bottom top-pos) + ;; Keep the second line from the top visible + (set-window-start window top-pos t) + ;; Try to keep the bottom line visible; if it's partially + ;; obscured, either scroll one more line to make it fully + ;; visible, or revert to using TOP-POS. + (save-excursion + (goto-char (point-max)) + (forward-line -1) + (let ((last-line-start (point))) + (goto-char bottom) + (set-window-start window (point) t) + (when (not (pos-visible-in-window-p last-line-start window)) + (forward-line 1) + (set-window-start window (min (point) top-pos) t))))))) ;; Do horizontal recentering while we're at it. (when (and (get-buffer-window (current-buffer) t) (not (eq gnus-auto-center-summary 'vertical))) @@ -5306,7 +5636,10 @@ The prefix argument ALL means to select all articles." (gnus-summary-jump-to-group group) (when rescan (save-excursion - (gnus-group-get-new-news-this-group 1))) + (save-window-excursion + ;; Don't show group contents. + (set-window-start (selected-window) (point-max)) + (gnus-group-get-new-news-this-group 1)))) (gnus-group-read-group all t) (gnus-summary-goto-subject current-subject nil t))) @@ -5370,10 +5703,6 @@ If FORCE (the prefix), also save the .newsrc file(s)." `gnus-exit-group-hook' is called with no arguments if that value is non-nil." (interactive) (gnus-set-global-variables) - (when (gnus-buffer-live-p gnus-article-buffer) - (save-excursion - (set-buffer gnus-article-buffer) - (mm-destroy-parts gnus-article-mime-handles))) (gnus-kill-save-kill-buffer) (gnus-async-halt-prefetch) (let* ((group gnus-newsgroup-name) @@ -5429,28 +5758,41 @@ If FORCE (the prefix), also save the .newsrc file(s)." (setq gnus-article-current nil)) (set-buffer buf) (if (not gnus-kill-summary-on-exit) - (gnus-deaden-summary) + (progn + (gnus-deaden-summary) + (setq mode nil)) ;; We set all buffer-local variables to nil. It is unclear why ;; this is needed, but if we don't, buffer-local variables are ;; not garbage-collected, it seems. This would the lead to en ;; ever-growing Emacs. (gnus-summary-clear-local-variables) + (let ((gnus-summary-local-variables gnus-newsgroup-variables)) + (gnus-summary-clear-local-variables)) (when (get-buffer gnus-article-buffer) (bury-buffer gnus-article-buffer)) ;; We clear the global counterparts of the buffer-local ;; variables as well, just to be on the safe side. (set-buffer gnus-group-buffer) (gnus-summary-clear-local-variables) - ;; Return to group mode buffer. - (when (eq mode 'gnus-summary-mode) - (gnus-kill-buffer buf))) + (let ((gnus-summary-local-variables gnus-newsgroup-variables)) + (gnus-summary-clear-local-variables))) (setq gnus-current-select-method gnus-select-method) (pop-to-buffer gnus-group-buffer) (if (not quit-config) (progn (goto-char group-point) - (gnus-configure-windows 'group 'force)) + (gnus-configure-windows 'group 'force) + (unless (pos-visible-in-window-p) + (forward-line (/ (static-if (featurep 'xemacs) + (window-displayed-height) + (1- (window-height))) + -2)) + (set-window-start (selected-window) (point)) + (goto-char group-point))) (gnus-handle-ephemeral-exit quit-config)) + ;; Return to group mode buffer. + (when (eq mode 'gnus-summary-mode) + (gnus-kill-buffer buf)) ;; Clear the current group name. (unless quit-config (setq gnus-newsgroup-name nil))))) @@ -5468,10 +5810,6 @@ If FORCE (the prefix), also save the .newsrc file(s)." (mapcar 'funcall (delq 'gnus-summary-expire-articles (copy-sequence gnus-summary-prepare-exit-hook))) - (when (gnus-buffer-live-p gnus-article-buffer) - (save-excursion - (set-buffer gnus-article-buffer) - (mm-destroy-parts gnus-article-mime-handles))) ;; If we have several article buffers, we kill them at exit. (unless gnus-single-article-buffer (gnus-kill-buffer gnus-article-buffer) @@ -5481,8 +5819,12 @@ If FORCE (the prefix), also save the .newsrc file(s)." (gnus-deaden-summary) (gnus-close-group group) (gnus-summary-clear-local-variables) + (let ((gnus-summary-local-variables gnus-newsgroup-variables)) + (gnus-summary-clear-local-variables)) (set-buffer gnus-group-buffer) (gnus-summary-clear-local-variables) + (let ((gnus-summary-local-variables gnus-newsgroup-variables)) + (gnus-summary-clear-local-variables)) (when (get-buffer gnus-summary-buffer) (kill-buffer gnus-summary-buffer))) (unless gnus-single-article-buffer @@ -5533,6 +5875,14 @@ The state which existed when entering the ephemeral is reset." (gnus-summary-recenter) (gnus-summary-position-point)))) +(defun gnus-summary-preview-mime-message () + "MIME decode and play this message." + (interactive) + (let ((gnus-break-pages nil) + (gnus-show-mime t)) + (gnus-summary-select-article gnus-show-all-headers t)) + (select-window (get-buffer-window gnus-article-buffer))) + ;;; Dead summaries. (defvar gnus-dead-summary-mode-map nil) @@ -5809,13 +6159,23 @@ Given a prefix, will force an `article' buffer configuration." (defun gnus-summary-display-article (article &optional all-header) "Display ARTICLE in article buffer." + (when (gnus-buffer-live-p gnus-article-buffer) + (with-current-buffer gnus-article-buffer + (set-buffer-multibyte t))) (gnus-set-global-variables) + (when (gnus-buffer-live-p gnus-article-buffer) + (with-current-buffer gnus-article-buffer + (setq gnus-article-charset gnus-newsgroup-charset) + (setq gnus-article-ignored-charsets gnus-newsgroup-ignored-charsets))) (if (null article) nil (prog1 (if gnus-summary-display-article-function (funcall gnus-summary-display-article-function article all-header) (gnus-article-prepare article all-header)) + (with-current-buffer gnus-article-buffer + (set (make-local-variable 'gnus-summary-search-article-matched-data) + nil)) (gnus-run-hooks 'gnus-select-article-hook) (when (and gnus-current-article (not (zerop gnus-current-article))) @@ -5858,14 +6218,7 @@ be displayed." force) ;; The requested article is different from the current article. (progn - (when (gnus-buffer-live-p gnus-article-buffer) - (with-current-buffer gnus-article-buffer - (mm-enable-multibyte))) (gnus-summary-display-article article all-headers) - (when (gnus-buffer-live-p gnus-article-buffer) - (with-current-buffer gnus-article-buffer - (if (not gnus-article-decoded-p) ;; a local variable - (mm-disable-multibyte)))) (when (or all-headers gnus-show-all-headers) (gnus-article-show-all-headers)) (gnus-article-set-window-start @@ -5875,6 +6228,12 @@ be displayed." (gnus-article-show-all-headers)) 'old)))) +(defun gnus-summary-force-verify-and-decrypt () + (interactive) + (let ((mm-verify-option 'known) + (mm-decrypt-option 'known)) + (gnus-summary-select-article nil 'force))) + (defun gnus-summary-set-current-mark (&optional current-mark) "Obsolete function." nil) @@ -6292,7 +6651,7 @@ articles that are younger than AGE days." (while (not days-got) (setq days (if younger (read-string "Limit to articles within (in days): ") - (read-string "Limit to articles old than (in days): "))) + (read-string "Limit to articles older than (in days): "))) (when (> (length days) 0) (setq days (read days))) (if (numberp days) @@ -6325,12 +6684,12 @@ articles that are younger than AGE days." (let ((header (intern (gnus-completing-read - (symbol-name (car gnus-extra-headers)) - "Limit extra header:" - (mapcar (lambda (x) + (symbol-name (car gnus-extra-headers)) + "Limit extra header:" + (mapcar (lambda (x) (cons (symbol-name x) x)) gnus-extra-headers) - nil + nil t)))) (list header (read-string (format "Limit to header %s (regexp): " header))))) @@ -6413,12 +6772,27 @@ Returns how many articles were removed." (gnus-summary-position-point)))) (defun gnus-summary-limit-include-thread (id) - "Display all the hidden articles that in the current thread." + "Display all the hidden articles that is in the thread with ID in it. +When called interactively, ID is the Message-ID of the current +article." (interactive (list (mail-header-id (gnus-summary-article-header)))) (let ((articles (gnus-articles-in-thread (gnus-id-to-thread (gnus-root-id id))))) (prog1 (gnus-summary-limit (nconc articles gnus-newsgroup-limit)) + (gnus-summary-limit-include-matching-articles + "subject" + (regexp-quote (gnus-simplify-subject-re + (mail-header-subject (gnus-id-to-header id))))) + (gnus-summary-position-point)))) + +(defun gnus-summary-limit-include-matching-articles (header regexp) + "Display all the hidden articles that have HEADERs that match REGEXP." + (interactive (list (read-string "Match on header: ") + (read-string "Regexp: "))) + (let ((articles (gnus-find-matching-articles header regexp))) + (prog1 + (gnus-summary-limit (nconc articles gnus-newsgroup-limit)) (gnus-summary-position-point)))) (defun gnus-summary-limit-include-dormant () @@ -6844,7 +7218,8 @@ of what's specified by the `gnus-refer-thread-limit' variable." ((eq 'current gnus-refer-article-method) (list gnus-current-select-method)) ;; List of select methods. - ((not (stringp (cadr gnus-refer-article-method))) + ((not (and (symbolp (car gnus-refer-article-method)) + (assq (car gnus-refer-article-method) nnoo-definition-alist))) (let (out) (dolist (method gnus-refer-article-method) (push (if (eq 'current method) @@ -6894,7 +7269,10 @@ to guess what the document format is." ;; the parent article. (when (setq to-address (or (message-fetch-field "reply-to") (message-fetch-field "from"))) - (setq params (append (list (cons 'to-address to-address))))) + (setq params (append + (list (cons 'to-address + (funcall gnus-decode-encoded-word-function + to-address)))))) (setq dig (nnheader-set-temp-buffer " *gnus digest buffer*")) (insert-buffer-substring gnus-original-article-buffer) ;; Remove lines that may lead nndoc to misinterpret the @@ -6977,12 +7355,16 @@ Obeys the standard process/prefix convention." "Do incremental search forward on the current article. If REGEXP-P (the prefix) is non-nil, do regexp isearch." (interactive "P") - (gnus-summary-select-article) - (gnus-configure-windows 'article) - (gnus-eval-in-buffer-window gnus-article-buffer - (save-restriction - (widen) - (isearch-forward regexp-p)))) + (let* ((gnus-inhibit-treatment t) + (old (gnus-summary-select-article))) + (gnus-configure-windows 'article) + (gnus-eval-in-buffer-window gnus-article-buffer + (save-restriction + (widen) + (when (eq 'old old) + (gnus-article-show-all-headers)) + (goto-char (point-min)) + (isearch-forward regexp-p))))) (defun gnus-summary-search-article-forward (regexp &optional backward) "Search for an article containing REGEXP forward. @@ -6997,10 +7379,14 @@ If BACKWARD, search backward instead." current-prefix-arg)) (if (string-equal regexp "") (setq regexp (or gnus-last-search-regexp "")) - (setq gnus-last-search-regexp regexp)) - (if (gnus-summary-search-article regexp backward) - (gnus-summary-show-thread) - (error "Search failed: \"%s\"" regexp))) + (setq gnus-last-search-regexp regexp) + (setq gnus-article-before-search gnus-current-article)) + ;; Intentionally set gnus-last-article. + (setq gnus-last-article gnus-article-before-search) + (let ((gnus-last-article gnus-last-article)) + (if (gnus-summary-search-article regexp backward) + (gnus-summary-show-thread) + (error "Search failed: \"%s\"" regexp)))) (defun gnus-summary-search-article-backward (regexp) "Search for an article containing REGEXP backward." @@ -7012,6 +7398,84 @@ If BACKWARD, search backward instead." ""))))) (gnus-summary-search-article-forward regexp 'backward)) +(eval-when-compile + (defmacro gnus-summary-search-article-position-point (regexp backward) + "Dehighlight the last matched text and goto the beginning position." + (` (if (and gnus-summary-search-article-matched-data + (let ((text (caddr gnus-summary-search-article-matched-data)) + (inhibit-read-only t) + buffer-read-only) + (delete-region + (goto-char (car gnus-summary-search-article-matched-data)) + (cadr gnus-summary-search-article-matched-data)) + (insert text) + (string-match (, regexp) text))) + (if (, backward) (beginning-of-line) (end-of-line)) + (goto-char (if (, backward) (point-max) (point-min)))))) + + (defmacro gnus-summary-search-article-highlight-goto-x-face (opoint) + "Place point where X-Face image is displayed." + (if (featurep 'xemacs) + (` (let ((end (if (search-forward "\n\n" nil t) + (goto-char (1- (point))) + (point-min))) + extent) + (or (search-backward "\n\n" nil t) (goto-char (point-min))) + (unless (and (re-search-forward "^From:" end t) + (setq extent (extent-at (point))) + (extent-begin-glyph extent)) + (goto-char (, opoint))))) + (` (let ((end (if (search-forward "\n\n" nil t) + (goto-char (1- (point))) + (point-min))) + (start (or (search-backward "\n\n" nil t) (point-min)))) + (goto-char + (or (text-property-any start end 'x-face-image t);; x-face-e21 + (text-property-any start end 'x-face-mule-bitmap-image t) + (, opoint))))))) + + (defmacro gnus-summary-search-article-highlight-matched-text + (backward treated x-face) + "Highlight matched text in the function `gnus-summary-search-article'." + (` (let ((start (set-marker (make-marker) (match-beginning 0))) + (end (set-marker (make-marker) (match-end 0))) + (inhibit-read-only t) + buffer-read-only) + (unless treated + (let ((,@ + (let ((items (mapcar 'car gnus-treatment-function-alist))) + (mapcar + (lambda (item) (setq items (delq item items))) + '(gnus-treat-buttonize + gnus-treat-fill-article + gnus-treat-fill-long-lines + gnus-treat-emphasize + gnus-treat-highlight-headers + gnus-treat-highlight-citation + gnus-treat-highlight-signature + gnus-treat-overstrike + gnus-treat-display-xface + gnus-treat-buttonize-head + gnus-treat-decode-article-as-default-mime-charset)) + (static-if (featurep 'xemacs) + items + (cons '(x-face-mule-delete-x-face-field + (quote never)) + items)))) + (gnus-treat-display-xface + (when (, x-face) gnus-treat-display-xface))) + (gnus-article-prepare-mime-display))) + (goto-char (if (, backward) start end)) + (when (, x-face) + (gnus-summary-search-article-highlight-goto-x-face (point))) + (setq gnus-summary-search-article-matched-data + (list start end (buffer-substring start end))) + (unless (eq start end);; matched text has been deleted. :-< + (put-text-property start end 'face + (or (find-face 'isearch) + 'secondary-selection)))))) + ) + (defun gnus-summary-search-article (regexp &optional backward) "Search for an article containing REGEXP. Optional argument BACKWARD means do search for backward. @@ -7027,15 +7491,38 @@ Optional argument BACKWARD means do search for backward. (gnus-xmas-force-redisplay nil) ;Inhibit XEmacs redisplay. (gnus-use-trees nil) ;Inhibit updating tree buffer. (sum (current-buffer)) - (gnus-display-mime-function nil) (found nil) - point) + point treated) (gnus-save-hidden-threads - (gnus-summary-select-article) + (static-if (featurep 'xemacs) + (let ((gnus-inhibit-treatment t)) + (setq treated (eq 'old (gnus-summary-select-article))) + (when (and treated + (not (and (gnus-buffer-live-p gnus-article-buffer) + (window-live-p (get-buffer-window + gnus-article-buffer t))))) + (gnus-summary-select-article nil t) + (setq treated nil))) + (let ((gnus-inhibit-treatment t) + (x-face-mule-delete-x-face-field 'never)) + (setq treated (eq 'old (gnus-summary-select-article))) + (when (and treated + (not + (and (gnus-buffer-live-p gnus-article-buffer) + (window-live-p (get-buffer-window + gnus-article-buffer t)) + (or (not (string-match "^\\^X-Face:" regexp)) + (with-current-buffer gnus-article-buffer + gnus-summary-search-article-matched-data))))) + (gnus-summary-select-article nil t) + (setq treated nil)))) (set-buffer gnus-article-buffer) - (goto-char (window-point (get-buffer-window (current-buffer)))) - (when backward - (forward-line -1)) + (widen) + (if treated + (progn + (gnus-article-show-all-headers) + (gnus-summary-search-article-position-point regexp backward)) + (goto-char (if backward (point-max) (point-min)))) (while (not found) (gnus-message 7 "Searching article: %d..." (cdr gnus-article-current)) (if (if backward @@ -7043,15 +7530,16 @@ Optional argument BACKWARD means do search for backward. (re-search-forward regexp nil t)) ;; We found the regexp. (progn + (gnus-summary-search-article-highlight-matched-text + backward treated (string-match "^\\^X-Face:" regexp)) (setq found 'found) - (beginning-of-line) + (forward-line + (/ (- 2 (window-height + (get-buffer-window gnus-article-buffer t))) + 2)) (set-window-start (get-buffer-window (current-buffer)) (point)) - (forward-line 1) - (set-window-point - (get-buffer-window (current-buffer)) - (point)) (set-buffer sum) (setq point (point))) ;; We didn't find it, so we go to the next article. @@ -7066,7 +7554,9 @@ Optional argument BACKWARD means do search for backward. (unless (gnus-summary-article-sparse-p (gnus-summary-article-number)) (setq found nil) - (gnus-summary-select-article) + (let ((gnus-inhibit-treatment t)) + (gnus-summary-select-article)) + (setq treated nil) (set-buffer gnus-article-buffer) (widen) (goto-char (if backward (point-max) (point-min)))))))) @@ -7079,6 +7569,18 @@ Optional argument BACKWARD means do search for backward. (gnus-summary-position-point) t))) +(defun gnus-find-matching-articles (header regexp) + "Return a list of all articles that match REGEXP on HEADER. +This search includes all articles in the current group that Gnus has +fetched headers for, whether they are displayed or not." + (let ((articles nil) + (func `(lambda (h) (,(intern (concat "mail-header-" header)) h))) + (case-fold-search t)) + (dolist (header gnus-newsgroup-headers) + (when (string-match regexp (funcall func header)) + (push (mail-header-number header) articles))) + (nreverse articles))) + (defun gnus-summary-find-matching (header regexp &optional backward unread not-case-fold) "Return a list of all articles that match REGEXP on HEADER. @@ -7087,10 +7589,7 @@ BACKWARD is non-nil. If BACKWARD is `all', do all articles. If UNREAD is non-nil, only unread articles will be taken into consideration. If NOT-CASE-FOLD, case won't be folded in the comparisons." - (let ((data (if (eq backward 'all) gnus-newsgroup-data - (gnus-data-find-list - (gnus-summary-article-number) (gnus-data-list backward)))) - (case-fold-search (not not-case-fold)) + (let ((case-fold-search (not not-case-fold)) articles d func) (if (consp header) (if (eq (car header) 'extra) @@ -7102,14 +7601,17 @@ in the comparisons." (unless (fboundp (intern (concat "mail-header-" header))) (error "%s is not a valid header" header)) (setq func `(lambda (h) (,(intern (concat "mail-header-" header)) h)))) - (while data - (setq d (car data)) - (and (or (not unread) ; We want all articles... - (gnus-data-unread-p d)) ; Or just unreads. - (vectorp (gnus-data-header d)) ; It's not a pseudo. - (string-match regexp (funcall func (gnus-data-header d))) ; Match. - (push (gnus-data-number d) articles)) ; Success! - (setq data (cdr data))) + (dolist (d (if (eq backward 'all) + gnus-newsgroup-data + (gnus-data-find-list + (gnus-summary-article-number) + (gnus-data-list backward)))) + (when (and (or (not unread) ; We want all articles... + (gnus-data-unread-p d)) ; Or just unreads. + (vectorp (gnus-data-header d)) ; It's not a pseudo. + (string-match regexp + (funcall func (gnus-data-header d)))) ; Match. + (push (gnus-data-number d) articles))) ; Success! (nreverse articles))) (defun gnus-summary-execute-command (header regexp command &optional backward) @@ -7120,9 +7622,11 @@ article. If BACKWARD (the prefix) is non-nil, search backward instead." (list (let ((completion-ignore-case t)) (completing-read "Header name: " - (mapcar (lambda (string) (list string)) - '("Number" "Subject" "From" "Lines" "Date" - "Message-ID" "Xref" "References" "Body")) + (mapcar (lambda (header) (list (format "%s" header))) + (append + '("Number" "Subject" "From" "Lines" "Date" + "Message-ID" "Xref" "References" "Body") + gnus-extra-headers)) nil 'require-match)) (read-string "Regexp: ") (read-key-sequence "Command: ") @@ -7174,8 +7678,7 @@ If the optional first 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) - current-prefix-arg)) + (interactive (list (ps-print-preprint 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 @@ -7185,6 +7688,12 @@ to save in." (copy-to-buffer buffer (point-min) (point-max)) (set-buffer buffer) (gnus-article-delete-invisible-text) + (when (gnus-visual-p 'article-highlight 'highlight) + ;; Copy-to-buffer doesn't copy overlay. So redo + ;; highlight. + (let ((gnus-article-buffer buffer)) + (gnus-article-highlight-citation t) + (gnus-article-highlight-signature))) (let ((ps-left-header (list (concat "(" @@ -7198,24 +7707,47 @@ to save in." (mail-header-date gnus-current-headers) ")")))) (gnus-run-hooks 'gnus-ps-print-hook) (save-excursion - (ps-print-buffer-with-faces filename)))) - (kill-buffer buffer)))))) + (if window-system + (ps-spool-buffer-with-faces) + (ps-spool-buffer))))) + (kill-buffer buffer)))) + (gnus-summary-remove-process-mark article)) + (ps-despool filename)) (defun gnus-summary-show-article (&optional arg) "Force re-fetching of the current article. -If ARG (the prefix) is a number, show the article with the charset +If ARG (the prefix) is a number, show the article with the charset defined in `gnus-summary-show-article-charset-alist', or the charset inputed. -If ARG (the prefix) is non-nil and not a number, show the raw article +If ARG (the prefix) is non-nil and not a number, show the raw article without any article massaging functions being run." (interactive "P") - (cond + (cond ((numberp arg) - (let ((gnus-newsgroup-charset + (let ((gnus-newsgroup-charset (or (cdr (assq arg gnus-summary-show-article-charset-alist)) (read-coding-system "Charset: "))) (gnus-newsgroup-ignored-charsets 'gnus-all)) - (gnus-summary-select-article nil 'force))) + (gnus-summary-select-article nil 'force) + (let ((deps gnus-newsgroup-dependencies) + head header) + (save-excursion + (set-buffer gnus-original-article-buffer) + (save-restriction + (message-narrow-to-head) + (setq head (buffer-string))) + (with-temp-buffer + (insert (format "211 %d Article retrieved.\n" + (cdr gnus-article-current))) + (insert head) + (insert ".\n") + (let ((nntp-server-buffer (current-buffer))) + (setq header (car (gnus-get-newsgroup-headers deps t)))))) + (gnus-data-set-header + (gnus-data-find (cdr gnus-article-current)) + header) + (gnus-summary-update-article-line + (cdr gnus-article-current) header)))) ((not arg) ;; Select the article the normal way. (gnus-summary-select-article nil 'force)) @@ -7228,13 +7760,9 @@ without any article massaging functions being run." (let ((gnus-have-all-headers t) gnus-article-prepare-hook gnus-article-decode-hook - gnus-display-mime-function - gnus-break-pages) - ;; Destroy any MIME parts. - (when (gnus-buffer-live-p gnus-article-buffer) - (save-excursion - (set-buffer gnus-article-buffer) - (mm-destroy-parts gnus-article-mime-handles))) + gnus-break-pages + gnus-show-mime + (gnus-inhibit-treatment t)) (gnus-summary-select-article nil 'force)))) (gnus-summary-goto-subject gnus-current-article) (gnus-summary-position-point)) @@ -7266,7 +7794,7 @@ If ARG is a negative number, hide the unwanted header lines." (setq hidden (if (numberp arg) (>= arg 0) - (save-restriction + (save-restriction (article-narrow-to-head) (gnus-article-hidden-text-p 'headers)))) (goto-char (point-min)) @@ -7293,7 +7821,17 @@ If ARG is a negative number, hide the unwanted header lines." (defun gnus-summary-show-all-headers () "Make all header lines visible." (interactive) - (gnus-article-show-all-headers)) + (gnus-summary-toggle-header 1)) + +(defun gnus-summary-toggle-mime (&optional arg) + "Toggle MIME processing. +If ARG is a positive number, turn MIME processing on." + (interactive "P") + (setq gnus-show-mime + (if (null arg) + (not gnus-show-mime) + (> (prefix-numeric-value arg) 0))) + (gnus-summary-select-article t 'force)) (defun gnus-summary-caesar-message (&optional arg) "Caesar rotate the current article by 13. @@ -7364,6 +7902,9 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." (crosspost "Crosspost" "Crossposting"))) (copy-buf (save-excursion (nnheader-set-temp-buffer " *copy article*"))) + (default-marks gnus-article-mark-lists) + (no-expire-marks (delete '(expirable . expire) + (copy-sequence gnus-article-mark-lists))) art-group to-method new-xref article to-groups) (unless (assq action names) (error "Unknown action %s" action)) @@ -7473,7 +8014,9 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." (list (cdr art-group))))) ;; See whether the article is to be put in the cache. - (let ((marks gnus-article-mark-lists) + (let ((marks (if (gnus-group-auto-expirable-p to-group) + default-marks + no-expire-marks)) (to-article (cdr art-group))) ;; Enter the article into the cache in the new group, @@ -7481,11 +8024,15 @@ ACTION can be either `move' (the default), `crosspost' or `copy'." (when gnus-use-cache (gnus-cache-possibly-enter-article to-group to-article + (let ((header (copy-sequence + (gnus-summary-article-header article)))) + (mail-header-set-number header to-article) + header) (memq article gnus-newsgroup-marked) (memq article gnus-newsgroup-dormant) (memq article gnus-newsgroup-unreads))) - (when gnus-preserve-marks + (when gnus-preserve-marks ;; Copy any marks over to the new group. (when (and (equal to-group gnus-newsgroup-name) (not (memq article gnus-newsgroup-unreads))) @@ -7614,12 +8161,12 @@ latter case, they will be copied into the relevant groups." (gnus-summary-move-article n nil method) (gnus-summary-copy-article n nil method))) -(defun gnus-summary-import-article (file) +(defun gnus-summary-import-article (file &optional edit) "Import an arbitrary file into a mail newsgroup." - (interactive "fImport file: ") + (interactive "fImport file: \nP") (let ((group gnus-newsgroup-name) (now (current-time)) - atts lines) + atts lines group-art) (unless (gnus-check-backend-function 'request-accept-article group) (error "%s does not support article importing" group)) (or (file-readable-p file) @@ -7636,13 +8183,41 @@ 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: " (message-make-date (nth 5 atts)) - "\n" + "Date: " (message-make-date (nth 5 atts)) "\n" "Message-ID: " (message-make-message-id) "\n" "Lines: " (int-to-string lines) "\n" "Chars: " (int-to-string (nth 7 atts)) "\n\n")) - (gnus-request-accept-article group nil t) - (kill-buffer (current-buffer))))) + (setq group-art (gnus-request-accept-article group nil t)) + (kill-buffer (current-buffer))) + (setq gnus-newsgroup-active (gnus-activate-group group)) + (forward-line 1) + (gnus-summary-goto-article (cdr group-art) nil t) + (when edit + (gnus-summary-edit-article)))) + +(defun gnus-summary-create-article () + "Create an article in a mail newsgroup." + (interactive) + (let ((group gnus-newsgroup-name) + (now (current-time)) + group-art) + (unless (gnus-check-backend-function 'request-accept-article group) + (error "%s does not support article importing" group)) + (save-excursion + (set-buffer (gnus-get-buffer-create " *import file*")) + (erase-buffer) + (goto-char (point-min)) + ;; This doesn't look like an article, so we fudge some headers. + (insert "From: " (read-string "From: ") "\n" + "Subject: " (read-string "Subject: ") "\n" + "Date: " (message-make-date now) "\n" + "Message-ID: " (message-make-message-id) "\n") + (setq group-art (gnus-request-accept-article group nil t)) + (kill-buffer (current-buffer))) + (setq gnus-newsgroup-active (gnus-activate-group group)) + (forward-line 1) + (gnus-summary-goto-article (cdr group-art) nil t) + (gnus-summary-edit-article))) (defun gnus-summary-article-posted-p () "Say whether the current (mail) article is available from news as well. @@ -7677,6 +8252,9 @@ This will be the case if the article has both been mailed and posted." (expiry-wait (if now 'immediate (gnus-group-find-parameter gnus-newsgroup-name 'expiry-wait))) + (nnmail-expiry-target + (or (gnus-group-find-parameter gnus-newsgroup-name 'expiry-target) + nnmail-expiry-target)) es) (when expirable ;; There are expirable articles in this group, so we run them @@ -7692,19 +8270,19 @@ This will be the case if the article has both been mailed and posted." (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 - ;; really expired articles as nonexistent. - (unless (eq es expirable) ;If nothing was expired, we don't mark. - (let ((gnus-use-cache nil)) - (while expirable - (unless (memq (car expirable) es) - (when (gnus-data-find (car expirable)) - (gnus-summary-mark-article - (car expirable) gnus-canceled-mark))) - (setq expirable (cdr expirable))))) + expirable gnus-newsgroup-name))) + (unless total + (setq gnus-newsgroup-expirable es)) + ;; We go through the old list of expirable, and mark all + ;; really expired articles as nonexistent. + (unless (eq es expirable) ;If nothing was expired, we don't mark. + (let ((gnus-use-cache nil)) + (while expirable + (unless (memq (car expirable) es) + (when (gnus-data-find (car expirable)) + (gnus-summary-mark-article + (car expirable) gnus-canceled-mark))) + (setq expirable (cdr expirable)))))) (gnus-message 6 "Expiring articles...done"))))) (defun gnus-summary-expire-articles-now () @@ -7731,6 +8309,8 @@ delete these instead." (unless (gnus-check-backend-function 'request-expire-articles gnus-newsgroup-name) (error "The current newsgroup does not support article deletion")) + (unless (gnus-check-server (gnus-find-method-for-group gnus-newsgroup-name)) + (error "Couldn't open server")) ;; Compute the list of articles to delete. (let ((articles (sort (copy-sequence (gnus-summary-work-articles n)) '<)) not-deleted) @@ -7757,63 +8337,32 @@ delete these instead." (gnus-set-mode-line 'summary) not-deleted)) -(defun gnus-summary-edit-article (&optional arg) +(defun gnus-summary-edit-article (&optional force) "Edit the current article. This will have permanent effect only in mail groups. -If ARG is nil, edit the decoded articles. -If ARG is 1, edit the raw articles. -If ARG is 2, edit the raw articles even in read-only groups. -Otherwise, allow editing of articles even in read-only +If FORCE is non-nil, allow editing of articles even in read-only groups." (interactive "P") - (let (force raw) - (cond - ((null arg)) - ((eq arg 1) (setq raw t)) - ((eq arg 2) (setq raw t - force t)) - (t (setq force t))) - (if (and raw (not force) (equal gnus-newsgroup-name "nndraft:drafts")) - (error "Can't edit the raw article in group nndraft:drafts.")) - (save-excursion - (set-buffer gnus-summary-buffer) - (let ((mail-parse-charset gnus-newsgroup-charset) - (mail-parse-ignored-charsets gnus-newsgroup-ignored-charsets)) - (gnus-set-global-variables) - (when (and (not force) - (gnus-group-read-only-p)) - (error "The current newsgroup does not support article editing")) - (gnus-summary-show-article t) - (when (and (not raw) (gnus-buffer-live-p gnus-article-buffer)) - (with-current-buffer gnus-article-buffer - (mm-enable-multibyte))) - (if (equal gnus-newsgroup-name "nndraft:drafts") - (setq raw t)) - (gnus-article-edit-article - (if raw 'ignore - #'(lambda () - (let ((mbl mml-buffer-list)) - (setq mml-buffer-list nil) - (mime-to-mml) - (make-local-hook 'kill-buffer-hook) - (let ((mml-buffer-list mml-buffer-list)) - (setq mml-buffer-list mbl) - (make-local-variable 'mml-buffer-list)) - (add-hook 'kill-buffer-hook 'mml-destroy-buffers t t)))) - `(lambda (no-highlight) - (let ((mail-parse-charset ',gnus-newsgroup-charset) - (mail-parse-ignored-charsets - ',gnus-newsgroup-ignored-charsets)) - ,(if (not raw) '(progn - (mml-to-mime) - (mml-destroy-buffers) - (remove-hook 'kill-buffer-hook - 'mml-destroy-buffers t) - (kill-local-variable 'mml-buffer-list))) - (gnus-summary-edit-article-done - ,(or (mail-header-references gnus-current-headers) "") - ,(gnus-group-read-only-p) - ,gnus-summary-buffer no-highlight)))))))) + (save-excursion + (set-buffer gnus-summary-buffer) + (let ((mail-parse-charset gnus-newsgroup-charset) + (mail-parse-ignored-charsets gnus-newsgroup-ignored-charsets)) + (gnus-set-global-variables) + (when (and (not force) + (gnus-group-read-only-p)) + (error "The current newsgroup does not support article editing")) + (gnus-summary-show-article t) + (gnus-article-edit-article + 'ignore + `(lambda (no-highlight) + (let ((mail-parse-charset ',gnus-newsgroup-charset) + (message-options message-options) + (message-options-set-recipient) + (mail-parse-ignored-charsets + ',gnus-newsgroup-ignored-charsets)) + (gnus-summary-edit-article-done + ,(or (mail-header-references gnus-current-headers) "") + ,(gnus-group-read-only-p) ,gnus-summary-buffer no-highlight))))))) (defalias 'gnus-summary-edit-article-postpone 'gnus-article-edit-exit) @@ -7821,14 +8370,35 @@ groups." no-highlight) "Make edits to the current article permanent." (interactive) + (save-excursion + ;; The buffer restriction contains the entire article if it exists. + (when (article-goto-body) + (let ((lines (count-lines (point) (point-max))) + (length (- (point-max) (point))) + (case-fold-search t) + (body (copy-marker (point)))) + (goto-char (point-min)) + (when (re-search-forward "^content-length:[ \t]\\([0-9]+\\)" body t) + (delete-region (match-beginning 1) (match-end 1)) + (insert (number-to-string length))) + (goto-char (point-min)) + (when (re-search-forward + "^x-content-length:[ \t]\\([0-9]+\\)" body t) + (delete-region (match-beginning 1) (match-end 1)) + (insert (number-to-string length))) + (goto-char (point-min)) + (when (re-search-forward "^lines:[ \t]\\([0-9]+\\)" body t) + (delete-region (match-beginning 1) (match-end 1)) + (insert (number-to-string lines)))))) ;; Replace the article. (let ((buf (current-buffer))) (with-temp-buffer (insert-buffer-substring buf) + (if (and (not read-only) (not (gnus-request-replace-article (cdr gnus-article-current) (car gnus-article-current) - (current-buffer) t))) + (current-buffer) t))) (error "Couldn't replace article") ;; Update the summary buffer. (if (and references @@ -7987,28 +8557,31 @@ If optional argument UNMARK is negative, mark articles as unread instead." If N is negative, mark backward instead. If UNMARK is non-nil, remove the process mark instead. The difference between N and the actual number of articles marked is returned." - (interactive "p") - (let ((backward (< n 0)) - (n (abs n))) - (while (and - (> n 0) - (if unmark + (interactive "P") + (if (and (null n) (gnus-region-active-p)) + (gnus-uu-mark-region (region-beginning) (region-end) unmark) + (setq n (prefix-numeric-value n)) + (let ((backward (< n 0)) + (n (abs n))) + (while (and + (> n 0) + (if unmark (gnus-summary-remove-process-mark (gnus-summary-article-number)) - (gnus-summary-set-process-mark (gnus-summary-article-number))) - (zerop (gnus-summary-next-subject (if backward -1 1) nil t))) - (setq n (1- n))) - (when (/= 0 n) - (gnus-message 7 "No more articles")) - (gnus-summary-recenter) - (gnus-summary-position-point) - n)) + (gnus-summary-set-process-mark (gnus-summary-article-number))) + (zerop (gnus-summary-next-subject (if backward -1 1) nil t))) + (setq n (1- n))) + (when (/= 0 n) + (gnus-message 7 "No more articles")) + (gnus-summary-recenter) + (gnus-summary-position-point) + n))) (defun gnus-summary-unmark-as-processable (n) "Remove the process mark from the next N articles. If N is negative, unmark backward instead. The difference between N and the actual number of articles unmarked is returned." - (interactive "p") + (interactive "P") (gnus-summary-mark-as-processable n t)) (defun gnus-summary-unmark-all-processable () @@ -8019,6 +8592,20 @@ the actual number of articles unmarked is returned." (gnus-summary-remove-process-mark (car gnus-newsgroup-processable)))) (gnus-summary-position-point)) +(defun gnus-summary-add-mark (article type) + "Mark ARTICLE with a mark of TYPE." + (let ((vtype (car (assq type gnus-article-mark-lists))) + var) + (if (not vtype) + (error "No such mark type: %s" type) + (setq var (intern (format "gnus-newsgroup-%s" type))) + (set var (cons article (symbol-value var))) + (if (memq type '(processable cached replied forwarded saved)) + (gnus-summary-update-secondary-mark article) + ;;; !!! This is bobus. We should find out what primary + ;;; !!! mark we want to set. + (gnus-summary-update-mark gnus-del-mark 'unread))))) + (defun gnus-summary-mark-as-expirable (n) "Mark N articles forward as expirable. If N is negative, mark backward instead. The difference between N and @@ -8027,11 +8614,25 @@ the actual number of articles marked is returned." (gnus-summary-mark-forward n gnus-expirable-mark)) (defun gnus-summary-mark-article-as-replied (article) - "Mark ARTICLE replied and update the summary line." - (push article gnus-newsgroup-replied) - (let ((buffer-read-only nil)) - (when (gnus-summary-goto-subject article nil t) - (gnus-summary-update-secondary-mark article)))) + "Mark ARTICLE as replied to and update the summary line. +ARTICLE can also be a list of articles." + (interactive (list (gnus-summary-article-number))) + (let ((articles (if (listp article) article (list article)))) + (dolist (article articles) + (push article gnus-newsgroup-replied) + (let ((buffer-read-only nil)) + (when (gnus-summary-goto-subject article nil t) + (gnus-summary-update-secondary-mark article)))))) + +(defun gnus-summary-mark-article-as-forwarded (article) + "Mark ARTICLE as forwarded and update the summary line. +ARTICLE can also be a list of articles." + (let ((articles (if (listp article) article (list article)))) + (dolist (article articles) + (push article gnus-newsgroup-forwarded) + (let ((buffer-read-only nil)) + (when (gnus-summary-goto-subject article nil t) + (gnus-summary-update-secondary-mark article)))))) (defun gnus-summary-set-bookmark (article) "Set a bookmark in current article." @@ -8190,6 +8791,7 @@ Iff NO-EXPIRE, auto-expiry will be inhibited." (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)))) @@ -8236,6 +8838,7 @@ Iff NO-EXPIRE, auto-expiry will be inhibited." (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)))) @@ -8255,9 +8858,11 @@ Iff NO-EXPIRE, auto-expiry will be inhibited." gnus-cached-mark) ((memq article gnus-newsgroup-replied) gnus-replied-mark) + ((memq article gnus-newsgroup-forwarded) + gnus-forwarded-mark) ((memq article gnus-newsgroup-saved) gnus-saved-mark) - (t gnus-unread-mark)) + (t gnus-no-mark)) 'replied) (when (gnus-visual-p 'summary-highlight 'highlight) (gnus-run-hooks 'gnus-summary-update-hook)) @@ -8401,6 +9006,11 @@ The difference between N and the number of marks cleared is returned." (gnus-read-mark-p mark)) (gnus-summary-mark-article gnus-current-article gnus-read-mark)))) +(defun gnus-summary-mark-unread-as-ticked () + "Intended to be used by `gnus-summary-mark-article-hook'." + (when (memq gnus-current-article gnus-newsgroup-unreads) + (gnus-summary-mark-article gnus-current-article gnus-ticked-mark))) + (defun gnus-summary-mark-region-as-read (point mark all) "Mark all unread articles between point and mark as read. If given a prefix, mark all articles between point and mark as read, @@ -8474,8 +9084,8 @@ even ticked and dormant ones." (let ((scored gnus-newsgroup-scored) headers h) (while scored - (unless (gnus-summary-goto-subject (caar scored)) - (and (setq h (gnus-summary-article-header (caar scored))) + (unless (gnus-summary-article-header (caar scored)) + (and (setq h (gnus-number-to-header (caar scored))) (< (cdar scored) gnus-summary-expunge-below) (push h headers))) (setq scored (cdr scored))) @@ -8483,6 +9093,11 @@ even ticked and dormant ones." (when (not no-error) (error "No expunged articles hidden")) (goto-char (point-min)) + (push gnus-newsgroup-limit gnus-newsgroup-limits) + (setq gnus-newsgroup-limit (copy-sequence gnus-newsgroup-limit)) + (mapcar (lambda (x) (push (mail-header-number x) + gnus-newsgroup-limit)) + headers) (gnus-summary-prepare-unthreaded (nreverse headers)) (goto-char (point-min)) (gnus-summary-position-point) @@ -8550,7 +9165,8 @@ If ALL is non-nil, also mark ticked and dormant articles as read." (defun gnus-summary-catchup-and-exit (&optional all quietly) "Mark all unread articles in this group as read, then exit. -If prefix argument ALL is non-nil, all articles are marked as read." +If prefix argument ALL is non-nil, all articles are marked as read. +If QUIETLY is non-nil, no questions will be asked." (interactive "P") (when (gnus-summary-catchup all quietly nil 'fast) ;; Select next newsgroup or exit. @@ -8682,14 +9298,16 @@ is non-nil or the Subject: of both articles are the same." (unless (and message-id (not (equal message-id ""))) (error "No message-id in desired parent")) (gnus-with-article current-article - (goto-char (point-min)) - (if (re-search-forward "^References: " nil t) - (progn - (re-search-forward "^[^ \t]" nil t) - (forward-line -1) - (end-of-line) - (insert " " message-id)) - (insert "References: " message-id "\n"))) + (save-restriction + (goto-char (point-min)) + (message-narrow-to-head) + (if (re-search-forward "^References: " nil t) + (progn + (re-search-forward "^[^ \t]" nil t) + (forward-line -1) + (end-of-line) + (insert " " message-id)) + (insert "References: " message-id "\n")))) (set-buffer gnus-summary-buffer) (gnus-summary-unmark-all-processable) (gnus-summary-update-article current-article) @@ -8843,7 +9461,7 @@ taken." (defun gnus-summary-up-thread (n) "Go up thread N steps. -If N is negative, go up instead. +If N is negative, go down instead. Returns the difference between N and how many steps down that were taken." (interactive "p") @@ -8896,14 +9514,14 @@ Argument REVERSE means reverse order." (defun gnus-summary-sort-by-author (&optional reverse) "Sort the summary buffer by author name alphabetically. -If case-fold-search is non-nil, case of letters is ignored. +If `case-fold-search' is non-nil, case of letters is ignored. Argument REVERSE means reverse order." (interactive "P") (gnus-summary-sort 'author reverse)) (defun gnus-summary-sort-by-subject (&optional reverse) "Sort the summary buffer by subject alphabetically. `Re:'s are ignored. -If case-fold-search is non-nil, case of letters is ignored. +If `case-fold-search' is non-nil, case of letters is ignored. Argument REVERSE means reverse order." (interactive "P") (gnus-summary-sort 'subject reverse)) @@ -8930,7 +9548,19 @@ Argument REVERSE means reverse order." "Sort the summary buffer by article length. Argument REVERSE means reverse order." (interactive "P") - (gnus-summary-sort 'chars reverse)) + (gnus-summary-sort 'chars reverse)) + +(defun gnus-summary-sort-by-original (&optional reverse) + "Sort the summary buffer using the default sorting method. +Argument REVERSE means reverse order." + (interactive "P") + (let* ((buffer-read-only) + (gnus-summary-prepare-hook nil)) + ;; We do the sorting by regenerating the threads. + (gnus-summary-prepare) + ;; Hide subthreads if needed. + (when (and gnus-show-threads gnus-thread-hide-subtree) + (gnus-summary-hide-all-threads)))) (defun gnus-summary-sort (predicate reverse) "Sort summary buffer by PREDICATE. REVERSE means reverse order." @@ -8941,6 +9571,8 @@ Argument REVERSE means reverse order." thread `(lambda (t1 t2) (,thread t2 t1)))) + (gnus-sort-gathered-threads-function + gnus-thread-sort-functions) (gnus-article-sort-functions (if (not reverse) article @@ -8999,6 +9631,7 @@ If N is a negative number, pipe the N previous articles. If N is nil and any articles have been marked with the process mark, pipe those articles instead." (interactive "P") + (require 'gnus-art) (let ((gnus-default-article-saver 'gnus-summary-save-in-pipe)) (gnus-summary-save-article arg t)) (gnus-configure-windows 'pipe)) @@ -9010,6 +9643,7 @@ If N is a negative number, save the N previous articles. If N is nil and any articles have been marked with the process mark, save those articles instead." (interactive "P") + (require 'gnus-art) (let ((gnus-default-article-saver 'gnus-summary-save-in-mail)) (gnus-summary-save-article arg))) @@ -9020,6 +9654,7 @@ If N is a negative number, save the N previous articles. If N is nil and any articles have been marked with the process mark, save those articles instead." (interactive "P") + (require 'gnus-art) (let ((gnus-default-article-saver 'gnus-summary-save-in-rmail)) (gnus-summary-save-article arg))) @@ -9030,6 +9665,7 @@ If N is a negative number, save the N previous articles. If N is nil and any articles have been marked with the process mark, save those articles instead." (interactive "P") + (require 'gnus-art) (let ((gnus-default-article-saver 'gnus-summary-save-in-file)) (gnus-summary-save-article arg))) @@ -9040,6 +9676,7 @@ If N is a negative number, save the N previous articles. If N is nil and any articles have been marked with the process mark, save those articles instead." (interactive "P") + (require 'gnus-art) (let ((gnus-default-article-saver 'gnus-summary-write-to-file)) (gnus-summary-save-article arg))) @@ -9050,6 +9687,7 @@ If N is a negative number, save the N previous articles. If N is nil and any articles have been marked with the process mark, save those articles instead." (interactive "P") + (require 'gnus-art) (let ((gnus-default-article-saver 'gnus-summary-save-body-in-file)) (gnus-summary-save-article arg))) @@ -9074,7 +9712,7 @@ save those articles instead." (set-buffer gnus-original-article-buffer) (save-restriction (nnheader-narrow-to-headers) - (while methods + (while (and methods (not split-name)) (goto-char (point-min)) (setq method (pop methods)) (setq match (car method)) @@ -9093,7 +9731,7 @@ save those articles instead." (save-restriction (widen) (setq result (eval match))))) - (setq split-name (append (cdr method) split-name)) + (setq split-name (cdr method)) (cond ((stringp result) (push (expand-file-name result gnus-article-save-directory) @@ -9162,8 +9800,14 @@ save those articles instead." "Save parts matching TYPE to DIR. If REVERSE, save parts that do not match TYPE." (interactive - (list (read-string "Save parts of type: " "image/.*") - (read-file-name "Save to directory: " nil nil t) + (list (read-string "Save parts of type: " + (or (car gnus-summary-save-parts-type-history) + gnus-summary-save-parts-default-mime) + 'gnus-summary-save-parts-type-history) + (setq gnus-summary-save-parts-last-directory + (read-file-name "Save to directory: " + gnus-summary-save-parts-last-directory + nil t)) current-prefix-arg)) (gnus-summary-iterate n (let ((gnus-display-mime-function nil) @@ -9171,10 +9815,12 @@ If REVERSE, save parts that do not match TYPE." (gnus-summary-select-article)) (save-excursion (set-buffer gnus-article-buffer) - (let ((handles (or (mm-dissect-buffer) (mm-uu-dissect)))) + (let ((handles (or gnus-article-mime-handles + (mm-dissect-buffer) (mm-uu-dissect)))) (when handles (gnus-summary-save-parts-1 type dir handles reverse) - (mm-destroy-parts handles)))))) + (unless gnus-article-mime-handles ;; Don't destroy this case. + (mm-destroy-parts handles))))))) (defun gnus-summary-save-parts-1 (type dir handle reverse) (if (stringp (car handle)) @@ -9188,7 +9834,9 @@ If REVERSE, save parts that do not match TYPE." (or (mail-content-type-get (mm-handle-disposition handle) 'filename) - (concat gnus-newsgroup-name "." gnus-current-article))) + (concat gnus-newsgroup-name + "." (number-to-string + (cdr gnus-article-current))))) dir))) (unless (file-exists-p file) (mm-save-part-to-file handle file)))))) @@ -9228,7 +9876,7 @@ If REVERSE, save parts that do not match TYPE." (lambda (f) (if (equal f " ") f - (mm-quote-arg f))) + (gnus-quote-arg-for-sh-or-csh f))) files " "))))) (setq ps (cdr ps))))) (if (and gnus-view-pseudos (not not-view)) @@ -9382,8 +10030,8 @@ If REVERSE, save parts that do not match TYPE." ;;; (defun gnus-highlight-selected-summary () + "Highlight selected article in summary buffer." ;; Added by Per Abrahamsen . - ;; Highlight selected article in summary buffer (when gnus-summary-selected-face (save-excursion (let* ((beg (progn (beginning-of-line) (point))) @@ -9478,23 +10126,32 @@ If REVERSE, save parts that do not match TYPE." (if compute read (save-excursion - (set-buffer gnus-group-buffer) - (gnus-undo-register - `(progn - (gnus-info-set-marks ',info ',(gnus-info-marks info) t) - (gnus-info-set-read ',info ',(gnus-info-read info)) - (gnus-get-unread-articles-in-group ',info (gnus-active ,group)) - (gnus-group-update-group ,group t)))) - ;; Propagate the read marks to the backend. - (if (gnus-check-backend-function 'request-set-mark group) - (let ((del (gnus-remove-from-range (gnus-info-read info) read)) - (add (gnus-remove-from-range read (gnus-info-read info)))) - (when (or add del) - (unless (gnus-check-group group) - (error "Can't open server for %s" group)) - (gnus-request-set-mark - group (delq nil (list (if add (list add 'add '(read))) - (if del (list del 'del '(read))))))))) + (let (setmarkundo) + ;; Propagate the read marks to the backend. + (when (gnus-check-backend-function 'request-set-mark group) + (let ((del (gnus-remove-from-range (gnus-info-read info) read)) + (add (gnus-remove-from-range read (gnus-info-read info)))) + (when (or add del) + (unless (gnus-check-group group) + (error "Can't open server for %s" group)) + (gnus-request-set-mark + group (delq nil (list (if add (list add 'add '(read))) + (if del (list del 'del '(read)))))) + (setq setmarkundo + `(gnus-request-set-mark + ,group + ',(delq nil (list + (if del (list del 'add '(read))) + (if add (list add 'del '(read)))))))))) + (set-buffer gnus-group-buffer) + (gnus-undo-register + `(progn + (gnus-info-set-marks ',info ',(gnus-info-marks info) t) + (gnus-info-set-read ',info ',(gnus-info-read info)) + (gnus-get-unread-articles-in-group ',info + (gnus-active ,group)) + (gnus-group-update-group ,group t) + ,setmarkundo)))) ;; Enter this list into the group info. (gnus-info-set-read info read) ;; Set the number of unread articles in gnus-newsrc-hashtb. @@ -9503,25 +10160,24 @@ If REVERSE, save parts that do not match TYPE." (defun gnus-offer-save-summaries () "Offer to save all active summary buffers." - (save-excursion - (let ((buflist (buffer-list)) - buffers bufname) - ;; Go through all buffers and find all summaries. - (while buflist - (and (setq bufname (buffer-name (car buflist))) - (string-match "Summary" bufname) - (save-excursion - (set-buffer bufname) - ;; We check that this is, indeed, a summary buffer. - (and (eq major-mode 'gnus-summary-mode) - ;; Also make sure this isn't bogus. - gnus-newsgroup-prepared - ;; Also make sure that this isn't a dead summary buffer. - (not gnus-dead-summary-mode))) - (push bufname buffers)) - (setq buflist (cdr buflist))) - ;; Go through all these summary buffers and offer to save them. - (when buffers + (let (buffers) + ;; Go through all buffers and find all summaries. + (dolist (buffer (buffer-list)) + (when (and (setq buffer (buffer-name buffer)) + (string-match "Summary" buffer) + (save-excursion + (set-buffer buffer) + ;; We check that this is, indeed, a summary buffer. + (and (eq major-mode 'gnus-summary-mode) + ;; Also make sure this isn't bogus. + gnus-newsgroup-prepared + ;; Also make sure that this isn't a + ;; dead summary buffer. + (not gnus-dead-summary-mode)))) + (push buffer buffers))) + ;; Go through all these summary buffers and offer to save them. + (when buffers + (save-excursion (map-y-or-n-p "Update summary buffer %s? " (lambda (buf) @@ -9529,41 +10185,135 @@ If REVERSE, save parts that do not match TYPE." (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-article-this-buffer 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) + )) + + +;;; @ for message/rfc822 +;;; + +(defun gnus-mime-extract-message/rfc822 (entity situation) + (let (group article num cwin swin cur) + (with-temp-buffer + (mime-insert-entity-content entity) + (setq group (or (cdr (assq 'group situation)) + (completing-read "Group: " + gnus-active-hashtb + nil + (gnus-read-active-file-p) + gnus-newsgroup-name)) + article (gnus-request-accept-article group))) + (when (and (consp article) + (numberp (setq article (cdr article)))) + (setq num (1+ (or (cdr (assq 'number situation)) 0)) + cwin (get-buffer-window (current-buffer) t)) + (save-window-excursion + (if (setq swin (get-buffer-window gnus-summary-buffer t)) + (select-window swin) + (set-buffer gnus-summary-buffer)) + (setq cur gnus-current-article) + (forward-line num) + (let (gnus-show-threads) + (gnus-summary-goto-subject article t)) + (gnus-summary-clear-mark-forward 1) + (gnus-summary-goto-subject cur)) + (when (and cwin (window-frame cwin)) + (select-frame (window-frame cwin))) + (when (boundp 'mime-acting-situation-to-override) + (set-alist 'mime-acting-situation-to-override + 'group + group) + (set-alist 'mime-acting-situation-to-override + 'after-method + `(progn + (save-current-buffer + (set-buffer gnus-group-buffer) + (gnus-activate-group ,group)) + (gnus-summary-goto-article ,cur + gnus-show-all-headers))) + (set-alist 'mime-acting-situation-to-override + 'number num))))) + +(mime-add-condition + 'action '((type . message)(subtype . rfc822) + (major-mode . gnus-original-article-mode) + (method . gnus-mime-extract-message/rfc822) + (mode . "extract") + )) + +(mime-add-condition + 'action '((type . message)(subtype . news) + (major-mode . gnus-original-article-mode) + (method . gnus-mime-extract-message/rfc822) + (mode . "extract") + )) + +(defun gnus-mime-extract-multipart (entity situation) + (let ((children (mime-entity-children entity)) + mime-acting-situation-to-override + f) + (while children + (mime-play-entity (car children) + (cons (assq 'mode situation) + mime-acting-situation-to-override)) + (setq children (cdr children))) + (if (setq f (cdr (assq 'after-method + mime-acting-situation-to-override))) + (eval f) + ))) + +(mime-add-condition + 'action '((type . multipart) + (method . gnus-mime-extract-multipart) + (mode . "extract") + ) + 'with-default) + + +;;; @ end +;;; + (defun gnus-summary-setup-default-charset () "Setup newsgroup default charset." (if (equal gnus-newsgroup-name "nndraft:drafts") (setq gnus-newsgroup-charset nil) - (let* ((name (and gnus-newsgroup-name - (gnus-group-real-name gnus-newsgroup-name))) - (ignored-charsets + (let* ((ignored-charsets (or gnus-newsgroup-ephemeral-ignored-charsets (append (and gnus-newsgroup-name - (or (gnus-group-find-parameter gnus-newsgroup-name - 'ignored-charsets t) - (let ((alist gnus-group-ignored-charsets-alist) - elem (charsets nil)) - (while (setq elem (pop alist)) - (when (and name - (string-match (car elem) name)) - (setq alist nil - charsets (cdr elem)))) - charsets))) + (gnus-parameter-ignored-charsets gnus-newsgroup-name)) gnus-newsgroup-ignored-charsets)))) (setq gnus-newsgroup-charset (or gnus-newsgroup-ephemeral-charset (and gnus-newsgroup-name - (or (gnus-group-find-parameter gnus-newsgroup-name 'charset) - (let ((alist gnus-group-charset-alist) - elem charset) - (while (setq elem (pop alist)) - (when (and name - (string-match (car elem) name)) - (setq alist nil - charset (cadr elem)))) - charset))) + (gnus-parameter-charset gnus-newsgroup-name)) gnus-default-charset)) - (set (make-local-variable 'gnus-newsgroup-ignored-charsets) + (set (make-local-variable 'gnus-newsgroup-ignored-charsets) ignored-charsets)))) ;;; @@ -9585,17 +10335,17 @@ treated as multipart/mixed." (interactive (list (gnus-summary-article-number))) (gnus-with-article article (message-narrow-to-head) + (message-remove-header "Mime-Version") (goto-char (point-max)) + (insert "Mime-Version: 1.0\n") (widen) (when (search-forward "\n--" nil t) (let ((separator (buffer-substring (point) (gnus-point-at-eol)))) (message-narrow-to-head) - (message-remove-header "Mime-Version") (message-remove-header "Content-Type") (goto-char (point-max)) (insert (format "Content-Type: multipart/mixed; boundary=\"%s\"\n" separator)) - (insert "Mime-Version: 1.0\n") (widen)))) (let (gnus-mark-article-hook) (gnus-summary-select-article t t nil article))) @@ -9611,6 +10361,104 @@ treated as multipart/mixed." (gnus-summary-show-article))) ;;; +;;; Intelli-mouse commmands +;;; + +(defun gnus-wheel-summary-scroll (event) + (interactive "e") + (let ((amount (if (memq 'shift (event-modifiers event)) + (car gnus-wheel-scroll-amount) + (cdr gnus-wheel-scroll-amount))) + (direction (- (* (static-if (featurep 'xemacs) + (event-button event) + (cond ((eq 'mouse-4 (event-basic-type event)) + 4) + ((eq 'mouse-5 (event-basic-type event)) + 5))) + 2) 9)) + edge) + (gnus-summary-scroll-up (* amount direction)) + (when (gnus-eval-in-buffer-window gnus-article-buffer + (save-restriction + (widen) + (and (if (< 0 direction) + (gnus-article-next-page 0) + (gnus-article-prev-page 0) + (bobp)) + (if (setq edge (get-text-property + (point-min) 'gnus-wheel-edge)) + (setq edge (* edge direction)) + (setq edge -1)) + (or (plusp edge) + (let ((buffer-read-only nil) + (inhibit-read-only t)) + (put-text-property (point-min) (point-max) + 'gnus-wheel-edge direction) + nil)) + (or (> edge gnus-wheel-edge-resistance) + (let ((buffer-read-only nil) + (inhibit-read-only t)) + (put-text-property (point-min) (point-max) + 'gnus-wheel-edge + (* (1+ edge) direction)) + nil)) + (eq last-command 'gnus-wheel-summary-scroll)))) + (gnus-summary-next-article nil nil (minusp direction))))) + +(defun gnus-wheel-install () + "Enable mouse wheel support on summary window." + (when gnus-use-wheel + (let ((keys + '([(mouse-4)] [(shift mouse-4)] [(mouse-5)] [(shift mouse-5)]))) + (dolist (key keys) + (define-key gnus-summary-mode-map key + 'gnus-wheel-summary-scroll))))) + +(add-hook 'gnus-summary-mode-hook 'gnus-wheel-install) + +;;; +;;; Traditional PGP commmands +;;; + +(defun gnus-summary-decrypt-article (&optional force) + "Decrypt the current article in traditional PGP way. +This will have permanent effect only in mail groups. +If FORCE is non-nil, allow editing of articles even in read-only +groups." + (interactive "P") + (gnus-summary-select-article t) + (gnus-eval-in-buffer-window gnus-article-buffer + (save-excursion + (save-restriction + (widen) + (goto-char (point-min)) + (unless (re-search-forward (car pgg-armor-header-lines) nil t) + (error "Not a traditional PGP message!")) + (let ((armor-start (match-beginning 0))) + (if (and (pgg-decrypt-region armor-start (point-max)) + (or force (not (gnus-group-read-only-p)))) + (let ((inhibit-read-only t) + buffer-read-only) + (delete-region armor-start + (progn + (re-search-forward "^-+END PGP" nil t) + (beginning-of-line 2) + (point))) + (insert-buffer-substring pgg-output-buffer)))))))) + +(defun gnus-summary-verify-article () + "Verify the current article in traditional PGP way." + (interactive) + (save-excursion + (set-buffer gnus-original-article-buffer) + (goto-char (point-min)) + (unless (re-search-forward "^-+BEGIN PGP SIGNED MESSAGE" nil t) + (error "Not a traditional PGP message!")) + (re-search-forward "^-+END PGP" nil t) + (beginning-of-line 2) + (call-interactively (function pgg-verify-region)))) + +;;; ;;; Generic summary marking commands ;;; @@ -9642,8 +10490,8 @@ treated as multipart/mixed." mark (car lway) lway name))) (setq func (eval func)) (define-key map (nth 4 lway) func))))) - -(defun gnus-summary-make-marking-command-1 (mark way lway name) + +(defun gnus-summary-make-marking-command-1 (mark way lway name) `(defun ,(intern (format "gnus-summary-put-mark-as-%s%s" name (if (eq way 'nomove) @@ -9656,10 +10504,10 @@ If N, the prefix, then repeat N times. If N is negative, move in reverse order. The difference between N and the actual number of articles marked is returned." - name (cadr lway)) + name (car (cdr lway))) (interactive "p") (gnus-summary-generic-mark n ,mark ',(nth 2 lway) ,(nth 3 lway)))) - + (defun gnus-summary-generic-mark (n mark move unread) "Mark N articles with MARK." (unless (eq major-mode 'gnus-summary-mode) @@ -9686,6 +10534,104 @@ returned." (gnus-set-mode-line 'summary) n)) +(defun gnus-summary-insert-articles (articles) + (when (setq articles + (gnus-set-difference articles + (mapcar (lambda (h) (mail-header-number h)) + gnus-newsgroup-headers))) + (setq gnus-newsgroup-headers + (merge 'list + gnus-newsgroup-headers + (gnus-fetch-headers articles) + 'gnus-article-sort-by-number)) + ;; Suppress duplicates? + (when gnus-suppress-duplicates + (gnus-dup-suppress-articles)) + + ;; We might want to build some more threads first. + (when (and gnus-fetch-old-headers + (eq gnus-headers-retrieved-by 'nov)) + (if (eq gnus-fetch-old-headers 'invisible) + (gnus-build-all-threads) + (gnus-build-old-threads))) + ;; Let the Gnus agent mark articles as read. + (when gnus-agent + (gnus-agent-get-undownloaded-list)) + ;; Remove list identifiers from subject + (when gnus-list-identifiers + (gnus-summary-remove-list-identifiers)) + ;; First and last article in this newsgroup. + (when gnus-newsgroup-headers + (setq gnus-newsgroup-begin + (mail-header-number (car gnus-newsgroup-headers)) + gnus-newsgroup-end + (mail-header-number + (gnus-last-element gnus-newsgroup-headers)))) + (when gnus-use-scoring + (gnus-possibly-score-headers)))) + +(defun gnus-summary-insert-old-articles (&optional all) + "Insert all old articles in this group. +If ALL is non-nil, already read articles become readable. +If ALL is a number, fetch this number of articles." + (interactive "P") + (prog1 + (let ((old (mapcar 'car gnus-newsgroup-data)) + (i (car gnus-newsgroup-active)) + older len) + (while (<= i (cdr gnus-newsgroup-active)) + (or (memq i old) (push i older)) + (incf i)) + (setq len (length older)) + (cond + ((null older) nil) + ((numberp all) + (if (< all len) + (setq older (subseq older 0 all)))) + (all nil) + (t + (if (and (numberp gnus-large-newsgroup) + (> len gnus-large-newsgroup)) + (let ((input + (read-string + (format + "How many articles from %s (default %d): " + (gnus-limit-string + (gnus-group-decoded-name gnus-newsgroup-name) 35) + len)))) + (unless (string-match "^[ \t]*$" input) + (setq all (string-to-number input)) + (if (< all len) + (setq older (subseq older 0 all)))))))) + (if (not older) + (message "No old news.") + (gnus-summary-insert-articles older) + (gnus-summary-limit (gnus-union older old)))) + (gnus-summary-position-point))) + +(defun gnus-summary-insert-new-articles () + "Insert all new articles in this group." + (interactive) + (prog1 + (let ((old (mapcar 'car gnus-newsgroup-data)) + (old-active gnus-newsgroup-active) + (nnmail-fetched-sources (list t)) + i new) + (setq gnus-newsgroup-active + (gnus-activate-group gnus-newsgroup-name 'scan)) + (setq i (1+ (cdr old-active))) + (while (<= i (cdr gnus-newsgroup-active)) + (push i new) + (incf i)) + (if (not new) + (message "No gnus is bad news.") + (setq new (nreverse new)) + (gnus-summary-insert-articles new) + (setq gnus-newsgroup-unreads + (append gnus-newsgroup-unreads new)) + (gnus-summary-limit (gnus-union old new)))) + (gnus-summary-position-point))) + (gnus-summary-make-all-marking-commands) (gnus-ems-redefine)