X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fgnus-sum.el;h=e65f0793b212d23e1a0d05f6473db684c087e75d;hb=d5c76a088ce7de15a4e41960dcd80d0f7eff31eb;hp=d4f8d5ca44606f3e6439cb60b08fc75ed8d3641b;hpb=ed5859e1e7c85dee6841ff01b44bdd132a265de9;p=elisp%2Fgnus.git- diff --git a/lisp/gnus-sum.el b/lisp/gnus-sum.el index d4f8d5c..e65f079 100644 --- a/lisp/gnus-sum.el +++ b/lisp/gnus-sum.el @@ -1,5 +1,6 @@ ;;; gnus-sum.el --- summary mode commands for Semi-gnus -;; Copyright (C) 1996,97,98,99 Free Software Foundation, Inc. +;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001 +;; Free Software Foundation, Inc. ;; Author: Lars Magne Ingebrigtsen ;; MORIOKA Tomohiko @@ -28,6 +29,7 @@ ;;; Code: (eval-when-compile (require 'cl)) +(eval-when-compile (require 'gnus-clfns)) (require 'gnus) (require 'gnus-group) @@ -36,20 +38,26 @@ (require 'gnus-int) (require 'gnus-undo) (require 'gnus-util) +;; Recursive :-(. +;; (require 'gnus-art) +(require 'nnoo) (require 'mime-view) (eval-when-compile (require 'mime-play) - ;; Avoid byte-compile warnings. - (defvar gnus-article-decoded-p) - (defvar gnus-decode-encoded-word-function) - ) + (require 'static)) (eval-and-compile - (autoload 'gnus-cache-articles-in-group "gnus-cache")) + (autoload 'gnus-cache-articles-in-group "gnus-cache") + (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. @@ -182,10 +190,15 @@ This variable will only be used if the value of :type 'string) (defcustom gnus-summary-goto-unread t - "*If t, marking commands will go to the next unread article. -If `never', commands that usually go to the next unread article, will -go to the next article, whether it is read or not. -If nil, only the marking commands will go to the next (un)read article." + "*If t, many commands will go to the next unread article. +This applies to marking commands as well as other commands that +\"naturally\" select the next article, like, for instance, `SPC' at +the end of an article. + +If nil, the marking commands do NOT go to the next unread article +(they go to the next article instead). If `never', commands that +usually go to the next unread article, will go to the next article, +whether it is read or not." :group 'gnus-summary-marks :link '(custom-manual "(gnus)Setting Marks") :type '(choice (const :tag "off" nil) @@ -285,6 +298,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 @@ -360,13 +381,15 @@ The articles will simply be fed to the function given by (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) @@ -402,7 +425,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) @@ -426,6 +449,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 @@ -436,6 +464,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 @@ -481,7 +514,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) @@ -501,11 +534,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) @@ -563,6 +598,16 @@ with some simple extensions: :group 'gnus-summary-format :type 'string) +(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) + (regexp :value ".*") + (repeat :value (".*") regexp))) + (defcustom gnus-summary-mark-below 0 "*Mark all articles with a score below this variable as read. This variable is local to each summary buffer and usually set by the @@ -572,7 +617,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) @@ -585,16 +645,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) @@ -635,9 +701,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 @@ -705,7 +779,8 @@ is not run if `gnus-visual' is nil." :type 'hook) (defcustom gnus-exit-group-hook nil - "*A hook called when exiting (not quitting) summary mode." + "*A hook called when exiting summary mode. +This hook is not called from the non-updating exit commands like `Q'." :group 'gnus-various :type 'hook) @@ -766,6 +841,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 @@ -804,61 +882,136 @@ 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 + (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) - ("^relcom\\>" koi8-r) - ("^\\(cz\\|hun\\|pl\\|sk\\|hr\\)\\>" iso-8859-2) - ("^israel\\>" iso-8859-1) - ("^han\\>" euc-kr) - ("^\\(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) +(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 '(choice (const nil) function) + :group 'gnus-summary) + +(defcustom gnus-orphan-score nil + "*All orphans get this score added. Set in the score file." + :group 'gnus-score-default + :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) + + ;;; 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) @@ -869,6 +1022,14 @@ This variable uses the same syntax as `gnus-emphasis-alist'." (defvar gnus-thread-indent-array nil) (defvar gnus-thread-indent-array-level gnus-thread-indent-level) +(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) @@ -892,9 +1053,9 @@ This variable uses the same syntax as `gnus-emphasis-alist'." (?s gnus-tmp-subject-or-nil ?s) (?n gnus-tmp-name ?s) (?A (std11-address-string - (car (mime-read-field 'From gnus-tmp-header))) ?s) + (car (mime-entity-read-field gnus-tmp-header 'From))) ?s) (?a (or (std11-full-name-string - (car (mime-read-field 'From gnus-tmp-header))) + (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) @@ -904,7 +1065,7 @@ This variable uses the same syntax as `gnus-emphasis-alist'." (?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) @@ -926,9 +1087,9 @@ This variable uses the same syntax as `gnus-emphasis-alist'." ?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) @@ -956,6 +1117,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.") @@ -1001,6 +1167,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.") @@ -1025,6 +1194,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.") @@ -1048,6 +1220,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 @@ -1056,7 +1230,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 @@ -1071,6 +1246,7 @@ variable (string, integer, character, etc).") gnus-score-alist gnus-current-score-file (gnus-summary-expunge-below . global) (gnus-summary-mark-below . global) + (gnus-orphan-score . global) gnus-newsgroup-active gnus-scores-exclude-files gnus-newsgroup-history gnus-newsgroup-ancient gnus-newsgroup-sparse gnus-newsgroup-process-stack @@ -1080,16 +1256,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) +(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) @@ -1106,7 +1286,7 @@ variable (string, integer, character, etc).") (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)) @@ -1134,7 +1314,7 @@ If RE-ONLY is non-nil, strip leading `Re:'s only." (defsubst gnus-simplify-buffer-fuzzy-step (regexp &optional newtext) (goto-char (point-min)) (while (re-search-forward regexp nil t) - (replace-match (or newtext "")))) + (replace-match (or newtext "")))) (defun gnus-simplify-buffer-fuzzy () "Simplify string in the buffer fuzzily. @@ -1142,7 +1322,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" " ") @@ -1219,6 +1399,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 @@ -1266,6 +1448,8 @@ increase the score of each group you read." "\M-\C-h" gnus-summary-hide-thread "\M-\C-f" gnus-summary-next-thread "\M-\C-b" gnus-summary-prev-thread + [(meta down)] gnus-summary-next-thread + [(meta up)] gnus-summary-prev-thread "\M-\C-u" gnus-summary-up-thread "\M-\C-d" gnus-summary-down-thread "&" gnus-summary-execute-command @@ -1281,6 +1465,7 @@ 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 @@ -1316,7 +1501,7 @@ increase the score of each group you read." "\C-d" gnus-summary-enter-digest-group "\M-\C-d" gnus-summary-read-document "\M-\C-e" gnus-summary-edit-parameters - "\M-\C-g" gnus-summary-customize-parameters + "\M-\C-a" gnus-summary-customize-parameters "\C-c\C-b" gnus-bug "*" gnus-cache-enter-article "\M-*" gnus-cache-remove-article @@ -1375,10 +1560,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 @@ -1423,6 +1610,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 @@ -1452,6 +1640,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) @@ -1463,14 +1652,17 @@ increase the score of each group you read." "Q" gnus-article-fill-long-lines "C" gnus-article-capitalize-sentences "c" gnus-article-remove-cr + "Z" gnus-article-decode-HZ "f" gnus-article-display-x-face "l" gnus-summary-stop-page-breaking "r" gnus-summary-caesar-message "t" gnus-article-toggle-headers "v" gnus-summary-verbose-headers "m" gnus-summary-toggle-mime - "H" gnus-article-strip-headers-in-body - "d" gnus-article-treat-dumbquotes) + "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 @@ -1479,6 +1671,7 @@ increase the score of each group you read." "s" gnus-article-hide-signature "c" gnus-article-hide-citation "C" gnus-article-hide-citation-in-followups + "l" gnus-article-hide-list-identifiers "p" gnus-article-hide-pgp "B" gnus-article-strip-banner "P" gnus-article-hide-pem @@ -1494,6 +1687,7 @@ increase the score of each group you read." "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 @@ -1506,7 +1700,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 @@ -1529,6 +1724,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) @@ -1549,10 +1745,13 @@ 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) - ) + "|" gnus-article-pipe-part)) + +(defvar gnus-article-post-menu nil) (defun gnus-summary-make-menu-bar () (gnus-turn-off-edit-menu 'summary) @@ -1565,7 +1764,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) @@ -1590,11 +1788,12 @@ 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-toggle-headers t] ["Signature" gnus-article-hide-signature t] ["Citation" gnus-article-hide-citation t] + ["List identifiers" gnus-article-hide-list-identifiers t] ["PGP" gnus-article-hide-pgp t] ["Banner" gnus-article-strip-banner t] ["Boring headers" gnus-article-hide-boring-headers t]) @@ -1618,7 +1817,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] @@ -1627,17 +1828,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] - ["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]) + ["Toggle header" gnus-summary-toggle-header 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] @@ -1656,6 +1866,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))] @@ -1668,7 +1879,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] @@ -1688,14 +1901,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 "" @@ -1713,29 +1933,40 @@ increase the score of each group you read." ["Mark thread as read" gnus-summary-kill-thread t] ["Lower thread score" gnus-summary-lower-thread t] ["Raise thread score" gnus-summary-raise-thread t] - ["Rethread current" gnus-summary-rethread-current t] - )) + ["Rethread current" gnus-summary-rethread-current t])) (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-summary-mail-digest t] - ["Digest and post" gnus-summary-post-digest 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] @@ -1744,15 +1975,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] @@ -1780,7 +2023,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] @@ -1802,8 +2045,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] @@ -1827,7 +2074,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] @@ -1839,6 +2087,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] @@ -1854,10 +2104,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] @@ -1867,6 +2121,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) @@ -1937,7 +2235,8 @@ increase the score of each group you read." (list 'gnus-summary-header (nth 1 header))) (list 'quote (nth 1 (car ts))) - (list 'gnus-score-default nil) + (list 'gnus-score-delta-default + nil) (nth 1 (car ps)) t) t) @@ -1974,10 +2273,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) @@ -1992,6 +2294,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) @@ -2000,6 +2305,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) + (turn-on-gnus-mailing-list-mode) (gnus-update-format-specifications nil 'summary 'summary-mode 'summary-dummy) (gnus-update-summary-mark-positions)) @@ -2052,7 +2358,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)) @@ -2336,12 +2642,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. @@ -2351,9 +2658,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) @@ -2376,9 +2684,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) @@ -2394,12 +2706,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) @@ -2413,7 +2727,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 @@ -2428,6 +2750,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) @@ -2477,7 +2805,9 @@ marks of articles." (let ((gnus-summary-line-format-spec spec) (gnus-newsgroup-downloadable '((0 . t)))) (gnus-summary-insert-line - (make-full-mail-header 0 "" "" "" "" "" 0 0 "" nil) + (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) @@ -2505,10 +2835,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 @@ -2542,7 +2870,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 @@ -2552,15 +2880,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 @@ -2574,7 +2901,9 @@ 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)) + (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)) @@ -2585,7 +2914,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. @@ -2607,7 +2936,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)) @@ -2689,14 +3018,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 @@ -2726,7 +3076,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. @@ -2754,8 +3108,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) @@ -2771,6 +3123,7 @@ If NO-DISPLAY, don't generate a summary buffer." (let ((gnus-newsgroup-dormant nil)) (gnus-summary-initial-limit show-all)) (gnus-summary-initial-limit show-all)) + ;; When untreaded, all articles are always shown. (setq gnus-newsgroup-limit (mapcar (lambda (header) (mail-header-number header)) @@ -2895,7 +3248,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." @@ -2969,12 +3323,12 @@ 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)) (setcdr (car threads) - (sort (cdar threads) 'gnus-thread-sort-by-number))) + (sort (cdar threads) gnus-sort-gathered-threads-function))) (setq threads (cdr threads))) result)) @@ -3109,6 +3463,7 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." (defun gnus-build-sparse-threads () (let ((headers gnus-newsgroup-headers) + (mail-parse-charset gnus-newsgroup-charset) (gnus-summary-ignore-duplicates t) header references generation relations subject child end new-child date) @@ -3142,7 +3497,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) @@ -3161,7 +3516,8 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." ;; fetch the headers for the articles that aren't there. This will ;; build complete threads - if the roots haven't been expired by the ;; server, that is. - (let (id heads) + (let ((mail-parse-charset gnus-newsgroup-charset) + id heads) (mapatoms (lambda (refs) (when (not (car (symbol-value refs))) @@ -3184,31 +3540,38 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." header) ;; overview: [num subject from date id refs chars lines misc] - (unless (eobp) - (forward-char)) - - (setq header - (make-full-mail-header - 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 - (unless (eobp) - (nnheader-nov-field)) ; misc - (nnheader-nov-parse-extra))) ; extra + (unwind-protect + (progn + (narrow-to-region (point) eol) + (unless (eobp) + (forward-char)) + + (setq header + (make-full-mail-header + 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 + (unless (eobp) + (if (looking-at "Xref: ") + (goto-char (match-end 0))) + (nnheader-nov-field)) ; Xref + (nnheader-nov-parse-extra)))) ; extra + + (widen)) (when gnus-alter-header-function (funcall gnus-alter-header-function header)) (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 @@ -3243,6 +3606,7 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." (defun gnus-build-all-threads () "Read all the headers." (let ((gnus-summary-ignore-duplicates t) + (mail-parse-charset gnus-newsgroup-charset) (dependencies gnus-newsgroup-dependencies) header article) (save-excursion @@ -3252,8 +3616,7 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." (while (not (eobp)) (ignore-errors (setq article (read (current-buffer)) - header (gnus-nov-parse-line - article dependencies))) + header (gnus-nov-parse-line article dependencies))) (when header (save-excursion (set-buffer gnus-summary-buffer) @@ -3290,17 +3653,19 @@ Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise." (memq article gnus-newsgroup-expirable) ;; Only insert the Subject string when it's different ;; from the previous Subject string. - (if (gnus-subject-equal - (condition-case () - (mail-header-subject - (gnus-data-header - (cadr - (gnus-data-find-list - article - (gnus-data-list t))))) - ;; Error on the side of excessive subjects. - (error "")) - (mail-header-subject header)) + (if (and + gnus-show-threads + (gnus-subject-equal + (condition-case () + (mail-header-subject + (gnus-data-header + (cadr + (gnus-data-find-list + article + (gnus-data-list t))))) + ;; Error on the side of excessive subjects. + (error "")) + (mail-header-subject header))) "" (mail-header-subject header)) nil (cdr (assq article gnus-newsgroup-scored)) @@ -3514,7 +3879,6 @@ If LINE, insert the rebuilt thread starting on line LINE." (while thread (gnus-remove-thread-1 (car thread)) (setq thread (cdr thread)))) - (gnus-summary-show-all-threads) (gnus-remove-thread-1 thread)))))))) (defun gnus-remove-thread-1 (thread) @@ -3526,6 +3890,7 @@ If LINE, insert the rebuilt thread starting on line LINE." (gnus-remove-thread-1 (pop thread))) (when (setq d (gnus-data-find number)) (goto-char (gnus-data-pos d)) + (gnus-summary-show-thread) (gnus-data-remove number (- (gnus-point-at-bol) @@ -3533,13 +3898,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) @@ -3554,12 +3928,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) @@ -3595,11 +3969,11 @@ 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 ((addr (car (mime-read-field 'From h1)))) + (let ((addr (car (mime-entity-read-field h1 'From)))) (or (std11-full-name-string addr) (std11-address-string addr) "")) - (let ((addr (car (mime-read-field 'From h2)))) + (let ((addr (car (mime-entity-read-field h2 'From)))) (or (std11-full-name-string addr) (std11-address-string addr) "")) @@ -3684,7 +4058,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)))) @@ -3887,7 +4261,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 @@ -3897,17 +4271,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 @@ -3916,7 +4291,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)) @@ -3971,6 +4348,63 @@ or a straight list of headers." (cdr (assq number gnus-newsgroup-scored)) (memq number gnus-newsgroup-processable)))))) +(defun gnus-summary-remove-list-identifiers () + "Remove list identifiers in `gnus-list-identifiers' from articles in the current group." + (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 + ;;;!!! FIXME: temporary fix for an infloop on nnimap. + (if (eq 'nnimap (car (gnus-find-method-for-group name))) + (if (eq 'nov + (setq gnus-headers-retrieved-by + (gnus-retrieve-headers + articles gnus-newsgroup-name + ;; We might want to fetch old headers, but + ;; not if there is only 1 article. + (and (or (and + (not (eq gnus-fetch-old-headers 'some)) + (not (numberp gnus-fetch-old-headers))) + (> (length articles) 1)) + gnus-fetch-old-headers)))) + (gnus-get-newsgroup-headers-xover + articles nil nil gnus-newsgroup-name t) + (gnus-get-newsgroup-headers)) + (gnus-retrieve-parsed-headers + articles gnus-newsgroup-name + ;; We might want to fetch old headers, but + ;; not if there is only 1 article. + (and (or (and (not (eq gnus-fetch-old-headers 'some)) + (not (numberp gnus-fetch-old-headers))) + (> (length articles) 1)) + gnus-fetch-old-headers))) + (gnus-message 5 "Fetching headers for %s...done" name)))) + (defun gnus-select-newsgroup (group &optional read-all select-articles) "Select newsgroup GROUP. If READ-ALL is non-nil, all articles in the group are selected. @@ -3994,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) @@ -4045,17 +4479,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 - (gnus-retrieve-parsed-headers - articles gnus-newsgroup-name - ;; We might want to fetch old headers, but - ;; not if there is only 1 article. - (and (or (and (not (eq gnus-fetch-old-headers 'some)) - (not (numberp gnus-fetch-old-headers))) - (> (length articles) 1)) - gnus-fetch-old-headers))) - (gnus-message 5 "Fetching headers for %s...done" gnus-newsgroup-name) + (setq gnus-newsgroup-headers (gnus-fetch-headers articles)) ;; Suppress duplicates? (when gnus-suppress-duplicates @@ -4087,6 +4511,9 @@ If SELECT-ARTICLES, only select those articles from GROUP." ;; 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)) ;; Check whether auto-expire is to be done in this group. (setq gnus-newsgroup-auto-expire (gnus-group-auto-expirable-p group)) @@ -4104,7 +4531,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. @@ -4113,7 +4540,9 @@ If SELECT-ARTICLES, only select those articles from GROUP." (zerop (length gnus-newsgroup-unreads))) (eq (gnus-group-find-parameter group 'display) 'all)) - (gnus-uncompress-range (gnus-active group)) + (or + (gnus-uncompress-range (gnus-active group)) + (gnus-cache-articles-in-group group)) (sort (append gnus-newsgroup-dormant gnus-newsgroup-marked (copy-sequence gnus-newsgroup-unreads)) '<))) @@ -4132,15 +4561,14 @@ If SELECT-ARTICLES, only select those articles from GROUP." ((and (or (<= scored marked) (= scored number)) (natnump gnus-large-newsgroup) (> number gnus-large-newsgroup)) - (let* ((minibuffer-setup-hook (append - minibuffer-setup-hook - '(beginning-of-line))) - (input (read-string + (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) - (number-to-string gnus-large-newsgroup)))) + (cons (number-to-string gnus-large-newsgroup) + 0)))) (if (string-match "^[ \t]*$" input) number input))) @@ -4154,7 +4582,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 @@ -4174,6 +4604,12 @@ If SELECT-ARTICLES, only select those articles from GROUP." (gnus-sorted-intersection gnus-newsgroup-unreads (gnus-sorted-complement gnus-newsgroup-unreads articles))) + (when gnus-alter-articles-to-read-function + (setq gnus-newsgroup-unreads + (sort + (funcall gnus-alter-articles-to-read-function + gnus-newsgroup-name gnus-newsgroup-unreads) + '<))) articles))) (defun gnus-killed-articles (killed articles) @@ -4259,9 +4695,9 @@ If SELECT-ARTICLES, only select those articles from GROUP." ;; Add all marks lists to the list of marks lists. (while (setq type (pop types)) (setq list (symbol-value - (setq symbol - (intern (format "gnus-newsgroup-%s" - (car type)))))) + (setq symbol + (intern (format "gnus-newsgroup-%s" + (car type)))))) (when list ;; Get rid of the entries of the articles that have the @@ -4280,30 +4716,36 @@ If SELECT-ARTICLES, only select those articles from GROUP." (setq arts (cdr arts))) (setq list (cdr all))))) - (or (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) - ;; uncompressed:s are not proper flags (they are cons cells) - ;; cache is a internal gnus flag - (unless (memq (cdr type) (cons 'cache uncompressed)) - (let* ((old (cdr (assq (cdr type) (gnus-info-marks info)))) - (del (gnus-remove-from-range (gnus-copy-sequence old) list)) - (add (gnus-remove-from-range (gnus-copy-sequence list) old))) - (if add - (push (list add 'add (list (cdr type))) delta-marks)) - (if del - (push (list del 'del (list (cdr type))) delta-marks))))) - + (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 + ;; download are local to one gnus installation (well) + ;; unsend are for nndraft groups only + ;; xxx: generality of this? this suits nnimap anyway + (unless (memq (cdr type) (append '(cache download unsend) + uncompressed)) + (let* ((old (cdr (assq (cdr type) (gnus-info-marks info)))) + (del (gnus-remove-from-range (gnus-copy-sequence old) list)) + (add (gnus-remove-from-range + (gnus-copy-sequence list) old))) + (when add + (push (list add 'add (list (cdr type))) delta-marks)) + (when del + (push (list del 'del (list (cdr type))) delta-marks))))) + (when list - (push (cons (cdr type) list) newmarked))) + (push (cons (cdr type) list) newmarked))) (when delta-marks (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) @@ -4319,7 +4761,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) @@ -4335,7 +4777,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-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)) @@ -4572,19 +5015,20 @@ The resulting hash table is returned, or nil if no Xrefs were found." (progn (goto-char p) (if (search-forward "\nsubject: " nil t) - (buffer-substring (match-end 0) (std11-field-end)) + (nnheader-header-value) "(none)")) ;; From. (progn (goto-char p) - (if (search-forward "\nfrom: " nil t) - (buffer-substring (match-end 0) (std11-field-end)) + (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) - (buffer-substring (match-end 0) (std11-field-end)) + (nnheader-header-value) "")) ;; Message-ID. (progn @@ -4605,7 +5049,7 @@ The resulting hash table is returned, or nil if no Xrefs were found." (progn (setq end (point)) (prog1 - (buffer-substring (match-end 0) (std11-field-end)) + (nnheader-header-value) (setq ref (buffer-substring (progn @@ -4619,9 +5063,7 @@ The resulting hash table is returned, or nil if no Xrefs were found." ;; were no references and the in-reply-to header looks ;; promising. (if (and (search-forward "\nin-reply-to: " nil t) - (setq in-reply-to - (buffer-substring (match-end 0) - (std11-field-end))) + (setq in-reply-to (nnheader-header-value)) (string-match "<[^>]+>" in-reply-to)) (let (ref2) (setq ref (substring in-reply-to (match-beginning 0) @@ -4638,20 +5080,20 @@ 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) (and (search-forward "\nxref: " nil t) - (buffer-substring (match-end 0) (std11-field-end)))) + (nnheader-header-value))) ;; Extra. (when gnus-extra-headers (let ((extra gnus-extra-headers) @@ -4660,16 +5102,12 @@ 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) - (buffer-substring (match-end 0) - (std11-field-end))) - 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 - (buffer-substring (match-end 0) (std11-field-end)))) + (setq ctype (nnheader-header-value))) (mime-entity-set-content-type-internal header (mime-parse-Content-Type ctype))) (when (equal id ref) @@ -4692,8 +5130,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)) @@ -4741,8 +5180,11 @@ list of headers that match SEQUENCE (see `nntp-retrieve-headers')." (let ((gnus-nov-is-evil t)) (nconc (nreverse headers) - (gnus-retrieve-parsed-headers sequence group) - )))))) + ;;;!!! FIXME: temporary fix for an infloop on nnimap. + (if (eq 'nnimap (car (gnus-find-method-for-group group))) + (when (gnus-retrieve-headers sequence group) + (gnus-get-newsgroup-headers)) + (gnus-retrieve-parsed-headers sequence group)))))))) (defun gnus-article-get-xrefs () "Fill in the Xref value in `gnus-current-headers', if necessary. @@ -4758,7 +5200,8 @@ This is meant to be called in `gnus-article-internal-prepare-hook'." (save-restriction (nnheader-narrow-to-headers) (goto-char (point-min)) - (when (or (and (eq (downcase (char-after)) ?x) + (when (or (and (not (eobp)) + (eq (downcase (char-after)) ?x) (looking-at "Xref:")) (search-forward "\nXref:" nil t)) (goto-char (1+ (match-end 0))) @@ -5021,6 +5464,7 @@ If `gnus-auto-center-summary' is nil, or the article buffer isn't displayed, no centering will be performed." ;; Suggested by earle@mahendo.JPL.NASA.GOV (Greg Earle). ;; Recenter only when requested. Suggested by popovich@park.cs.columbia.edu. + (interactive) (let* ((top (cond ((< (window-height) 4) 0) ((< (window-height) 7) 1) (t (if (numberp gnus-auto-center-summary) @@ -5038,9 +5482,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))))) + (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))) @@ -5080,7 +5537,10 @@ displayed, no centering will be performed." ;; If the range of read articles is a single range, then the ;; first unread article is the article after the last read ;; article. Sounds logical, doesn't it? - (if (not (listp (cdr read))) + (if (and (not (listp (cdr read))) + (or (< (car read) (car active)) + (progn (setq read (list read)) + nil))) (setq first (max (car active) (1+ (cdr read)))) ;; `read' is a list of ranges. (when (/= (setq nlast (or (and (numberp (car read)) (car read)) @@ -5137,8 +5597,7 @@ displayed, no centering will be performed." (key-binding (read-key-sequence (substitute-command-keys - "\\\\[gnus-summary-universal-argument]" - )))) + "\\\\[gnus-summary-universal-argument]")))) 'undefined) (gnus-error 1 "Undefined key") (save-excursion @@ -5173,7 +5632,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))) @@ -5234,7 +5696,7 @@ If FORCE (the prefix), also save the .newsrc file(s)." (defun gnus-summary-exit (&optional temporary) "Exit reading current newsgroup, and then return to group selection mode. -gnus-exit-group-hook is called with no arguments if that value is non-nil." +`gnus-exit-group-hook' is called with no arguments if that value is non-nil." (interactive) (gnus-set-global-variables) (gnus-kill-save-kill-buffer) @@ -5263,6 +5725,8 @@ gnus-exit-group-hook is called with no arguments if that value is non-nil." (gnus-dup-enter-articles)) (when gnus-use-trees (gnus-tree-close group)) + (when gnus-use-cache + (gnus-cache-write-active)) ;; Remove entries for this group. (nnmail-purge-split-history (gnus-group-real-name group)) ;; Make all changes in this group permanent. @@ -5290,28 +5754,41 @@ gnus-exit-group-hook is called with no arguments if that value is non-nil." (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))))) @@ -5328,7 +5805,7 @@ gnus-exit-group-hook is called with no arguments if that value is non-nil." (gnus-async-halt-prefetch) (mapcar 'funcall (delq 'gnus-summary-expire-articles - (copy-list gnus-summary-prepare-exit-hook))) + (copy-sequence gnus-summary-prepare-exit-hook))) ;; If we have several article buffers, we kill them at exit. (unless gnus-single-article-buffer (gnus-kill-buffer gnus-article-buffer) @@ -5338,8 +5815,12 @@ gnus-exit-group-hook is called with no arguments if that value is non-nil." (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 @@ -5444,7 +5925,8 @@ The state which existed when entering the ephemeral is reset." (rename-buffer (concat (substring name 0 (match-beginning 0)) "Dead " (substring name (match-beginning 0))) - t)))) + t) + (bury-buffer)))) (defun gnus-kill-or-deaden-summary (buffer) "Kill or deaden the summary BUFFER." @@ -5611,8 +6093,8 @@ returned." (if backward (gnus-summary-find-prev unread) (gnus-summary-find-next unread))) - (gnus-summary-show-thread) - (setq n (1- n))) + (unless (zerop (setq n (1- n))) + (gnus-summary-show-thread))) (when (/= 0 n) (gnus-message 7 "No more%s articles" (if unread " unread" ""))) @@ -5673,13 +6155,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))) @@ -5703,37 +6195,40 @@ be displayed." (set-buffer gnus-summary-buffer)) (let ((article (or article (gnus-summary-article-number))) (all-headers (not (not all-headers))) ;Must be T or NIL. - gnus-summary-display-article-function - did) + gnus-summary-display-article-function) (and (not pseudo) (gnus-summary-article-pseudo-p article) (error "This is a pseudo-article")) - (prog1 - (save-excursion - (set-buffer gnus-summary-buffer) - (if (or (and gnus-single-article-buffer - (or (null gnus-current-article) - (null gnus-article-current) - (null (get-buffer gnus-article-buffer)) - (not (eq article (cdr gnus-article-current))) - (not (equal (car gnus-article-current) - gnus-newsgroup-name)))) - (and (not gnus-single-article-buffer) - (or (null gnus-current-article) - (not (eq gnus-current-article article)))) - force) - ;; The requested article is different from the current article. - (prog1 - (gnus-summary-display-article article all-headers) - (setq did article) - (when (or all-headers gnus-show-all-headers) - (gnus-article-show-all-headers))) + (save-excursion + (set-buffer gnus-summary-buffer) + (if (or (and gnus-single-article-buffer + (or (null gnus-current-article) + (null gnus-article-current) + (null (get-buffer gnus-article-buffer)) + (not (eq article (cdr gnus-article-current))) + (not (equal (car gnus-article-current) + gnus-newsgroup-name)))) + (and (not gnus-single-article-buffer) + (or (null gnus-current-article) + (not (eq gnus-current-article article)))) + force) + ;; The requested article is different from the current article. + (progn + (gnus-summary-display-article article all-headers) (when (or all-headers gnus-show-all-headers) (gnus-article-show-all-headers)) - 'old)) - (when did - (gnus-article-set-window-start - (cdr (assq article gnus-newsgroup-bookmarks))))))) + (gnus-article-set-window-start + (cdr (assq article gnus-newsgroup-bookmarks))) + article) + (when (or all-headers gnus-show-all-headers) + (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." @@ -6145,7 +6640,21 @@ If given a prefix, remove all limits." "Limit the summary buffer to articles that are older than (or equal) AGE days. If YOUNGER-P (the prefix) is non-nil, limit the summary buffer to articles that are younger than AGE days." - (interactive "nLimit to articles older than (in days): \nP") + (interactive + (let ((younger current-prefix-arg) + (days-got nil) + days) + (while (not days-got) + (setq days (if younger + (read-string "Limit to articles within (in days): ") + (read-string "Limit to articles older than (in days): "))) + (when (> (length days) 0) + (setq days (read days))) + (if (numberp days) + (setq days-got t) + (message "Please enter a number.") + (sleep-for 1))) + (list days younger))) (prog1 (let ((data gnus-newsgroup-data) (cutoff (days-to-time age)) @@ -6154,7 +6663,9 @@ articles that are younger than AGE days." (when (and (vectorp (gnus-data-header d)) (setq date (mail-header-date (gnus-data-header d)))) (setq is-younger (time-less-p - (time-since (date-to-time date)) + (time-since (condition-case () + (date-to-time date) + (error '(0 0)))) cutoff)) (when (if younger-p is-younger @@ -6169,12 +6680,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))))) @@ -6384,6 +6895,7 @@ If ALL, mark even excluded ticked and dormants as read." "Go forwards in the thread until we find an article that we want to display." (when (or (eq gnus-fetch-old-headers 'some) (eq gnus-fetch-old-headers 'invisible) + (numberp gnus-fetch-old-headers) (eq gnus-build-sparse-threads 'some) (eq gnus-build-sparse-threads 'more)) ;; Deal with old-fetched headers and sparse threads. @@ -6413,6 +6925,7 @@ If ALL, mark even excluded ticked and dormants as read." "Cut off all uninteresting articles from the beginning of threads." (when (or (eq gnus-fetch-old-headers 'some) (eq gnus-fetch-old-headers 'invisible) + (numberp gnus-fetch-old-headers) (eq gnus-build-sparse-threads 'some) (eq gnus-build-sparse-threads 'more)) (let ((th threads)) @@ -6430,6 +6943,7 @@ fetch-old-headers verbiage, and so on." (if (or gnus-inhibit-limiting (and (null gnus-newsgroup-dormant) (not (eq gnus-fetch-old-headers 'some)) + (not (numberp gnus-fetch-old-headers)) (not (eq gnus-fetch-old-headers 'invisible)) (null gnus-summary-expunge-below) (not (eq gnus-build-sparse-threads 'some)) @@ -6483,7 +6997,8 @@ fetch-old-headers verbiage, and so on." (zerop children)) ;; If this is "fetch-old-headered" and there is no ;; visible children, then we don't want this article. - (and (eq gnus-fetch-old-headers 'some) + (and (or (eq gnus-fetch-old-headers 'some) + (numberp gnus-fetch-old-headers)) (gnus-summary-article-ancient-p number) (zerop children)) ;; If this is "fetch-old-headered" and `invisible', then @@ -6634,11 +7149,9 @@ of what's specified by the `gnus-refer-thread-limit' variable." (gnus-message 5 "Fetching headers for %s...done" gnus-newsgroup-name)) (gnus-summary-limit-include-thread id))) -(defun gnus-summary-refer-article (message-id &optional arg) - "Fetch an article specified by MESSAGE-ID. -If ARG (the prefix), fetch the article using `gnus-refer-article-method' -or `gnus-select-method', no matter what backend the article comes from." - (interactive "sMessage-ID: \nP") +(defun gnus-summary-refer-article (message-id) + "Fetch an article specified by MESSAGE-ID." + (interactive "sMessage-ID: ") (when (and (stringp message-id) (not (zerop (length message-id)))) ;; Construct the correct Message-ID if necessary. @@ -6652,7 +7165,8 @@ or `gnus-select-method', no matter what backend the article comes from." (gnus-summary-article-sparse-p (mail-header-number header)) (memq (mail-header-number header) - gnus-newsgroup-limit)))) + gnus-newsgroup-limit))) + number) (cond ;; If the article is present in the buffer we just go to it. ((and header @@ -6665,22 +7179,38 @@ or `gnus-select-method', no matter what backend the article comes from." (when sparse (gnus-summary-update-article (mail-header-number header))))) (t - ;; We fetch the article - (let ((gnus-override-method - (cond ((gnus-news-group-p gnus-newsgroup-name) - gnus-refer-article-method) - (arg - (or gnus-refer-article-method gnus-select-method)) - (t nil))) - number) - ;; Start the special refer-article method, if necessary. - (when (and gnus-refer-article-method - (gnus-news-group-p gnus-newsgroup-name)) - (gnus-check-server gnus-refer-article-method)) - ;; Fetch the header, and display the article. - (if (setq number (gnus-summary-insert-subject message-id)) + ;; We fetch the article. + (catch 'found + (dolist (gnus-override-method (gnus-refer-article-methods)) + (gnus-check-server gnus-override-method) + ;; Fetch the header, and display the article. + (when (setq number (gnus-summary-insert-subject message-id)) (gnus-summary-select-article nil nil nil number) - (gnus-message 3 "Couldn't fetch article %s" message-id)))))))) + (throw 'found t))) + (gnus-message 3 "Couldn't fetch article %s" message-id))))))) + +(defun gnus-refer-article-methods () + "Return a list of referrable methods." + (cond + ;; No method, so we default to current and native. + ((null gnus-refer-article-method) + (list gnus-current-select-method gnus-select-method)) + ;; Current. + ((eq 'current gnus-refer-article-method) + (list gnus-current-select-method)) + ;; List of select methods. + ((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) + gnus-current-select-method + method) + out)) + (nreverse out))) + ;; One single select method. + (t + (list gnus-refer-article-method)))) (defun gnus-summary-edit-parameters () "Edit the group parameters of the current group." @@ -6713,8 +7243,17 @@ to guess what the document format is." (list (cons 'save-article-group ogroup)))) (case-fold-search t) (buf (current-buffer)) - dig) + dig to-address) (save-excursion + (set-buffer gnus-original-article-buffer) + ;; Have the digest group inherit the main mail address of + ;; the parent article. + (when (setq to-address (or (message-fetch-field "reply-to") + (message-fetch-field "from"))) + (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 @@ -6732,7 +7271,7 @@ to guess what the document format is." (gnus-group-read-ephemeral-group name `(nndoc ,name (nndoc-address ,(get-buffer dig)) (nndoc-article-type - ,(if force 'digest 'guess))) t)) + ,(if force 'mbox 'guess))) t)) ;; Make all postings to this group go to the parent group. (nconc (gnus-info-params (gnus-get-info name)) params) @@ -6797,12 +7336,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. @@ -6817,10 +7360,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." @@ -6832,6 +7379,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. @@ -6841,19 +7466,44 @@ Optional argument BACKWARD means do search for backward. (require 'gnus-async) (require 'gnus-art) (let ((gnus-select-article-hook nil) ;Disable hook. - (gnus-article-display-hook nil) + (gnus-article-prepare-hook nil) (gnus-mark-article-hook nil) ;Inhibit marking as read. (gnus-use-article-prefetch nil) (gnus-xmas-force-redisplay nil) ;Inhibit XEmacs redisplay. (gnus-use-trees nil) ;Inhibit updating tree buffer. (sum (current-buffer)) (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) - (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 @@ -6861,12 +7511,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-buffer sum) (setq point (point))) ;; We didn't find it, so we go to the next article. @@ -6881,7 +7535,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)))))))) @@ -6935,9 +7591,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: ") @@ -6989,8 +7647,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 @@ -7000,6 +7657,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 "(" @@ -7013,30 +7676,63 @@ 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 non-nil, show the raw article without any -article massaging functions being run." +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 +without any article massaging functions being run." (interactive "P") - (if (not arg) - ;; Select the article the normal way. + (cond + ((numberp arg) + (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) + (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)) + (t ;; We have to require this here to make sure that the following ;; dynamic binding isn't shadowed by autoloading. (require 'gnus-async) (require 'gnus-art) ;; Bind the article treatment functions to nil. (let ((gnus-have-all-headers t) - gnus-article-display-hook gnus-article-prepare-hook gnus-article-decode-hook gnus-break-pages gnus-show-mime - gnus-visual) - (gnus-summary-select-article nil 'force))) + (gnus-inhibit-treatment t)) + (gnus-summary-select-article nil 'force)))) (gnus-summary-goto-subject gnus-current-article) (gnus-summary-position-point)) @@ -7064,9 +7760,12 @@ If ARG is a negative number, hide the unwanted header lines." (let* ((buffer-read-only nil) (inhibit-point-motion-hooks t) hidden e) - (save-restriction - (article-narrow-to-head) - (setq hidden (gnus-article-hidden-text-p 'headers))) + (setq hidden + (if (numberp arg) + (>= arg 0) + (save-restriction + (article-narrow-to-head) + (gnus-article-hidden-text-p 'headers)))) (goto-char (point-min)) (when (search-forward "\n\n" nil t) (delete-region (point-min) (1- (point)))) @@ -7079,17 +7778,19 @@ If ARG is a negative number, hide the unwanted header lines." (save-restriction (narrow-to-region (point-min) (point)) (article-decode-encoded-words) - (if (or hidden - (and (numberp arg) (< arg 0))) + (if hidden (let ((gnus-treat-hide-headers nil) (gnus-treat-hide-boring-headers nil)) + (setq gnus-article-wash-types + (delq 'headers gnus-article-wash-types)) (gnus-treat-article 'head)) - (gnus-treat-article 'head))))))) + (gnus-treat-article 'head))) + (gnus-set-mode-line 'article))))) (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. @@ -7141,7 +7842,9 @@ re-spool using this method. For this function to work, both the current newsgroup and the newsgroup that you want to move to have to support the `request-move' -and `request-accept' functions." +and `request-accept' functions. + +ACTION can be either `move' (the default), `crosspost' or `copy'." (interactive "P") (unless action (setq action 'move)) @@ -7159,7 +7862,10 @@ and `request-accept' functions." 'request-replace-article gnus-newsgroup-name))) (error "The current group does not support article editing"))) (let ((articles (gnus-summary-work-articles n)) - (prefix (gnus-group-real-prefix gnus-newsgroup-name)) + (prefix (if (gnus-check-backend-function + 'request-move-article gnus-newsgroup-name) + (gnus-group-real-prefix gnus-newsgroup-name) + "")) (names '((move "Move" "Moving") (copy "Copy" "Copying") (crosspost "Crosspost" "Crossposting"))) @@ -7181,7 +7887,8 @@ and `request-accept' functions." articles prefix)) (set (intern (format "gnus-current-%s-group" action)) to-newsgroup)) (setq to-method (or select-method - (gnus-group-name-to-method to-newsgroup))) + (gnus-server-to-method + (gnus-group-method to-newsgroup)))) ;; Check the method we are to move this article to... (unless (gnus-check-backend-function 'request-accept-article (car to-method)) @@ -7207,7 +7914,7 @@ and `request-accept' functions." gnus-newsgroup-name)) ; Server (list 'gnus-request-accept-article to-newsgroup (list 'quote select-method) - (not articles) t) ; Accept form + (not articles) t) ; Accept form (not articles))) ; Only save nov last time ;; Copy the article. ((eq action 'copy) @@ -7248,12 +7955,13 @@ and `request-accept' functions." art-group)))))) (cond ((not art-group) - (gnus-message 1 "Couldn't %s article %s" - (cadr (assq action names)) article)) - ((and (eq art-group 'junk) - (eq action 'move)) - (gnus-summary-mark-article article gnus-canceled-mark) - (gnus-message 4 "Deleted article %s" article)) + (gnus-message 1 "Couldn't %s article %s: %s" + (cadr (assq action names)) article + (nnheader-get-report (car to-method)))) + ((eq art-group 'junk) + (when (eq action 'move) + (gnus-summary-mark-article article gnus-canceled-mark) + (gnus-message 4 "Deleted article %s" article))) (t (let* ((pto-group (gnus-group-prefixed-name (car art-group) to-method)) @@ -7274,13 +7982,14 @@ and `request-accept' functions." info (gnus-add-to-range (gnus-info-read info) (list (cdr art-group))))) - ;; Copy any marks over to the new group. + ;; See whether the article is to be put in the cache. (let ((marks (if (gnus-group-auto-expirable-p to-group) default-marks no-expire-marks)) (to-article (cdr art-group))) - ;; See whether the article is to be put in the cache. + ;; Enter the article into the cache in the new group, + ;; if that is required. (when gnus-use-cache (gnus-cache-possibly-enter-article to-group to-article @@ -7292,34 +8001,36 @@ and `request-accept' functions." (memq article gnus-newsgroup-dormant) (memq article gnus-newsgroup-unreads))) - (when (and (equal to-group gnus-newsgroup-name) - (not (memq article gnus-newsgroup-unreads))) - ;; Mark this article as read in this group. - (push (cons to-article gnus-read-mark) gnus-newsgroup-reads) - (setcdr (gnus-active to-group) to-article) - (setcdr gnus-newsgroup-active to-article)) - - (while marks - (when (memq article (symbol-value - (intern (format "gnus-newsgroup-%s" - (caar marks))))) - (push (cdar marks) to-marks) - ;; If the other group is the same as this group, - ;; then we have to add the mark to the list. - (when (equal to-group gnus-newsgroup-name) - (set (intern (format "gnus-newsgroup-%s" (caar marks))) - (cons to-article - (symbol-value - (intern (format "gnus-newsgroup-%s" - (caar marks))))))) - ;; Copy the marks to other group. - (gnus-add-marked-articles - to-group (cdar marks) (list to-article) info)) - (setq marks (cdr marks))) - - (gnus-request-set-mark to-group (list (list (list to-article) - 'set - to-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))) + ;; Mark this article as read in this group. + (push (cons to-article gnus-read-mark) gnus-newsgroup-reads) + (setcdr (gnus-active to-group) to-article) + (setcdr gnus-newsgroup-active to-article)) + + (while marks + (when (memq article (symbol-value + (intern (format "gnus-newsgroup-%s" + (caar marks))))) + (push (cdar marks) to-marks) + ;; If the other group is the same as this group, + ;; then we have to add the mark to the list. + (when (equal to-group gnus-newsgroup-name) + (set (intern (format "gnus-newsgroup-%s" (caar marks))) + (cons to-article + (symbol-value + (intern (format "gnus-newsgroup-%s" + (caar marks))))))) + ;; Copy the marks to other group. + (gnus-add-marked-articles + to-group (cdar marks) (list to-article) info)) + (setq marks (cdr marks))) + + (gnus-request-set-mark to-group (list (list (list to-article) + 'set + to-marks)))) (gnus-dribble-enter (concat "(gnus-group-set-info '" @@ -7419,12 +8130,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) @@ -7441,21 +8152,48 @@ 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 `gnus-select-method' as well. + "Say whether the current (mail) article is available from news as well. This will be the case if the article has both been mailed and posted." (interactive) (let ((id (mail-header-references (gnus-summary-article-header))) - (gnus-override-method - (or gnus-refer-article-method gnus-select-method))) + (gnus-override-method (car (gnus-refer-article-methods)))) (if (gnus-request-head id "") (gnus-message 2 "The current message was found on %s" gnus-override-method) @@ -7483,6 +8221,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 @@ -7498,19 +8239,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 () @@ -7537,6 +8278,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) @@ -7582,6 +8325,8 @@ groups." '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 @@ -7594,10 +8339,31 @@ 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) @@ -7760,28 +8526,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 () @@ -7792,6 +8561,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 @@ -7800,11 +8583,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." @@ -7883,7 +8680,8 @@ the actual number of articles marked is returned." "Mark N articles as read forwards. If N is negative, mark backwards instead. Mark with MARK, ?r by default. The difference between N and the actual number of articles marked is -returned." +returned. +Iff NO-EXPIRE, auto-expiry will be inhibited." (interactive "p") (gnus-summary-show-thread) (let ((backward (< n 0)) @@ -7976,7 +8774,8 @@ Four MARK strings are reserved: `? ' (unread), `?!' (ticked), `??' (dormant) and `?E' (expirable). If MARK is nil, then the default character `?r' is used. If ARTICLE is nil, then the article on the current line will be -marked." +marked. +Iff NO-EXPIRE, auto-expiry will be inhibited." ;; The mark might be a string. (when (stringp mark) (setq mark (aref mark 0))) @@ -8028,9 +8827,11 @@ marked." 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)) @@ -8174,6 +8975,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, @@ -8247,8 +9053,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))) @@ -8256,6 +9062,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) @@ -8323,7 +9134,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. @@ -8337,7 +9149,6 @@ If prefix argument ALL is non-nil, all articles are marked as read." (interactive "P") (gnus-summary-catchup-and-exit t quietly)) -;; Suggested by "Arne Eofsson" . (defun gnus-summary-catchup-and-goto-next-group (&optional all) "Mark all articles in this group as read and select the next group. If given a prefix, mark all articles, unread as well as ticked, as @@ -8345,7 +9156,38 @@ read." (interactive "P") (save-excursion (gnus-summary-catchup all)) - (gnus-summary-next-article t nil nil t)) + (gnus-summary-next-group)) + +;;; +;;; with article +;;; + +(defmacro gnus-with-article (article &rest forms) + "Select ARTICLE and perform FORMS in the original article buffer. +Then replace the article with the result." + `(progn + ;; We don't want the article to be marked as read. + (let (gnus-mark-article-hook) + (gnus-summary-select-article t t nil ,article)) + (set-buffer gnus-original-article-buffer) + ,@forms + (if (not (gnus-check-backend-function + 'request-replace-article (car gnus-article-current))) + (gnus-message 5 "Read-only group; not replacing") + (unless (gnus-request-replace-article + ,article (car gnus-article-current) + (current-buffer) t) + (error "Couldn't replace article"))) + ;; The cache and backlog have to be flushed somewhat. + (when gnus-keep-backlog + (gnus-backlog-remove-article + (car gnus-article-current) (cdr gnus-article-current))) + (when gnus-use-cache + (gnus-cache-update-article + (car gnus-article-current) (cdr gnus-article-current))))) + +(put 'gnus-with-article 'lisp-indent-function 1) +(put 'gnus-with-article 'edebug-form-spec '(form body)) ;; Thread-based commands. @@ -8425,14 +9267,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) @@ -8507,9 +9351,7 @@ Returns nil if no threads were there to be hidden." (subst-char-in-region start (point) ?\n ?\^M) (gnus-summary-goto-subject article)) (goto-char start) - nil) - ;;(gnus-summary-position-point) - )))) + nil))))) (defun gnus-summary-go-to-next-thread (&optional previous) "Go to the same level (or less) next thread. @@ -8588,7 +9430,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") @@ -8641,14 +9483,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)) @@ -8675,7 +9517,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." @@ -8686,6 +9540,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 @@ -8744,6 +9600,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)) @@ -8755,6 +9612,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))) @@ -8765,6 +9623,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))) @@ -8775,6 +9634,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))) @@ -8785,6 +9645,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))) @@ -8795,6 +9656,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))) @@ -8819,7 +9681,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)) @@ -8838,7 +9700,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) @@ -8883,7 +9745,8 @@ save those articles instead." (mapcar (lambda (el) (list el)) (nreverse split-name)) nil nil nil - 'gnus-group-history))))) + 'gnus-group-history)))) + (to-method (gnus-server-to-method (gnus-group-method to-newsgroup)))) (when to-newsgroup (if (or (string= to-newsgroup "") (string= to-newsgroup prefix)) @@ -8891,24 +9754,29 @@ save those articles instead." (unless to-newsgroup (error "No group name entered")) (or (gnus-active to-newsgroup) - (gnus-activate-group to-newsgroup) + (gnus-activate-group to-newsgroup nil nil to-method) (if (gnus-y-or-n-p (format "No such group: %s. Create it? " to-newsgroup)) - (or (and (gnus-request-create-group - to-newsgroup (gnus-group-name-to-method to-newsgroup)) - (gnus-activate-group to-newsgroup nil nil - (gnus-group-name-to-method - to-newsgroup))) + (or (and (gnus-request-create-group to-newsgroup to-method) + (gnus-activate-group + to-newsgroup nil nil to-method) + (gnus-subscribe-group to-newsgroup)) (error "Couldn't create group %s" to-newsgroup))) (error "No such group: %s" to-newsgroup))) to-newsgroup)) -(defun gnus-summary-save-parts (type dir n reverse) +(defun gnus-summary-save-parts (type dir n &optional reverse) "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: " t 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) @@ -8916,10 +9784,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)) @@ -8933,7 +9803,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)))))) @@ -9050,8 +9922,10 @@ If REVERSE, save parts that do not match TYPE." "Read the headers of article ID and enter them into the Gnus system." (let ((group gnus-newsgroup-name) (gnus-override-method - (and (gnus-news-group-p gnus-newsgroup-name) - gnus-refer-article-method)) + (or + gnus-override-method + (and (gnus-news-group-p gnus-newsgroup-name) + (car (gnus-refer-article-methods))))) where) ;; First we check to see whether the header in question is already ;; fetched. @@ -9125,8 +9999,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))) @@ -9221,23 +10095,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. @@ -9306,40 +10189,31 @@ If REVERSE, save parts that do not match TYPE." (defun gnus-mime-extract-message/rfc822 (entity situation) (let (group article num cwin swin cur) - (with-current-buffer (mime-entity-buffer entity) - (save-restriction - (narrow-to-region (mime-entity-body-start entity) - (mime-entity-body-end 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) - ) - )) + (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) - ) + 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) - ) + (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-goto-subject article t)) (gnus-summary-clear-mark-forward 1) - (gnus-summary-goto-subject cur) - ) + (gnus-summary-goto-subject cur)) (when (and cwin (window-frame cwin)) - (select-frame (window-frame cwin)) - ) + (select-frame (window-frame cwin))) (when (boundp 'mime-acting-situation-to-override) (set-alist 'mime-acting-situation-to-override 'group @@ -9349,15 +10223,11 @@ If REVERSE, save parts that do not match TYPE." `(progn (save-current-buffer (set-buffer gnus-group-buffer) - (gnus-activate-group ,group) - ) + (gnus-activate-group ,group)) (gnus-summary-goto-article ,cur - gnus-show-all-headers) - )) + gnus-show-all-headers))) (set-alist 'mime-acting-situation-to-override - 'number num) - ) - ))) + 'number num))))) (mime-add-condition 'action '((type . message)(subtype . rfc822) @@ -9385,7 +10255,7 @@ If REVERSE, save parts that do not match TYPE." (if (setq f (cdr (assq 'after-method mime-acting-situation-to-override))) (eval f) - ))) + ))) (mime-add-condition 'action '((type . multipart) @@ -9402,39 +10272,19 @@ If REVERSE, save parts that do not match TYPE." "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 - (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-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 nil)) - (while (setq elem (pop alist)) - (when (and name - (string-match (car elem) name)) - (setq alist nil - charset (cadr elem)))) - charset))) - gnus-default-charset)) - (set (make-local-variable 'gnus-newsgroup-ignored-charsets) - ignored-charsets)))) + (let* ((ignored-charsets + (or gnus-newsgroup-ephemeral-ignored-charsets + (append + (and gnus-newsgroup-name + (gnus-parameter-ignored-charsets gnus-newsgroup-name)) + gnus-newsgroup-ignored-charsets)))) + (setq gnus-newsgroup-charset + (or gnus-newsgroup-ephemeral-charset + (and gnus-newsgroup-name + (gnus-parameter-charset gnus-newsgroup-name)) + gnus-default-charset)) + (set (make-local-variable 'gnus-newsgroup-ignored-charsets) + ignored-charsets)))) ;;; ;;; Mime Commands @@ -9455,17 +10305,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))) @@ -9481,35 +10331,102 @@ treated as multipart/mixed." (gnus-summary-show-article))) ;;; -;;; with article +;;; Intelli-mouse commmands ;;; -(defmacro gnus-with-article (article &rest forms) - "Select ARTICLE and perform FORMS in the original article buffer. -Then replace the article with the result." - `(progn - ;; We don't want the article to be marked as read. - (let (gnus-mark-article-hook) - (gnus-summary-select-article t t nil ,article)) - (set-buffer gnus-original-article-buffer) - ,@forms - (if (not (gnus-check-backend-function - 'request-replace-article (car gnus-article-current))) - (gnus-message 5 "Read-only group; not replacing") - (unless (gnus-request-replace-article - ,article (car gnus-article-current) - (current-buffer) t) - (error "Couldn't replace article"))) - ;; The cache and backlog have to be flushed somewhat. - (when gnus-keep-backlog - (gnus-backlog-remove-article - (car gnus-article-current) (cdr gnus-article-current))) - (when gnus-use-cache - (gnus-cache-update-article - (car gnus-article-current) (cdr gnus-article-current))))) +(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) -(put 'gnus-with-article 'lisp-indent-function 1) -(put 'gnus-with-article 'edebug-form-spec '(form body)) +;;; +;;; 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 @@ -9543,8 +10460,8 @@ Then replace the article with the result." 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) @@ -9557,10 +10474,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) @@ -9587,6 +10504,103 @@ 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.") + (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)