;;; gnus-sum.el --- summary mode commands for Gnus
-;; Copyright (C) 1996,97,98,99 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000
+;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
(require 'gnus-undo)
(require 'gnus-util)
(require 'mm-decode)
+;; Recursive :-(.
+;; (require 'gnus-art)
+(require 'nnoo)
(autoload 'gnus-summary-limit-include-cached "gnus-cache" nil t)
+(autoload 'gnus-cache-write-active "gnus-cache")
+(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.
: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)
in the group. If t, select the first unread article.
This variable can also be a function to place point on a likely
-subject line. Useful values include `gnus-summary-first-unread-subject',
-`gnus-summary-first-unread-article' and
+subject line. Useful values include `gnus-summary-first-unread-subject',
+`gnus-summary-first-unread-article' and
`gnus-summary-best-unread-article'.
If you want to prevent automatic selection of the first unread article
(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 ?
+(defcustom gnus-unread-mark ? ;Whitespace
"*Mark used for unread articles."
:group 'gnus-summary-marks
:type 'character)
:group 'gnus-summary-marks
:type 'character)
-(defcustom gnus-empty-thread-mark ?
+(defcustom gnus-empty-thread-mark ? ;Whitespace
"*There is no thread under the article."
:group 'gnus-summary-marks
:type 'character)
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)
: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
\"thread score\" is.
This variable is local to the summary buffers."
- :group 'gnus-treading
+ :group 'gnus-threading
:group 'gnus-score-default
:type '(choice (const :tag "off" nil)
integer))
(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)
: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)
(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
+(defcustom gnus-group-charset-alist
'(("^hk\\>\\|^tw\\>\\|\\<big5\\>" cn-big5)
("^cn\\>\\|\\<chinese\\>" cn-gb-2312)
("^fj\\>\\|^japan\\>" iso-2022-jp-2)
+ ("^tnn\\>\\|^pin\\>\\|^sci.lang.japan" iso-2022-7bit)
("^relcom\\>" koi8-r)
+ ("^fido7\\>" koi8-r)
+ ("^\\(cz\\|hun\\|pl\\|sk\\|hr\\)\\>" iso-8859-2)
+ ("^israel\\>" iso-8859-1)
+ ("^han\\>" euc-kr)
+ ("^alt.chinese.text.big5\\>" chinese-big5)
+ ("^soc.culture.vietnamese\\>" vietnamese-viqr)
+ ("^\\(comp\\|rec\\|alt\\|sci\\|soc\\|news\\|gnu\\|bofh\\)\\>" iso-8859-1)
(".*" iso-8859-1))
- "Alist of regexps (to match group names) and default charsets to be used."
+ "Alist of regexps (to match group names) and default charsets to be used when reading."
:type '(repeat (list (regexp :tag "Group")
(symbol :tag "Charset")))
:group 'gnus-charset)
+(defcustom gnus-newsgroup-ignored-charsets '(unknown-8bit x-unknown)
+ "List of charsets that should be ignored.
+When these charsets are used in the \"charset\" parameter, the
+default charset will be used instead."
+ :version "21.1"
+ :type '(repeat symbol)
+ :group 'gnus-charset)
+
+(defcustom gnus-group-ignored-charsets-alist
+ '(("alt\\.chinese\\.text" iso-8859-1))
+ "Alist of regexps (to match group names) and charsets that should be ignored.
+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)
+
+(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"
+ gnus-emphasis-highlight-words)))))
+ :group 'gnus-summary-visual)
+
+(defcustom gnus-summary-show-article-charset-alist
+ nil
+ "Alist of number and charset.
+The article will be shown with the charset corresponding to the
+numbered argument.
+For example: ((1 . cn-gb-2312) (2 . big5))."
+ :version "21.1"
+ :type '(repeat (cons (number :tag "Argument" 1)
+ (symbol :tag "Charset")))
+ :group 'gnus-charset)
+
+(defcustom gnus-preserve-marks t
+ "Whether marks are preserved when moving, copying and respooling messages."
+ :version "21.1"
+ :type 'boolean
+ :group 'gnus-summary-marks)
+
+(defcustom gnus-alter-articles-to-read-function nil
+ "Function to be called to alter the list of articles to be selected."
+ :type 'function
+ :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)
(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)
?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)
(defvar gnus-last-article nil)
(defvar gnus-newsgroup-history nil)
(defvar gnus-newsgroup-charset nil)
+(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-dependencies gnus-newsgroup-selected-overlay
gnus-newsgroup-scored gnus-newsgroup-kill-headers
gnus-thread-expunge-below
- gnus-score-alist gnus-current-score-file gnus-summary-expunge-below
+ 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
gnus-newsgroup-charset)
"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))
;; MIME stuff.
'(mail-decode-encoded-word-string)
"List of methods used to decode encoded words.
-This variable is a list of FUNCTION or (REGEXP . FUNCTION). If item is
-FUNCTION, FUNCTION will be apply to all newsgroups. If item is a
+This variable is a list of FUNCTION or (REGEXP . FUNCTION). If item is
+FUNCTION, FUNCTION will be apply to all newsgroups. If item is a
(REGEXP . FUNCTION), FUNCTION will be only apply to thes newsgroups
whose names match REGEXP.
-For example:
+For example:
((\"chinese\" . gnus-decode-encoded-word-string-by-guess)
- mail-decode-encoded-word-string
- (\"chinese\" . rfc1843-decode-string))
-")
+ mail-decode-encoded-word-string
+ (\"chinese\" . rfc1843-decode-string))")
(defvar gnus-decode-encoded-word-methods-cache nil)
(defun gnus-multi-decode-encoded-word-string (string)
"Apply the functions from `gnus-encoded-word-methods' that match."
(unless (and gnus-decode-encoded-word-methods-cache
- (eq gnus-newsgroup-name
+ (eq gnus-newsgroup-name
(car gnus-decode-encoded-word-methods-cache)))
(setq gnus-decode-encoded-word-methods-cache (list gnus-newsgroup-name))
- (mapc '(lambda (x)
- (if (symbolp x)
- (nconc gnus-decode-encoded-word-methods-cache (list x))
- (if (and gnus-newsgroup-name
- (string-match (car x) gnus-newsgroup-name))
- (nconc gnus-decode-encoded-word-methods-cache
- (list (cdr x))))))
+ (mapcar (lambda (x)
+ (if (symbolp x)
+ (nconc gnus-decode-encoded-word-methods-cache (list x))
+ (if (and gnus-newsgroup-name
+ (string-match (car x) gnus-newsgroup-name))
+ (nconc gnus-decode-encoded-word-methods-cache
+ (list (cdr x))))))
gnus-decode-encoded-word-methods))
(let ((xlist gnus-decode-encoded-word-methods-cache))
(pop xlist)
;; 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)
(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.
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" " ")
"\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
"\C-c\M-\C-s" gnus-summary-limit-include-expunged
"\C-c\C-s\C-n" gnus-summary-sort-by-number
"\C-c\C-s\C-l" gnus-summary-sort-by-lines
+ "\C-c\C-s\C-c" gnus-summary-sort-by-chars
"\C-c\C-s\C-a" gnus-summary-sort-by-author
"\C-c\C-s\C-s" gnus-summary-sort-by-subject
"\C-c\C-s\C-d" gnus-summary-sort-by-date
"a" gnus-summary-post-news
"x" gnus-summary-limit-to-unread
"s" gnus-summary-isearch-article
- "t" gnus-article-hide-headers
+ "t" gnus-summary-toggle-header
"g" gnus-summary-show-article
"l" gnus-summary-goto-last-article
"\C-c\C-v\C-v" gnus-uu-decode-uu-view
"\C-d" gnus-summary-enter-digest-group
"\M-\C-d" gnus-summary-read-document
"\M-\C-e" gnus-summary-edit-parameters
- "\M-\C-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
"b" gnus-article-view-part
"\M-t" gnus-summary-toggle-display-buttonized
-
+
"V" gnus-summary-score-map
"X" gnus-uu-extract-map
"S" gnus-summary-send-map)
"a" gnus-summary-limit-to-author
"u" gnus-summary-limit-to-unread
"m" gnus-summary-limit-to-marks
+ "M" gnus-summary-limit-exclude-marks
"v" gnus-summary-limit-to-score
"*" gnus-summary-limit-include-cached
"D" gnus-summary-limit-include-dormant
"T" gnus-summary-limit-include-thread
"d" gnus-summary-limit-exclude-dormant
"t" gnus-summary-limit-to-age
+ "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)
"e" gnus-summary-end-of-article
"^" gnus-summary-refer-parent-article
"r" gnus-summary-refer-parent-article
+ "D" gnus-summary-enter-digest-group
"R" gnus-summary-refer-references
"T" gnus-summary-refer-thread
"g" gnus-summary-show-article
"s" gnus-summary-isearch-article
- "P" gnus-summary-print-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)
"b" gnus-article-add-buttons
"o" gnus-article-treat-overstrike
"e" gnus-article-emphasize
"w" gnus-article-fill-cited-article
+ "Q" gnus-article-fill-long-lines
+ "C" gnus-article-capitalize-sentences
"c" gnus-article-remove-cr
"q" gnus-article-de-quoted-unreadable
+ "6" gnus-article-de-base64-unreadable
+ "Z" gnus-article-decode-HZ
+ "h" gnus-article-wash-html
+ "s" gnus-summary-force-verify-and-decrypt
"f" gnus-article-display-x-face
"l" gnus-summary-stop-page-breaking
"r" gnus-summary-caesar-message
- "t" gnus-article-hide-headers
+ "t" gnus-summary-toggle-header
"v" gnus-summary-verbose-headers
- "h" gnus-article-treat-html
+ "H" gnus-article-strip-headers-in-body
+ "p" gnus-article-verify-x-pgp-sig
"d" gnus-article-treat-dumbquotes)
(gnus-define-keys (gnus-summary-wash-hide-map "W" gnus-summary-wash-map)
"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
"\C-c" gnus-article-hide-citation-maybe)
"\M-\C-e" gnus-summary-expire-articles-now
"\177" gnus-summary-delete-article
[delete] gnus-summary-delete-article
+ [backspace] gnus-summary-delete-article
"m" gnus-summary-move-article
"r" gnus-summary-respool-article
"w" gnus-summary-edit-article
"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
- "|" gnus-article-pipe-part)
- )
+ "E" gnus-article-encrypt-body
+ "i" gnus-article-inline-part
+ "|" gnus-article-pipe-part))
(defun gnus-summary-make-menu-bar ()
(gnus-turn-off-edit-menu 'summary)
;; Define both the Article menu in the summary buffer and the equivalent
;; Commands menu in the article buffer here for consistency.
(let ((innards
- '(("Hide"
+ `(("Hide"
["All" gnus-article-hide t]
["Headers" gnus-article-hide-headers t]
["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])
("Highlight"
["All" gnus-article-highlight t]
["Words" gnus-article-decode-mime-words t]
["Charset" gnus-article-decode-charset t]
["QP" gnus-article-de-quoted-unreadable t]
- ["View all" gnus-mime-view-all-parts t])
+ ["Base64" gnus-article-de-base64-unreadable t]
+ ["View all" gnus-mime-view-all-parts t]
+ ["Verify and Decrypt" gnus-summary-force-verify-and-decrypt t]
+ ["Encrypt body" gnus-article-encrypt-body t])
("Date"
["Local" gnus-article-date-local t]
["ISO8601" gnus-article-date-iso8601 t]
["Dumb quotes" gnus-article-treat-dumbquotes t]
["Emphasis" gnus-article-emphasize t]
["Word wrap" gnus-article-fill-cited-article t]
+ ["Fill long lines" gnus-article-fill-long-lines t]
+ ["Capitalize sentences" gnus-article-capitalize-sentences t]
["CR" gnus-article-remove-cr t]
["Show X-Face" gnus-article-display-x-face t]
["Quoted-Printable" gnus-article-de-quoted-unreadable t]
- ["UnHTMLize" gnus-article-treat-html t]
- ["Rot 13" gnus-summary-caesar-message t]
+ ["Base64" gnus-article-de-base64-unreadable t]
+ ["Rot 13" gnus-summary-caesar-message
+ ,@(if (featurep 'xemacs) nil
+ '(: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]
["Verbose header" gnus-summary-verbose-headers t]
- ["Toggle header" gnus-summary-toggle-header t])
+ ["Toggle header" gnus-summary-toggle-header t]
+ ["Html" gnus-article-wash-html 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) nil
+ '(:help "Save article using default method"))]
+ ["Save in file" gnus-summary-save-article-file
+ ,@(if (featurep 'xemacs) nil
+ '(: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]
(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) nil
+ '(: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]
("Cache"
["Enter article" gnus-cache-enter-article t]
["Remove article" gnus-cache-remove-article t])
+ ["Translate" gnus-article-babel t]
["Select article buffer" gnus-summary-select-article-buffer t]
["Enter digest buffer" gnus-summary-enter-digest-group t]
["Isearch article..." gnus-summary-isearch-article t]
["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 ""
["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) nil
+ '(:help "Post an article"))]
+ ["Followup" gnus-summary-followup
+ ,@(if (featurep 'xemacs) nil
+ '(:help "Post followup to this article"))]
+ ["Followup and yank" gnus-summary-followup-with-original
+ ,@(if (featurep 'xemacs) nil
+ '(: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) nil
+ '(: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) nil
+ '(:help "Mail a reply, quoting this article"))]
["Mail forward" gnus-summary-mail-forward t]
["Post forward" gnus-summary-post-forward t]
["Digest and mail" gnus-uu-digest-mail-forward t]
["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) nil
+ '(: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]
(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) nil
+ '(: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]
["Subject..." gnus-summary-limit-to-subject t]
["Author..." gnus-summary-limit-to-author t]
["Age..." gnus-summary-limit-to-age t]
+ ["Extra..." gnus-summary-limit-to-extra t]
["Score" gnus-summary-limit-to-score t]
["Unread" gnus-summary-limit-to-unread t]
["Non-dormant" gnus-summary-limit-exclude-dormant t]
["Hide childless dormant"
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])
("Process Mark"
["Set mark" gnus-summary-mark-as-processable t]
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) nil
+ '(:help "Show next page of article"))]
+ ["Page backward" gnus-summary-prev-page
+ ,@(if (featurep 'xemacs) nil
+ '(:help "Show previous page of article"))]
["Line forward" gnus-summary-scroll-up t])
("Move"
["Next unread article" gnus-summary-next-unread-article t]
["Sort by subject" gnus-summary-sort-by-subject t]
["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 lines" gnus-summary-sort-by-lines t]
+ ["Sort by characters" gnus-summary-sort-by-chars t])
("Help"
["Fetch group FAQ" gnus-summary-fetch-faq t]
["Describe group" gnus-summary-describe-group t]
["Customize group parameters" gnus-summary-customize-parameters t]
["Send a bug report" gnus-bug t]
("Exit"
- ["Catchup and exit" gnus-summary-catchup-and-exit t]
+ ["Catchup and exit" gnus-summary-catchup-and-exit
+ ,@(if (featurep 'xemacs) nil
+ '(: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) nil
+ '(: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]
(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)
(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)
\\{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)
(make-local-variable 'gnus-summary-dummy-line-format)
(make-local-variable 'gnus-summary-dummy-line-format-spec)
(make-local-variable 'gnus-summary-mark-positions)
- (make-local-hook 'post-command-hook)
- (add-hook 'post-command-hook 'gnus-clear-inboxes-moved nil t)
(make-local-hook 'pre-command-hook)
(add-hook 'pre-command-hook 'gnus-set-global-variables nil t)
(gnus-run-hooks 'gnus-summary-mode-hook)
- (mm-enable-multibyte)
+ (turn-on-gnus-mailing-list-mode)
+ (mm-enable-multibyte-mule4)
(gnus-update-format-specifications nil 'summary 'summary-mode 'summary-dummy)
(gnus-update-summary-mark-positions))
(defun gnus-summary-make-local-variables ()
"Make all the local summary buffer variables."
- (let ((locals gnus-summary-local-variables)
- global local)
- (while (setq local (pop locals))
+ (let (global)
+ (dolist (local gnus-summary-local-variables)
(if (consp local)
(progn
(if (eq (cdr local) 'global)
(setq global (symbol-value (car local)))
;; Use the value from the list.
(setq global (eval (cdr local))))
- (make-local-variable (car local))
- (set (car local) global))
+ (set (make-local-variable (car local)) global))
;; Simple nil-valued local variable.
- (make-local-variable local)
- (set local nil)))))
+ (set (make-local-variable local) nil)))))
(defun gnus-summary-clear-local-variables ()
(let ((locals gnus-summary-local-variables))
(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.
(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)
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)
(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
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)
(defun gnus-summary-last-article-p (&optional article)
"Return whether ARTICLE is the last article in the buffer."
(if (not (setq article (or article (gnus-summary-article-number))))
- t ; All non-existent numbers are the last article. :-)
+ ;; All non-existent numbers are the last article. :-)
+ t
(not (cdr (gnus-data-find-list article)))))
(defun gnus-make-thread-indent-array ()
(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-charset gnus-newsgroup-charset)
+ (mail-parse-ignored-charsets
+ (save-excursion (set-buffer gnus-summary-buffer)
+ gnus-newsgroup-ignored-charsets)))
(cond
((and to
gnus-ignored-from-addresses
(if (or (null gnus-summary-default-score)
(<= (abs (- gnus-tmp-score gnus-summary-default-score))
gnus-summary-zcore-fuzz))
- ?
+ ? ;Whitespace
(if (< gnus-tmp-score gnus-summary-default-score)
gnus-score-below-mark gnus-score-over-mark)))
(gnus-tmp-replied
(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
(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.
(if (or (null gnus-summary-default-score)
(<= (abs (- score gnus-summary-default-score))
gnus-summary-zcore-fuzz))
- ?
+ ? ;Whitespace
(if (< score gnus-summary-default-score)
gnus-score-below-mark gnus-score-over-mark))
'score))
(gnus-summary-set-local-parameters gnus-newsgroup-name)
(gnus-update-format-specifications
nil 'summary 'summary-mode 'summary-dummy)
+ (gnus-update-summary-mark-positions)
;; Do score processing.
(when gnus-use-scoring
(gnus-possibly-score-headers))
(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))
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))
(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)
;; 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)))
(setq heads nil)))))
gnus-newsgroup-dependencies)))
-(defmacro gnus-nov-read-integer ()
- '(prog1
- (if (eq (char-after) ?\t)
- 0
- (let ((num (ignore-errors (read buffer))))
- (if (numberp num) num 0)))
- (unless (eobp)
- (search-forward "\t" eol 'move))))
-
-(defmacro gnus-nov-skip-field ()
- '(search-forward "\t" eol 'move))
-
-(defmacro gnus-nov-field ()
- '(buffer-substring (point) (if (gnus-nov-skip-field) (1- (point)) eol)))
-
-(defmacro gnus-nov-parse-extra ()
- '(let (out string)
- (while (not (memq (char-after) '(?\n nil)))
- (setq string (gnus-nov-field))
- (when (string-match "^\\([^ :]+\\): " string)
- (push (cons (intern (match-string 1 string))
- (substring string (match-end 0)))
- out)))
- out))
-
;; This function has to be called with point after the article number
;; on the beginning of the line.
(defsubst gnus-nov-parse-line (number dependencies &optional force-new)
(make-full-mail-header
number ; number
(funcall gnus-decode-encoded-word-function
- (gnus-nov-field)) ; subject
+ (nnheader-nov-field)) ; subject
(funcall gnus-decode-encoded-word-function
- (gnus-nov-field)) ; from
- (gnus-nov-field) ; date
- (or (gnus-nov-field)
- (nnheader-generate-fake-message-id)) ; id
- (gnus-nov-field) ; refs
- (gnus-nov-read-integer) ; chars
- (gnus-nov-read-integer) ; lines
- (unless (eq (char-after) ?\n)
- (gnus-nov-field)) ; misc
- (gnus-nov-parse-extra)))) ; extra
+ (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))
(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
(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
(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)
(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))
(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)
(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)
(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)
;; Written by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>.
(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)
(gnus-article-sort-by-lines
(gnus-thread-header h1) (gnus-thread-header h2)))
+(defsubst gnus-article-sort-by-chars (h1 h2)
+ "Sort articles by octet length."
+ (< (mail-header-chars h1)
+ (mail-header-chars h2)))
+
+(defun gnus-thread-sort-by-chars (h1 h2)
+ "Sort threads by root article octet length."
+ (gnus-article-sort-by-chars
+ (gnus-thread-header h1) (gnus-thread-header h2)))
+
(defsubst gnus-article-sort-by-author (h1 h2)
"Sort articles by root author."
(string-lessp
(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))))
(if (or (null gnus-summary-default-score)
(<= (abs (- gnus-tmp-score gnus-summary-default-score))
gnus-summary-zcore-fuzz))
- ?
+ ? ;Whitespace
(if (< gnus-tmp-score gnus-summary-default-score)
gnus-score-below-mark gnus-score-over-mark))
gnus-tmp-replied
(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
(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 (stringp gnus-list-identifiers)
+ gnus-list-identifiers
+ (mapconcat 'identity gnus-list-identifiers " *\\|"))))
+ (dolist (header gnus-newsgroup-headers)
+ (when (string-match (concat "\\(\\(\\(Re: +\\)?\\(" regexp
+ " *\\)\\)+\\(Re: +\\)?\\)")
+ (mail-header-subject header))
+ (mail-header-set-subject
+ header (concat (substring (mail-header-subject header)
+ 0 (match-beginning 1))
+ (or
+ (match-string 3 (mail-header-subject header))
+ (match-string 5 (mail-header-subject header)))
+ (substring (mail-header-subject header)
+ (match-end 1))))))))
+
(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.
(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)
;; 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))
(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.
(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))
'<)))
(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
(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)
out))
(defun gnus-adjust-marked-articles (info)
- "Set all article lists and remove all marks that are no longer legal."
+ "Set all article lists and remove all marks that are no longer valid."
(let* ((marked-lists (gnus-info-marks info))
(active (gnus-active (gnus-info-group info)))
(min (car active))
(uncompressed '(score bookmark killed))
type list newmarked symbol delta-marks)
(when info
- ;; Add all marks lists that are non-nil to the list of marks lists.
+ ;; Add all marks lists to the list of marks lists.
(while (setq type (pop types))
- (when (setq list (symbol-value
- (setq symbol
- (intern (format "gnus-newsgroup-%s"
- (car type))))))
+ (setq list (symbol-value
+ (setq symbol
+ (intern (format "gnus-newsgroup-%s"
+ (car type))))))
+ (when list
;; Get rid of the entries of the articles that have the
;; default score.
(when (and (eq (cdr type) 'score)
(setcdr prev (cdr arts))
(setq prev arts))
(setq arts (cdr arts)))
- (setq list (cdr all))))
-
- (when (gnus-check-backend-function 'request-set-mark
- gnus-newsgroup-name)
- ;; score & bookmark are not proper flags (they are cons cells)
- ;; cache is a internal gnus flag
- (unless (memq (cdr type) '(cache score bookmark))
- (let* ((old (cdr (assq (cdr type) (gnus-info-marks info))))
- (del (gnus-remove-from-range old list))
- (add (gnus-remove-from-range list old)))
- (if add
- (push (list add 'add (list (cdr type))) delta-marks))
- (if del
- (push (list del 'del (list (cdr type))) delta-marks)))))
-
- (push (cons (cdr type)
- (if (memq (cdr type) uncompressed) list
- (gnus-compress-sequence
- (set symbol (sort list '<)) t)))
- newmarked)))
-
- (if delta-marks
- (gnus-request-set-mark gnus-newsgroup-name delta-marks))
-
+ (setq list (cdr all)))))
+
+ (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)))
+
+ (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)
(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)
(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-name-decode
+ gnus-newsgroup-name
+ (gnus-group-name-charset
+ nil
+ 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))
(active (gnus-active group))
ninfo)
(when entry
- ;; First peel off all illegal article numbers.
+ ;; First peel off all invalid article numbers.
(when active
(let ((ids articles)
id first)
;; Update the group buffer.
(gnus-group-update-group group t)))))
-(defun gnus-methods-equal-p (m1 m2)
- (let ((m1 (or m1 gnus-select-method))
- (m2 (or m2 gnus-select-method)))
- (or (equal m1 m2)
- (and (eq (car m1) (car m2))
- (or (not (memq 'address (assoc (symbol-name (car m1))
- gnus-valid-select-methods)))
- (equal (nth 1 m1) (nth 1 m2)))))))
-
(defvar gnus-newsgroup-none-id 0)
(defun gnus-get-newsgroup-headers (&optional dependencies force-new)
(save-excursion (set-buffer gnus-summary-buffer)
gnus-newsgroup-dependencies)))
headers id end ref
- (mail-parse-charset gnus-newsgroup-charset))
+ (mail-parse-charset gnus-newsgroup-charset)
+ (mail-parse-ignored-charsets
+ (save-excursion (condition-case nil
+ (set-buffer gnus-summary-buffer)
+ (error))
+ gnus-newsgroup-ignored-charsets)))
(save-excursion
(set-buffer nntp-server-buffer)
;; Translate all TAB characters into SPACE characters.
;; From.
(progn
(goto-char p)
- (if (search-forward "\nfrom: " nil t)
+ (if (or (search-forward "\nfrom: " nil t)
+ (search-forward "\nfrom:" nil t))
(funcall gnus-decode-encoded-word-function
(nnheader-header-value))
"(nobody)"))
(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))
(let ((mail-parse-charset gnus-newsgroup-charset)
+ (mail-parse-ignored-charsets gnus-newsgroup-ignored-charsets)
(cur nntp-server-buffer)
(dependencies (or dependencies gnus-newsgroup-dependencies))
number headers header)
(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)))
`(let ((,articles (gnus-summary-work-articles ,arg)))
(while ,articles
(gnus-summary-goto-subject (car ,articles))
- ,@forms))))
+ ,@forms
+ (pop ,articles)))))
(put 'gnus-summary-iterate 'lisp-indent-function 1)
(put 'gnus-summary-iterate 'edebug-form-spec '(form body))
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)
;; 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)))
;; 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))
(key-binding
(read-key-sequence
(substitute-command-keys
- "\\<gnus-summary-mode-map>\\[gnus-summary-universal-argument]"
- ))))
+ "\\<gnus-summary-mode-map>\\[gnus-summary-universal-argument]"))))
'undefined)
(gnus-error 1 "Undefined key")
(save-excursion
(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)
(when (gnus-buffer-live-p gnus-article-buffer)
(save-excursion
(set-buffer gnus-article-buffer)
- (mm-destroy-parts gnus-article-mime-handles)))
+ (mm-destroy-parts gnus-article-mime-handles)
+ ;; Set it to nil for safety reason.
+ (setq gnus-article-mime-handle-alist nil)
+ (setq gnus-article-mime-handles nil)))
(gnus-kill-save-kill-buffer)
(gnus-async-halt-prefetch)
(let* ((group gnus-newsgroup-name)
(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.
;; 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)
+ (let ((gnus-summary-local-variables gnus-newsgroup-variables))
+ (gnus-summary-clear-local-variables))
;; Return to group mode buffer.
(when (eq mode 'gnus-summary-mode)
(gnus-kill-buffer buf)))
(gnus-y-or-n-p "Discard changes to this group and exit? "))
(gnus-async-halt-prefetch)
(mapcar 'funcall
- (delq 'gnus-summary-expire-articles
- (copy-list gnus-summary-prepare-exit-hook)))
+ (delq 'gnus-summary-expire-articles
+ (copy-sequence gnus-summary-prepare-exit-hook)))
(when (gnus-buffer-live-p gnus-article-buffer)
(save-excursion
(set-buffer gnus-article-buffer)
- (mm-destroy-parts gnus-article-mime-handles)))
+ (mm-destroy-parts gnus-article-mime-handles)
+ ;; Set it to nil for safety reason.
+ (setq gnus-article-mime-handle-alist nil)
+ (setq gnus-article-mime-handles nil)))
;; If we have several article buffers, we kill them at exit.
(unless gnus-single-article-buffer
(gnus-kill-buffer gnus-article-buffer)
(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
(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."
(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" "")))
(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
+ (mm-enable-multibyte-mule4)))
(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)
+ (mm-enable-multibyte-mule4)))
(if (null article)
nil
(prog1
(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))
+ (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 (gnus-buffer-live-p gnus-article-buffer)
+ (with-current-buffer gnus-article-buffer
+ (if (not gnus-article-decoded-p) ;; a local variable
+ (mm-disable-multibyte-mule4))))
(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."
"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 "nTime 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))
(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
(gnus-summary-limit (nreverse articles)))
(gnus-summary-position-point)))
+(defun gnus-summary-limit-to-extra (header regexp)
+ "Limit the summary buffer to articles that match an 'extra' header."
+ (interactive
+ (let ((header
+ (intern
+ (gnus-completing-read
+ (symbol-name (car gnus-extra-headers))
+ "Limit extra header:"
+ (mapcar (lambda (x)
+ (cons (symbol-name x) x))
+ gnus-extra-headers)
+ nil
+ t))))
+ (list header
+ (read-string (format "Limit to header %s (regexp): " header)))))
+ (when (not (equal "" regexp))
+ (prog1
+ (let ((articles (gnus-summary-find-matching
+ (cons 'extra header) regexp 'all)))
+ (unless articles
+ (error "Found no matches for \"%s\"" regexp))
+ (gnus-summary-limit articles))
+ (gnus-summary-position-point))))
+
(defalias 'gnus-summary-delete-marked-as-read 'gnus-summary-limit-to-unread)
(make-obsolete
'gnus-summary-delete-marked-as-read 'gnus-summary-limit-to-unread)
"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.
"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))
(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))
(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
(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.
(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
(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."
(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
(goto-char (point-min))
(or (search-forward "\n\n" nil t) (point)))
(goto-char (point-min))
- (delete-matching-lines "^\\(Path\\):\\|^From ")
+ (delete-matching-lines "^Path:\\|^From ")
(widen))
(unwind-protect
- (if (gnus-group-read-ephemeral-group
- name `(nndoc ,name (nndoc-address ,(get-buffer dig))
- (nndoc-article-type
- ,(if force 'digest 'guess))) t)
- ;; Make all postings to this group go to the parent group.
+ (if (let ((gnus-newsgroup-ephemeral-charset gnus-newsgroup-charset)
+ (gnus-newsgroup-ephemeral-ignored-charsets
+ gnus-newsgroup-ignored-charsets))
+ (gnus-group-read-ephemeral-group
+ name `(nndoc ,name (nndoc-address ,(get-buffer dig))
+ (nndoc-article-type
+ ,(if force 'mbox 'guess))) t))
+ ;; Make all postings to this group go to the parent group.
(nconc (gnus-info-params (gnus-get-info name))
params)
;; Couldn't select this doc group.
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."
(require 'gnus-async)
(require 'gnus-art)
(let ((gnus-select-article-hook nil) ;Disable hook.
+ (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-save-hidden-threads
(gnus-summary-select-article)
(set-buffer gnus-article-buffer)
+ (goto-char (window-point (get-buffer-window (current-buffer))))
(when backward
(forward-line -1))
(while (not found)
(get-buffer-window (current-buffer))
(point))
(forward-line 1)
+ (set-window-point
+ (get-buffer-window (current-buffer))
+ (point))
(set-buffer sum)
(setq point (point)))
;; We didn't find it, so we go to the next article.
(let ((data (if (eq backward 'all) gnus-newsgroup-data
(gnus-data-find-list
(gnus-summary-article-number) (gnus-data-list backward))))
- (func `(lambda (h) (,(intern (concat "mail-header-" header)) h)))
(case-fold-search (not not-case-fold))
- articles d)
- (unless (fboundp (intern (concat "mail-header-" header)))
- (error "%s is not a valid header" header))
+ articles d func)
+ (if (consp header)
+ (if (eq (car header) 'extra)
+ (setq func
+ `(lambda (h)
+ (or (cdr (assq ',(cdr header) (mail-header-extra h)))
+ "")))
+ (error "%s is an invalid header" header))
+ (unless (fboundp (intern (concat "mail-header-" header)))
+ (error "%s is not a valid header" header))
+ (setq func `(lambda (h) (,(intern (concat "mail-header-" header)) h))))
(while data
(setq d (car data))
(and (or (not unread) ; We want all articles...
If N is negative, print the N previous articles. If N is nil and articles
have been marked with the process mark, print these instead.
-If the optional second argument FILENAME is nil, send the image to the
+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."
(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)
gnus-article-prepare-hook
gnus-article-decode-hook
gnus-display-mime-function
- gnus-break-pages
- gnus-visual)
+ gnus-break-pages)
;; Destroy any MIME parts.
(when (gnus-buffer-live-p gnus-article-buffer)
(save-excursion
(set-buffer gnus-article-buffer)
- (mm-destroy-parts gnus-article-mime-handles)))
- (gnus-summary-select-article nil 'force)))
+ (mm-destroy-parts gnus-article-mime-handles)
+ ;; Set it to nil for safety reason.
+ (setq gnus-article-mime-handle-alist nil)
+ (setq gnus-article-mime-handles nil)))
+ (gnus-summary-select-article nil 'force))))
(gnus-summary-goto-subject gnus-current-article)
(gnus-summary-position-point))
(interactive "P")
(save-excursion
(set-buffer gnus-article-buffer)
- (let* ((buffer-read-only nil)
- (inhibit-point-motion-hooks t)
- (hidden (text-property-any
- (goto-char (point-min)) (search-forward "\n\n")
- 'invisible t))
- e)
- (goto-char (point-min))
- (when (search-forward "\n\n" nil t)
- (delete-region (point-min) (1- (point))))
- (goto-char (point-min))
- (save-excursion
- (set-buffer gnus-original-article-buffer)
+ (save-restriction
+ (let* ((buffer-read-only nil)
+ (inhibit-point-motion-hooks t)
+ hidden e)
+ (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))))
(goto-char (point-min))
- (setq e (1- (or (search-forward "\n\n" nil t) (point-max)))))
- (insert-buffer-substring gnus-original-article-buffer 1 e)
- (narrow-to-region (point-min) (point))
- (if (or (not hidden) (and (numberp arg) (< arg 0)))
- (let ((gnus-treat-hide-headers nil)
- (gnus-treat-hide-boring-headers nil))
- (gnus-treat-article 'head))
- (gnus-treat-article 'head)))))
+ (save-excursion
+ (set-buffer gnus-original-article-buffer)
+ (goto-char (point-min))
+ (setq e (1- (or (search-forward "\n\n" nil t) (point-max)))))
+ (insert-buffer-substring gnus-original-article-buffer 1 e)
+ (save-restriction
+ (narrow-to-region (point-min) (point))
+ (article-decode-encoded-words)
+ (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-set-mode-line 'article)))))
(defun gnus-summary-show-all-headers ()
"Make all header lines visible."
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))
'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")))
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))
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)
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))
(entry
(gnus-gethash pto-group gnus-newsrc-hashtb))
(info (nth 2 entry))
- (to-group (gnus-info-group info)))
+ (to-group (gnus-info-group info))
+ to-marks)
;; Update the group that has been moved to.
(when (and info
(memq action '(move copy)))
(push to-group to-groups))
(unless (memq article gnus-newsgroup-unreads)
+ (push 'read to-marks)
(gnus-info-set-read
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 gnus-article-mark-lists)
(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
- (let ((header (copy-sequence
- (gnus-summary-article-header article))))
- (mail-header-set-number header to-article)
- header)
(memq article gnus-newsgroup-marked)
(memq article gnus-newsgroup-dormant)
(memq article gnus-newsgroup-unreads)))
- (when (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)))))
- ;; 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)))
+ (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 '"
(save-excursion
(set-buffer (gnus-get-buffer-create " *import file*"))
(erase-buffer)
- (insert-file-contents file)
+ (nnheader-insert-file-contents file)
(goto-char (point-min))
(unless (nnheader-article-p)
;; This doesn't look like an article, so we fudge some headers.
(kill-buffer (current-buffer)))))
(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)
(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
;; through the expiry process.
(gnus-message 6 "Expiring articles...")
+ (unless (gnus-check-group gnus-newsgroup-name)
+ (error "Can't open server for %s" gnus-newsgroup-name))
;; The list of articles that weren't expired is returned.
(save-excursion
(if expiry-wait
(setq es (gnus-request-expire-articles
expirable gnus-newsgroup-name)))
(setq es (gnus-request-expire-articles
- expirable gnus-newsgroup-name))))
- (unless total
- (setq gnus-newsgroup-expirable es))
- ;; We go through the old list of expirable, and mark all
- ;; 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 ()
(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)
(gnus-set-mode-line 'summary)
not-deleted))
-(defun gnus-summary-edit-article (&optional force)
+(defun gnus-summary-edit-article (&optional arg)
"Edit the current article.
This will have permanent effect only in mail groups.
-If FORCE is non-nil, allow editing of articles even in read-only
+If ARG is nil, edit the decoded articles.
+If ARG is 1, edit the raw articles.
+If ARG is 2, edit the raw articles even in read-only groups.
+If ARG is 3, edit the articles with the current handles.
+Otherwise, allow editing of articles even in read-only
groups."
(interactive "P")
- (save-excursion
- (set-buffer gnus-summary-buffer)
- (gnus-set-global-variables)
- (when (and (not force)
- (gnus-group-read-only-p))
- (error "The current newsgroup does not support article editing"))
- ;; Select article if needed.
- (unless (eq (gnus-summary-article-number)
- gnus-current-article)
- (gnus-summary-select-article t))
- (gnus-article-date-original)
- (gnus-article-edit-article
- `(lambda (no-highlight)
- (gnus-summary-edit-article-done
- ,(or (mail-header-references gnus-current-headers) "")
- ,(gnus-group-read-only-p) ,gnus-summary-buffer no-highlight)))))
+ (let (force raw current-handles)
+ (cond
+ ((null arg))
+ ((eq arg 1) (setq raw t))
+ ((eq arg 2) (setq raw t
+ force t))
+ ((eq arg 3) (setq current-handles
+ (and (gnus-buffer-live-p gnus-article-buffer)
+ (with-current-buffer gnus-article-buffer
+ (prog1
+ gnus-article-mime-handles
+ (setq gnus-article-mime-handles nil))))))
+ (t (setq force t)))
+ (if (and raw (not force) (equal gnus-newsgroup-name "nndraft:drafts"))
+ (error "Can't edit the raw article in group nndraft:drafts."))
+ (save-excursion
+ (set-buffer gnus-summary-buffer)
+ (let ((mail-parse-charset gnus-newsgroup-charset)
+ (mail-parse-ignored-charsets gnus-newsgroup-ignored-charsets))
+ (gnus-set-global-variables)
+ (when (and (not force)
+ (gnus-group-read-only-p))
+ (error "The current newsgroup does not support article editing"))
+ (gnus-summary-show-article t)
+ (when (and (not raw) (gnus-buffer-live-p gnus-article-buffer))
+ (with-current-buffer gnus-article-buffer
+ (mm-enable-multibyte-mule4)))
+ (if (equal gnus-newsgroup-name "nndraft:drafts")
+ (setq raw t))
+ (gnus-article-edit-article
+ (if raw 'ignore
+ `(lambda ()
+ (let ((mbl mml-buffer-list))
+ (setq mml-buffer-list nil)
+ (mime-to-mml ,'current-handles)
+ (make-local-hook 'kill-buffer-hook)
+ (let ((mbl1 mml-buffer-list))
+ (setq mml-buffer-list mbl)
+ (set (make-local-variable 'mml-buffer-list) mbl1))
+ (add-hook 'kill-buffer-hook 'mml-destroy-buffers t t))))
+ `(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))
+ ,(if (not raw) '(progn
+ (mml-to-mime)
+ (mml-destroy-buffers)
+ (remove-hook 'kill-buffer-hook
+ 'mml-destroy-buffers t)
+ (kill-local-variable 'mml-buffer-list)))
+ (gnus-summary-edit-article-done
+ ,(or (mail-header-references gnus-current-headers) "")
+ ,(gnus-group-read-only-p)
+ ,gnus-summary-buffer no-highlight))))))))
(defalias 'gnus-summary-edit-article-postpone 'gnus-article-edit-exit)
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 buf)
+ (insert-buffer-substring buf)
+
(if (and (not read-only)
(not (gnus-request-replace-article
(cdr gnus-article-current) (car gnus-article-current)
- (current-buffer)
- (not gnus-article-decoded-p))))
+ (current-buffer) t)))
(error "Couldn't replace article")
;; Update the summary buffer.
(if (and references
"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))
(save-excursion
(gnus-cache-possibly-enter-article
gnus-newsgroup-name article
- (gnus-summary-article-header article)
(= mark gnus-ticked-mark)
(= mark gnus-dormant-mark) (= mark gnus-unread-mark))))
`??' (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)))
(save-excursion
(gnus-cache-possibly-enter-article
gnus-newsgroup-name article
- (gnus-summary-article-header article)
(= mark gnus-ticked-mark)
(= mark gnus-dormant-mark) (= mark gnus-unread-mark))))
The difference between N and the actual number of articles marked is
returned."
(interactive "p")
- (gnus-summary-mark-forward (- n) gnus-del-mark gnus-inhibit-user-auto-expire))
+ (gnus-summary-mark-forward
+ (- n) gnus-del-mark gnus-inhibit-user-auto-expire))
(defun gnus-summary-mark-as-read (&optional article mark)
"Mark current article as read.
(gnus-summary-catchup t quietly))
(defun gnus-summary-catchup-and-exit (&optional all quietly)
- "Mark all articles not marked as unread in this newsgroup as read, then exit.
+ "Mark all unread articles in this group as read, then exit.
If prefix argument ALL is non-nil, all articles are marked as read."
(interactive "P")
(when (gnus-summary-catchup all quietly nil 'fast)
(interactive "P")
(gnus-summary-catchup-and-exit t quietly))
-;; Suggested by "Arne Eofsson" <arne@hodgkin.mbi.ucla.edu>.
(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
(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.
(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)
(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.
(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))
(gnus-summary-sort 'score reverse))
(defun gnus-summary-sort-by-lines (&optional reverse)
- "Sort the summary buffer by article length.
+ "Sort the summary buffer by the number of lines.
Argument REVERSE means reverse order."
(interactive "P")
(gnus-summary-sort 'lines reverse))
+(defun gnus-summary-sort-by-chars (&optional reverse)
+ "Sort the summary buffer by article length.
+Argument REVERSE means reverse order."
+ (interactive "P")
+ (gnus-summary-sort 'chars reverse))
+
(defun gnus-summary-sort (predicate reverse)
"Sort summary buffer by PREDICATE. REVERSE means reverse order."
(let* ((thread (intern (format "gnus-thread-sort-by-%s" predicate)))
thread
`(lambda (t1 t2)
(,thread t2 t1))))
+ (gnus-sort-gathered-threads-function
+ gnus-thread-sort-functions)
(gnus-article-sort-functions
(if (not reverse)
article
(save-buffer (save-excursion
(nnheader-set-temp-buffer " *Gnus Save*")))
(num (length articles))
- header article file)
- (while articles
- (setq header (gnus-summary-article-header
- (setq article (pop articles))))
+ header file)
+ (dolist (article articles)
+ (setq header (gnus-summary-article-header article))
(if (not (vectorp header))
;; This is a pseudo-article.
(if (assq 'name header)
If N is nil and any articles have been marked with the process mark,
save those articles instead."
(interactive "P")
- (let ((gnus-default-article-saver 'rmail-output-to-rmail-file))
+ (let ((gnus-default-article-saver 'gnus-summary-save-in-rmail))
(gnus-summary-save-article arg)))
(defun gnus-summary-save-article-file (&optional arg)
(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))
(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)
split-name))
((consp result)
(setq split-name (append result split-name)))))))))
- split-name))
+ (nreverse split-name)))
(defun gnus-valid-move-group-p (group)
(and (boundp group)
(symbol-name group)
(symbol-value group)
- (memq 'respool
- (assoc (symbol-name
- (car (gnus-find-method-for-group
- (symbol-name group))))
- gnus-valid-select-methods))))
+ (gnus-get-function (gnus-find-method-for-group
+ (symbol-name group)) 'request-accept-article t)))
(defun gnus-read-move-group-name (prompt default articles prefix)
"Read a group name."
(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))
(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 &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: "
+ (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)
+ (gnus-inhibit-treatment t))
+ (gnus-summary-select-article))
+ (save-excursion
+ (set-buffer gnus-article-buffer)
+ (let ((handles (or gnus-article-mime-handles
+ (mm-dissect-buffer) (mm-uu-dissect))))
+ (when handles
+ (gnus-summary-save-parts-1 type dir handles reverse)
+ (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))
+ (mapcar (lambda (h) (gnus-summary-save-parts-1 type dir h reverse))
+ (cdr handle))
+ (when (if reverse
+ (not (string-match type (mm-handle-media-type handle)))
+ (string-match type (mm-handle-media-type handle)))
+ (let ((file (expand-file-name
+ (file-name-nondirectory
+ (or
+ (mail-content-type-get
+ (mm-handle-disposition handle) 'filename)
+ (concat gnus-newsgroup-name
+ "." (number-to-string
+ (cdr gnus-article-current)))))
+ dir)))
+ (unless (file-exists-p file)
+ (mm-save-part-to-file handle file))))))
+
;; Summary extract commands
(defun gnus-summary-insert-pseudos (pslist &optional not-view)
"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.
;;;
(defun gnus-highlight-selected-summary ()
+ "Highlight selected article in summary buffer."
;; Added by Per Abrahamsen <amanda@iesd.auc.dk>.
- ;; Highlight selected article in summary buffer
(when gnus-summary-selected-face
(save-excursion
(let* ((beg (progn (beginning-of-line) (point)))
(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)
- (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.
(defun gnus-summary-setup-default-charset ()
"Setup newsgroup default charset."
- (let ((name (and gnus-newsgroup-name
- (gnus-group-real-name gnus-newsgroup-name))))
- (setq gnus-newsgroup-charset
- (or (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))))
-
+ (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)
+ (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))))
+
;;;
;;; Mime Commands
;;;
(defun gnus-summary-display-buttonized (&optional show-all-parts)
- "Display the current article buffer fully MIME-buttonized.
+ "Display the current article buffer fully MIME-buttonized.
If SHOW-ALL-PARTS (the prefix) is non-nil, all multipart/* parts are
treated as multipart/mixed."
(interactive "P")
(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)))
(let ((gnus-unbuttonized-mime-types nil))
(gnus-summary-show-article))
(gnus-summary-show-article)))
+
+;;;
+;;; Generic summary marking commands
+;;;
+
+(defvar gnus-summary-marking-alist
+ '((read gnus-del-mark "d")
+ (unread gnus-unread-mark "u")
+ (ticked gnus-ticked-mark "!")
+ (dormant gnus-dormant-mark "?")
+ (expirable gnus-expirable-mark "e"))
+ "An alist of names/marks/keystrokes.")
+
+(defvar gnus-summary-generic-mark-map (make-sparse-keymap))
+(defvar gnus-summary-mark-map)
+
+(defun gnus-summary-make-all-marking-commands ()
+ (define-key gnus-summary-mark-map "M" gnus-summary-generic-mark-map)
+ (dolist (elem gnus-summary-marking-alist)
+ (apply 'gnus-summary-make-marking-command elem)))
+
+(defun gnus-summary-make-marking-command (name mark keystroke)
+ (let ((map (make-sparse-keymap)))
+ (define-key gnus-summary-generic-mark-map keystroke map)
+ (dolist (lway `((next "next" next nil "n")
+ (next-unread "next unread" next t "N")
+ (prev "previous" prev nil "p")
+ (prev-unread "previous unread" prev t "P")
+ (nomove "" nil nil ,keystroke)))
+ (let ((func (gnus-summary-make-marking-command-1
+ 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 ,(intern
+ (format "gnus-summary-put-mark-as-%s%s"
+ name (if (eq way 'nomove)
+ ""
+ (concat "-" (symbol-name way)))))
+ (n)
+ ,(format
+ "Mark the current article as %s%s.
+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))
+ (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)
+ (error "This command can only be used in the summary buffer"))
+ (gnus-summary-show-thread)
+ (let ((nummove
+ (cond
+ ((eq move 'next) 1)
+ ((eq move 'prev) -1)
+ (t 0))))
+ (if (zerop nummove)
+ (setq n 1)
+ (when (< n 0)
+ (setq n (abs n)
+ nummove (* -1 nummove))))
+ (while (and (> n 0)
+ (gnus-summary-mark-article nil mark)
+ (zerop (gnus-summary-next-subject nummove unread t)))
+ (setq n (1- n)))
+ (when (/= 0 n)
+ (gnus-message 7 "No more %sarticles" (if mark "" "unread ")))
+ (gnus-summary-recenter)
+ (gnus-summary-position-point)
+ (gnus-set-mode-line 'summary)
+ n))
+
+(gnus-summary-make-all-marking-commands)
+
(gnus-ems-redefine)
(provide 'gnus-sum)
projects / gnus / blobdiff