;;; gnus-sum.el --- summary mode commands for Gnus
-;; Copyright (C) 1996,97,98 Free Software Foundation, Inc.
+;; Copyright (C) 1996,97,98,99 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
(require 'gnus-range)
(require 'gnus-int)
(require 'gnus-undo)
+(require 'gnus-util)
+(require 'mm-decode)
(autoload 'gnus-summary-limit-include-cached "gnus-cache" nil t)
(defcustom gnus-kill-summary-on-exit t
:group 'gnus-thread
:type 'boolean)
-(defcustom gnus-thread-ignore-subject nil
- "*If non-nil, ignore subjects and do all threading based on the Reference header.
-If nil, which is the default, articles that have different subjects
-from their parents will start separate threads."
+(defcustom gnus-thread-ignore-subject t
+ "*If non-nil, which is the default, ignore subjects and do all threading based on the Reference header.
+If nil, articles that have different subjects from their parents will
+start separate threads."
:group 'gnus-thread
:type 'boolean)
(defcustom gnus-auto-select-first t
"*If nil, don't select the first unread article when entering a group.
If this variable is `best', select the highest-scored unread article
-in the group. If neither nil nor `best', select the first unread
-article.
+in the group. If t, select the first unread article.
+
+This variable can also be a function to place point on a likely
+subject line. Useful values include `gnus-summary-first-unread-subject',
+`gnus-summary-first-unread-article' and
+`gnus-summary-best-unread-article'.
If you want to prevent automatic selection of the first unread article
in some newsgroups, set the variable to nil in
:group 'gnus-group-select
:type '(choice (const :tag "none" nil)
(const best)
- (sexp :menu-tag "first" t)))
+ (sexp :menu-tag "first" t)
+ (function-item gnus-summary-first-unread-subject)
+ (function-item gnus-summary-first-unread-article)
+ (function-item gnus-summary-best-unread-article)))
(defcustom gnus-auto-select-next t
"*If non-nil, offer to go to the next group from the end of the previous.
(sexp :menu-tag "on" t)))
(defcustom gnus-auto-select-same nil
- "*If non-nil, select the next article with the same subject."
+ "*If non-nil, select the next article with the same subject.
+If there are no more articles with the same subject, go to
+the first unread article."
:group 'gnus-summary-maneuvering
:type 'boolean)
:group 'gnus-summary-maneuvering
:type '(choice (const :tag "none" nil)
(const vertical)
+ (integer :tag "height")
(sexp :menu-tag "both" t)))
(defcustom gnus-show-all-headers nil
"*If non-nil, ignore articles with identical Message-ID headers."
:group 'gnus-summary
:type 'boolean)
-
+
(defcustom gnus-single-article-buffer t
"*If non-nil, display all articles in the same buffer.
If nil, each group will get its own article buffer."
:group 'gnus-article-various
:type 'boolean)
-(defcustom gnus-show-mime nil
- "*If non-nil, do mime processing of articles.
-The articles will simply be fed to the function given by
-`gnus-show-mime-method'."
- :group 'gnus-article-mime
- :type 'boolean)
-
(defcustom gnus-move-split-methods nil
"*Variable used to suggest where articles are to be moved to.
It uses the same syntax as the `gnus-split-methods' variable."
(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)
:group 'gnus-extract-view
:type 'boolean)
+(defcustom gnus-auto-expirable-marks
+ (list gnus-killed-mark gnus-del-mark gnus-catchup-mark
+ gnus-low-score-mark gnus-ancient-mark gnus-read-mark
+ gnus-souped-mark gnus-duplicate-mark)
+ "*The list of marks converted into expiration if a group is auto-expirable."
+ :group 'gnus-summary
+ :type '(repeat character))
+
+(defcustom gnus-inhibit-user-auto-expire t
+ "*If non-nil, user marking commands will not mark an article as expirable, even if the group has auto-expire turned on."
+ :group 'gnus-summary
+ :type 'boolean)
+
(defcustom gnus-view-pseudos nil
"*If `automatic', pseudo-articles will be viewed automatically.
If `not-confirm', pseudos will be viewed automatically, and the user
:group 'gnus-threading
:type 'string)
-(defcustom gnus-summary-mode-line-format "Gnus: %%b [%A] %Z"
+(defcustom gnus-summary-mode-line-format "Gnus: %g [%A] %Z"
"*The format specification for the summary mode line.
It works along the same lines as a normal formatting string,
with some simple extensions:
%G Group name
%p Unprefixed group name
%A Current article number
+%z Current article score
%V Gnus version
%U Number of unread articles in the group
%e Number of unselected articles in the group
\"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))
:group 'gnus-summary-visual
:type 'hook)
-(defcustom gnus-structured-field-decoder 'identity
- "Function to decode non-ASCII characters in structured field for summary."
- :group 'gnus-various
- :type 'function)
-
-(defcustom gnus-unstructured-field-decoder 'identity
- "Function to decode non-ASCII characters in unstructured field for summary."
- :group 'gnus-various
- :type 'function)
-
-(defcustom gnus-parse-headers-hook
- (list 'gnus-hack-decode-rfc1522 'gnus-decode-rfc1522)
+(defcustom gnus-parse-headers-hook nil
"*A hook called before parsing the headers."
:group 'gnus-various
:type 'hook)
The function is called with one parameter, the article header vector,
which it may alter in any way.")
+(defvar gnus-decode-encoded-word-function 'mail-decode-encoded-word-string
+ "Variable that says which function should be used to decode a string with encoded words.")
+
+(defcustom gnus-extra-headers nil
+ "*Extra headers to parse."
+ :group 'gnus-summary
+ :type '(repeat symbol))
+
+(defcustom gnus-ignored-from-addresses
+ (and user-mail-address (regexp-quote user-mail-address))
+ "*Regexp of From headers that may be suppressed in favor of To headers."
+ :group 'gnus-summary
+ :type 'regexp)
+
+(defcustom gnus-group-charset-alist
+ '(("^hk\\>\\|^tw\\>\\|\\<big5\\>" cn-big5)
+ ("^cn\\>\\|\\<chinese\\>" cn-gb-2312)
+ ("^fj\\>\\|^japan\\>" iso-2022-jp-2)
+ ("^relcom\\>" koi8-r)
+ ("^\\(cz\\|hun\\|pl\\|sk\\|hr\\)\\>" iso-8859-2)
+ ("^israel\\>" iso-8859-1)
+ ("^han\\>" euc-kr)
+ ("^\\(comp\\|rec\\|alt\\|sci\\|soc\\|news\\|gnu\\|bofh\\)\\>" iso-8859-1)
+ (".*" iso-8859-1))
+ "Alist of regexps (to match group names) and default charsets to be used when reading."
+ :type '(repeat (list (regexp :tag "Group")
+ (symbol :tag "Charset")))
+ :group 'gnus-charset)
+
+(defcustom gnus-newsgroup-ignored-charsets '(unknown-8bit)
+ "List of charsets that should be ignored.
+When these charsets are used in the \"charset\" parameter, the
+default charset will be used instead."
+ :type '(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'."
+ :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)
+
;;; Internal variables
+(defvar gnus-article-mime-handles nil)
+(defvar gnus-article-decoded-p nil)
(defvar gnus-scores-exclude-files nil)
(defvar gnus-page-broken nil)
+(defvar gnus-inhibit-mime-unbuttonizing nil)
(defvar gnus-original-article nil)
(defvar gnus-article-internal-prepare-hook nil)
(?l (bbb-grouplens-score gnus-tmp-header) ?s)
(?V (gnus-thread-total-score (and (boundp 'thread) (car thread))) ?d)
(?U gnus-tmp-unread ?c)
+ (?f (gnus-summary-from-or-to-or-newsgroups gnus-tmp-header) ?s)
(?t (gnus-summary-number-of-articles-in-thread
(and (boundp 'thread) (car thread)) gnus-tmp-level)
?d)
(?d (length gnus-newsgroup-dormant) ?d)
(?t (length gnus-newsgroup-marked) ?d)
(?r (length gnus-newsgroup-reads) ?d)
+ (?z (gnus-summary-article-score gnus-tmp-article-number) ?d)
(?E gnus-newsgroup-expunged-tally ?d)
(?s (gnus-current-score-file-nondirectory) ?s)))
(defvar gnus-have-all-headers nil)
(defvar gnus-last-article nil)
(defvar gnus-newsgroup-history nil)
+(defvar gnus-newsgroup-charset 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-newsgroup-active gnus-scores-exclude-files
gnus-newsgroup-history gnus-newsgroup-ancient
(gnus-newsgroup-expunged-tally . 0)
gnus-cache-removable-articles gnus-newsgroup-cached
gnus-newsgroup-data gnus-newsgroup-data-reverse
- gnus-newsgroup-limit gnus-newsgroup-limits)
+ gnus-newsgroup-limit gnus-newsgroup-limits
+ gnus-newsgroup-charset)
"Variables that are buffer-local to the summary buffers.")
;; Byte-compiler warning.
(defvar gnus-article-mode-map)
+;; MIME stuff.
+
+(defvar gnus-decode-encoded-word-methods
+ '(mail-decode-encoded-word-string)
+ "List of methods used to decode encoded words.
+
+This variable is a list of FUNCTION or (REGEXP . FUNCTION). If item is
+FUNCTION, FUNCTION will be apply to all newsgroups. If item is a
+(REGEXP . FUNCTION), FUNCTION will be only apply to thes newsgroups
+whose names match REGEXP.
+
+For example:
+((\"chinese\" . gnus-decode-encoded-word-string-by-guess)
+ mail-decode-encoded-word-string
+ (\"chinese\" . rfc1843-decode-string))
+")
+
+(defvar gnus-decode-encoded-word-methods-cache nil)
+
+(defun gnus-multi-decode-encoded-word-string (string)
+ "Apply the functions from `gnus-encoded-word-methods' that match."
+ (unless (and gnus-decode-encoded-word-methods-cache
+ (eq gnus-newsgroup-name
+ (car gnus-decode-encoded-word-methods-cache)))
+ (setq gnus-decode-encoded-word-methods-cache (list gnus-newsgroup-name))
+ (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))))))
+ gnus-decode-encoded-word-methods))
+ (let ((xlist gnus-decode-encoded-word-methods-cache))
+ (pop xlist)
+ (while xlist
+ (setq string (funcall (pop xlist) string))))
+ string)
+
;; Subject simplification.
(defun gnus-simplify-whitespace (str)
[delete] gnus-summary-prev-page
[backspace] gnus-summary-prev-page
"\r" gnus-summary-scroll-up
+ "\M-\r" gnus-summary-scroll-down
"n" gnus-summary-next-unread-article
"p" gnus-summary-prev-unread-article
"N" gnus-summary-next-article
"\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
"\M-g" gnus-summary-rescan-group
"w" gnus-summary-stop-page-breaking
"\C-c\C-r" gnus-summary-caesar-message
- "\M-t" gnus-summary-toggle-mime
"f" gnus-summary-followup
"F" gnus-summary-followup-with-original
"C" gnus-summary-cancel-article
"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
"\C-c\C-b" gnus-bug
"*" gnus-cache-enter-article
"\M-*" gnus-cache-remove-article
"L" gnus-summary-lower-score
"\M-i" gnus-symbolic-argument
"h" gnus-summary-select-article-buffer
-
+
+ "b" gnus-article-view-part
+ "\M-t" gnus-summary-toggle-display-buttonized
+
"V" gnus-summary-score-map
"X" gnus-uu-extract-map
"S" gnus-summary-send-map)
"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)
[delete] gnus-summary-prev-page
"p" gnus-summary-prev-page
"\r" gnus-summary-scroll-up
+ "\M-\r" gnus-summary-scroll-down
"<" gnus-summary-beginning-of-article
">" gnus-summary-end-of-article
"b" gnus-summary-beginning-of-article
"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
+ "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
"f" gnus-article-display-x-face
"r" gnus-summary-caesar-message
"t" gnus-article-hide-headers
"v" gnus-summary-verbose-headers
- "m" gnus-summary-toggle-mime
"h" gnus-article-treat-html
+ "H" gnus-article-strip-headers-in-body
"d" gnus-article-treat-dumbquotes)
(gnus-define-keys (gnus-summary-wash-hide-map "W" gnus-summary-wash-map)
"b" gnus-article-hide-boring-headers
"s" gnus-article-hide-signature
"c" gnus-article-hide-citation
+ "C" gnus-article-hide-citation-in-followups
"p" gnus-article-hide-pgp
+ "B" gnus-article-strip-banner
"P" gnus-article-hide-pem
"\C-c" gnus-article-hide-citation-maybe)
"c" gnus-article-highlight-citation
"s" gnus-article-highlight-signature)
+ (gnus-define-keys (gnus-summary-wash-mime-map "M" gnus-summary-wash-map)
+ "w" gnus-article-decode-mime-words
+ "c" gnus-article-decode-charset
+ "v" gnus-mime-view-all-parts
+ "b" gnus-article-view-part)
+
(gnus-define-keys (gnus-summary-wash-time-map "T" gnus-summary-wash-map)
"z" gnus-article-date-ut
"u" gnus-article-date-ut
"m" gnus-article-strip-multiple-blank-lines
"a" gnus-article-strip-blank-lines
"A" gnus-article-strip-all-blank-lines
- "s" gnus-article-strip-leading-space)
+ "s" gnus-article-strip-leading-space
+ "e" gnus-article-strip-trailing-space)
(gnus-define-keys (gnus-summary-help-map "H" gnus-summary-mode-map)
"v" gnus-version
"c" gnus-summary-copy-article
"B" gnus-summary-crosspost-article
"q" gnus-summary-respool-query
+ "t" gnus-summary-respool-trace
"i" gnus-summary-import-article
"p" gnus-summary-article-posted-p)
"h" gnus-summary-save-article-folder
"v" gnus-summary-save-article-vm
"p" gnus-summary-pipe-output
- "s" gnus-soup-add-article))
+ "s" gnus-soup-add-article)
+
+ (gnus-define-keys (gnus-summary-mime-map "K" gnus-summary-mode-map)
+ "b" gnus-summary-display-buttonized
+ "m" gnus-summary-repair-multipart
+ "v" gnus-article-view-part
+ "o" gnus-article-save-part
+ "c" gnus-article-copy-part
+ "e" gnus-article-externalize-part
+ "i" gnus-article-inline-part
+ "|" gnus-article-pipe-part)
+ )
(defun gnus-summary-make-menu-bar ()
(gnus-turn-off-edit-menu 'summary)
["Signature" gnus-article-hide-signature t]
["Citation" gnus-article-hide-citation 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]
["Headers" gnus-article-highlight-headers t]
["Signature" gnus-article-highlight-signature t]
["Citation" gnus-article-highlight-citation t])
+ ("MIME"
+ ["Words" gnus-article-decode-mime-words t]
+ ["Charset" gnus-article-decode-charset t]
+ ["QP" gnus-article-de-quoted-unreadable t]
+ ["View all" gnus-mime-view-all-parts t])
("Date"
["Local" gnus-article-date-local t]
["ISO8601" gnus-article-date-iso8601 t]
["Trailing" gnus-article-remove-trailing-blank-lines t]
["All of the above" gnus-article-strip-blank-lines t]
["All" gnus-article-strip-all-blank-lines t]
- ["Leading space" gnus-article-strip-leading-space t])
+ ["Leading space" gnus-article-strip-leading-space t]
+ ["Trailing space" gnus-article-strip-trailing-space t])
["Overstrike" gnus-article-treat-overstrike t]
["Dumb quotes" gnus-article-treat-dumbquotes t]
["Emphasis" gnus-article-emphasize t]
["Word wrap" gnus-article-fill-cited-article t]
+ ["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]
["Add buttons" gnus-article-add-buttons t]
["Add buttons to head" gnus-article-add-buttons-to-head t]
["Stop page breaking" gnus-summary-stop-page-breaking t]
- ["Toggle MIME" gnus-summary-toggle-mime t]
["Verbose header" gnus-summary-verbose-headers t]
["Toggle header" gnus-summary-toggle-header t])
("Output"
(gnus-check-backend-function
'request-expire-articles gnus-newsgroup-name)]
["Query respool" gnus-summary-respool-query t]
+ ["Trace respool" gnus-summary-respool-trace t]
["Delete expirable articles" gnus-summary-expire-articles-now
(gnus-check-backend-function
'request-expire-articles gnus-newsgroup-name)])
("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]
["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]
["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]
["Edit local kill file" gnus-summary-edit-local-kill t]
["Edit main kill file" gnus-summary-edit-global-kill t]
["Edit group parameters" gnus-summary-edit-parameters t]
+ ["Customize group parameters" gnus-summary-customize-parameters t]
+ ["Send a bug report" gnus-bug t]
("Exit"
["Catchup and exit" gnus-summary-catchup-and-exit t]
- ["Catchup all and exit" gnus-summary-catchup-and-exit t]
+ ["Catchup all and exit" gnus-summary-catchup-all-and-exit t]
["Catchup and goto next" gnus-summary-catchup-and-goto-next-group t]
["Exit group" gnus-summary-exit t]
["Exit group without updating" gnus-summary-exit-no-update t]
("article body" "body" string)
("article head" "head" string)
("xref" "xref" string)
+ ("extra header" "extra" string)
("lines" "lines" number)
("followups to author" "followup" string)))
(types '((number ("less than" <)
(setq mode-name "Summary")
(make-local-variable 'minor-mode-alist)
(use-local-map gnus-summary-mode-map)
- (buffer-disable-undo (current-buffer))
+ (buffer-disable-undo)
(setq buffer-read-only t) ;Disable modification
(setq truncate-lines t)
(setq selective-display t)
(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)
(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))
(when list
(let ((data (and after-article (gnus-data-find-list after-article)))
(ilist list))
- (or data (not after-article) (error "No such article: %d" after-article))
- ;; Find the last element in the list to be spliced into the main
- ;; list.
- (while (cdr list)
- (setq list (cdr list)))
- (if (not data)
- (progn
- (setcdr list gnus-newsgroup-data)
- (setq gnus-newsgroup-data ilist)
+ (if (not (or data
+ after-article))
+ (let ((odata gnus-newsgroup-data))
+ (setq gnus-newsgroup-data (nconc list gnus-newsgroup-data))
(when offset
- (gnus-data-update-list (cdr list) offset)))
- (setcdr list (cdr data))
- (setcdr data ilist)
- (when offset
- (gnus-data-update-list (cdr list) offset)))
+ (gnus-data-update-list odata offset)))
+ ;; Find the last element in the list to be spliced into the main
+ ;; list.
+ (while (cdr list)
+ (setq list (cdr list)))
+ (if (not data)
+ (progn
+ (setcdr list gnus-newsgroup-data)
+ (setq gnus-newsgroup-data ilist)
+ (when offset
+ (gnus-data-update-list (cdr list) offset)))
+ (setcdr list (cdr data))
+ (setcdr data ilist)
+ (when offset
+ (gnus-data-update-list (cdr list) offset))))
(setq gnus-newsgroup-data-reverse nil))))
(defun gnus-data-remove (article &optional offset)
(defun gnus-data-update-list (data offset)
"Add OFFSET to the POS of all data entries in DATA."
+ (setq gnus-newsgroup-data-reverse nil)
(while data
(setcar (nthcdr 2 (car data)) (+ offset (nth 2 (car data))))
(setq data (cdr data))))
-(defun gnus-data-compute-positions ()
- "Compute the positions of all articles."
- (let ((data gnus-newsgroup-data)
- pos)
- (while data
- (when (setq pos (text-property-any
- (point-min) (point-max)
- 'gnus-number (gnus-data-number (car data))))
- (gnus-data-set-pos (car data) (+ pos 3)))
- (setq data (cdr data)))))
-
(defun gnus-summary-article-pseudo-p (article)
"Say whether this article is a pseudo article or not."
(not (vectorp (gnus-data-header (gnus-data-find article)))))
,@forms)
(gnus-restore-hidden-threads-configuration ,config)))))
+(defun gnus-data-compute-positions ()
+ "Compute the positions of all articles."
+ (setq gnus-newsgroup-data-reverse nil)
+ (let ((data gnus-newsgroup-data))
+ (save-excursion
+ (gnus-save-hidden-threads
+ (gnus-summary-show-all-threads)
+ (goto-char (point-min))
+ (while data
+ (while (get-text-property (point) 'gnus-intangible)
+ (forward-line 1))
+ (gnus-data-set-pos (car data) (+ (point) 3))
+ (setq data (cdr data))
+ (forward-line 1))))))
+
(defun gnus-hidden-threads-configuration ()
"Return the current hidden threads configuration."
(save-excursion
(while (setq point (pop config))
(when (and (< point (point-max))
(goto-char point)
- (= (following-char) ?\n))
+ (eq (char-after) ?\n))
(subst-char-in-region point (1+ point) ?\n ?\r)))))
;; Various summary mode internalish functions.
(setq gnus-summary-buffer (current-buffer))
(not gnus-newsgroup-prepared))
;; Fix by Sudish Joseph <joseph@cis.ohio-state.edu>
- (setq gnus-summary-buffer (set-buffer (get-buffer-create buffer)))
- (gnus-add-current-to-buffer-list)
+ (setq gnus-summary-buffer (set-buffer (gnus-get-buffer-create buffer)))
(gnus-summary-mode group)
(when gnus-carpal
(gnus-carpal-setup-buffer 'summary))
(original gnus-original-article-buffer)
(gac gnus-article-current)
(reffed gnus-reffed-article-number)
- (score-file gnus-current-score-file))
+ (score-file gnus-current-score-file)
+ (default-charset gnus-newsgroup-charset))
(save-excursion
(set-buffer gnus-group-buffer)
(setq gnus-newsgroup-name name
gnus-article-buffer article-buffer
gnus-original-article-buffer original
gnus-reffed-article-number reffed
- gnus-current-score-file score-file)
+ gnus-current-score-file score-file
+ gnus-newsgroup-charset default-charset)
;; 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 ()
(gnus-score-over-mark 130)
(gnus-download-mark 131)
(spec gnus-summary-line-format-spec)
- thread gnus-visual pos)
+ gnus-visual pos)
(save-excursion
(gnus-set-work-buffer)
(let ((gnus-summary-line-format-spec spec)
(gnus-newsgroup-downloadable '((0 . t))))
(gnus-summary-insert-line
- [0 "" "" "" "" "" 0 0 ""] 0 nil 128 t nil "" nil 1)
+ [0 "" "" "" "" "" 0 0 "" nil] 0 nil 128 t nil "" nil 1)
(goto-char (point-min))
(setq pos (list (cons 'unread (and (search-forward "\200" nil t)
(- (point) 2)))))
(point) (progn (eval gnus-summary-dummy-line-format-spec) (point))
(list 'gnus-number gnus-tmp-number 'gnus-intangible gnus-tmp-number)))
+(defun gnus-summary-from-or-to-or-newsgroups (header)
+ (let ((to (cdr (assq 'To (mail-header-extra header))))
+ (newsgroups (cdr (assq 'Newsgroups (mail-header-extra header))))
+ (mail-parse-charset gnus-newsgroup-charset))
+ (cond
+ ((and to
+ gnus-ignored-from-addresses
+ (string-match gnus-ignored-from-addresses
+ (mail-header-from header)))
+ (concat "-> "
+ (or (car (funcall gnus-extract-address-components
+ (funcall
+ gnus-decode-encoded-word-function to)))
+ (funcall gnus-decode-encoded-word-function to))))
+ ((and newsgroups
+ gnus-ignored-from-addresses
+ (string-match gnus-ignored-from-addresses
+ (mail-header-from header)))
+ (concat "=> " newsgroups))
+ (t
+ (or (car (funcall gnus-extract-address-components
+ (mail-header-from header)))
+ (mail-header-from header))))))
+
(defun gnus-summary-insert-line (gnus-tmp-header
gnus-tmp-level gnus-tmp-current
gnus-tmp-unread gnus-tmp-replied
(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
(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))
(set (car elem) (eval (nth 1 elem))))))))
(defun gnus-summary-read-group (group &optional show-all no-article
- kill-buffer no-display backward)
+ kill-buffer no-display backward
+ select-articles)
"Start reading news in newsgroup GROUP.
If SHOW-ALL is non-nil, already read articles are also listed.
If NO-ARTICLE is non-nil, no article is selected initially.
(let ((gnus-auto-select-next nil))
(or (gnus-summary-read-group-1
group show-all no-article
- kill-buffer no-display)
- (setq show-all nil)))))
+ kill-buffer no-display
+ select-articles)
+ (setq show-all nil
+ select-articles nil)))))
(eq gnus-auto-select-next 'quietly))
(set-buffer gnus-group-buffer)
;; The entry function called above goes to the next
result))
(defun gnus-summary-read-group-1 (group show-all no-article
- kill-buffer no-display)
+ kill-buffer no-display
+ &optional select-articles)
;; Killed foreign groups can't be entered.
(when (and (not (gnus-group-native-p group))
(not (gnus-gethash group gnus-newsrc-hashtb)))
(gnus-message 5 "Retrieving newsgroup: %s..." group)
(let* ((new-group (gnus-summary-setup-buffer group))
(quit-config (gnus-group-quit-config group))
- (did-select (and new-group (gnus-select-newsgroup group show-all))))
+ (did-select (and new-group (gnus-select-newsgroup
+ group show-all select-articles))))
(cond
;; This summary buffer exists already, so we just select it.
((not new-group)
(not no-display)
gnus-newsgroup-unreads
gnus-auto-select-first)
- (unless (if (eq gnus-auto-select-first 'best)
- (gnus-summary-best-unread-article)
- (gnus-summary-first-unread-article))
- (gnus-configure-windows 'summary))
+ (progn
+ (gnus-configure-windows 'summary)
+ (cond
+ ((eq gnus-auto-select-first 'best)
+ (gnus-summary-best-unread-article))
+ ((eq gnus-auto-select-first t)
+ (gnus-summary-first-unread-article))
+ ((gnus-functionp gnus-auto-select-first)
+ (funcall gnus-auto-select-first))))
;; Don't select any articles, just move point to the first
;; article in the group.
(goto-char (point-min))
(gnus-summary-position-point)
(gnus-configure-windows 'summary 'force)
- (gnus-set-mode-line 'summary))
+ (gnus-set-mode-line 'summary))
(when (get-buffer-window gnus-group-buffer t)
;; Gotta use windows, because recenter does weird stuff if
;; the current buffer ain't the displayed window.
threads))
;; Build the thread tree.
-(defun gnus-dependencies-add-header (header dependencies force-new)
+(defsubst gnus-dependencies-add-header (header dependencies force-new)
"Enter HEADER into the DEPENDENCIES table if it is not already there.
If FORCE-NEW is not nil, enter HEADER into the DEPENDENCIES table even
;; Yuk! This is a reference loop. Make the article be a
;; root article.
(progn
- (debug)
(mail-header-set-references (car (symbol-value id-dep)) "none")
(setq ref nil))
(setq ref (gnus-parent-id (mail-header-references ref-header)))))
(defun gnus-build-sparse-threads ()
(let ((headers gnus-newsgroup-headers)
+ (gnus-summary-ignore-duplicates t)
header references generation relations
- cthread subject child end pthread relation new-child)
+ subject child end new-child date)
;; First we create an alist of generations/relations, where
;; generations is how much we trust the relation, and the relation
;; is parent/child.
(not (string= references "")))
(insert references)
(setq child (mail-header-id header)
- subject (mail-header-subject header))
- (setq generation 0)
+ subject (mail-header-subject header)
+ date (mail-header-date header)
+ generation 0)
(while (search-backward ">" nil t)
(setq end (1+ (point)))
- (if (search-backward "<" nil t)
- (push (list (incf generation)
- child (setq child new-child)
- subject)
- relations)))
- (push (list (1+ generation) child nil subject) relations)
+ (when (search-backward "<" nil t)
+ (setq new-child (buffer-substring (point) end))
+ (push (list (incf generation)
+ child (setq child new-child)
+ subject date)
+ relations)))
+ (when child
+ (push (list (1+ generation) child nil subject) relations))
(erase-buffer)))
(kill-buffer (current-buffer)))
;; Sort over trustworthiness.
- (mapc #'(lambda (relation)
- (when (gnus-dependencies-add-header
- (make-full-mail-header gnus-reffed-article-number
- (cadddr relation)
- "" "" (cadr relation)
- (or (caddr relation) "") 0 0 "")
- gnus-newsgroup-dependencies nil)
- (push gnus-reffed-article-number gnus-newsgroup-limit)
- (push gnus-reffed-article-number gnus-newsgroup-sparse)
- (push (cons gnus-reffed-article-number gnus-sparse-mark)
- gnus-newsgroup-reads)
- (decf gnus-reffed-article-number)))
- (sort relations 'car-less-than-car))
+ (mapcar
+ (lambda (relation)
+ (when (gnus-dependencies-add-header
+ (make-full-mail-header
+ gnus-reffed-article-number
+ (nth 3 relation) "" (or (nth 4 relation) "")
+ (nth 1 relation)
+ (or (nth 2 relation) "") 0 0 "")
+ gnus-newsgroup-dependencies nil)
+ (push gnus-reffed-article-number gnus-newsgroup-limit)
+ (push gnus-reffed-article-number gnus-newsgroup-sparse)
+ (push (cons gnus-reffed-article-number gnus-sparse-mark)
+ gnus-newsgroup-reads)
+ (decf gnus-reffed-article-number)))
+ (sort relations 'car-less-than-car))
(gnus-message 7 "Making sparse threads...done")))
(defun gnus-build-old-threads ()
(setq heads nil)))))
gnus-newsgroup-dependencies)))
+;; This function has to be called with point after the article number
+;; on the beginning of the line.
+(defsubst gnus-nov-parse-line (number dependencies &optional force-new)
+ (let ((eol (gnus-point-at-eol))
+ (buffer (current-buffer))
+ header)
+
+ ;; overview: [num subject from date id refs chars lines misc]
+ (unwind-protect
+ (progn
+ (narrow-to-region (point) eol)
+ (unless (eobp)
+ (forward-char))
+
+ (setq header
+ (make-full-mail-header
+ number ; number
+ (funcall gnus-decode-encoded-word-function
+ (nnheader-nov-field)) ; subject
+ (funcall gnus-decode-encoded-word-function
+ (nnheader-nov-field)) ; from
+ (nnheader-nov-field) ; date
+ (nnheader-nov-read-message-id) ; id
+ (nnheader-nov-field) ; refs
+ (nnheader-nov-read-integer) ; chars
+ (nnheader-nov-read-integer) ; lines
+ (unless (eobp)
+ (nnheader-nov-field)) ; misc
+ (nnheader-nov-parse-extra)))) ; extra
+
+ (widen))
+
+ (when gnus-alter-header-function
+ (funcall gnus-alter-header-function header))
+ (gnus-dependencies-add-header header dependencies force-new)))
+
(defun gnus-build-get-header (id)
;; Look through the buffer of NOV lines and find the header to
;; ID. Enter this line into the dependencies hash table, and return
"Read all the headers."
(let ((gnus-summary-ignore-duplicates t)
(dependencies gnus-newsgroup-dependencies)
- found header article)
+ header article)
(save-excursion
(set-buffer nntp-server-buffer)
(let ((case-fold-search nil))
header (gnus-nov-parse-line
article dependencies)))
(when header
- (push header gnus-newsgroup-headers)
- (if (memq (setq article (mail-header-number header))
- gnus-newsgroup-unselected)
- (progn
- (push article gnus-newsgroup-unreads)
- (setq gnus-newsgroup-unselected
- (delq article gnus-newsgroup-unselected)))
- (push article gnus-newsgroup-ancient))
+ (save-excursion
+ (set-buffer gnus-summary-buffer)
+ (push header gnus-newsgroup-headers)
+ (if (memq (setq article (mail-header-number header))
+ gnus-newsgroup-unselected)
+ (progn
+ (push article gnus-newsgroup-unreads)
+ (setq gnus-newsgroup-unselected
+ (delq article gnus-newsgroup-unselected)))
+ (push article gnus-newsgroup-ancient)))
(forward-line 1)))))))
(defun gnus-summary-update-article-line (article header)
(defun gnus-summary-update-article (article &optional iheader)
"Update ARTICLE in the summary buffer."
(set-buffer gnus-summary-buffer)
- (let* ((header (or iheader (gnus-summary-article-header article)))
+ (let* ((header (gnus-summary-article-header article))
(id (mail-header-id header))
(data (gnus-data-find article))
(thread (gnus-id-to-thread id))
references))
"none")))
(buffer-read-only nil)
- (old (car thread))
- (number (mail-header-number header))
- pos)
+ (old (car thread)))
(when thread
- ;; !!! Should this be in or not?
(unless iheader
- (setcar thread nil))
- (when parent
- (delq thread parent))
- (if (gnus-summary-insert-subject id header iheader)
+ (setcar thread nil)
+ (when parent
+ (delq thread parent)))
+ (if (gnus-summary-insert-subject id header)
;; Set the (possibly) new article number in the data structure.
(gnus-data-set-number data (gnus-id-to-article id))
(setcar thread old)
nil))))
-(defun gnus-rebuild-thread (id)
- "Rebuild the thread containing ID."
+(defun gnus-rebuild-thread (id &optional line)
+ "Rebuild the thread containing ID.
+If LINE, insert the rebuilt thread starting on line LINE."
(let ((buffer-read-only nil)
old-pos current thread data)
(if (not gnus-show-threads)
(setq thread (cons subject (gnus-sort-threads roots))))))
(let (threads)
;; We then insert this thread into the summary buffer.
+ (when line
+ (goto-char (point-min))
+ (forward-line (1- line)))
(let (gnus-newsgroup-data gnus-newsgroup-threads)
(if gnus-show-threads
(gnus-summary-prepare-threads (gnus-cut-threads (list thread)))
(setq data (nreverse gnus-newsgroup-data))
(setq threads gnus-newsgroup-threads))
;; We splice the new data into the data structure.
- (gnus-data-enter-list current data (- (point) old-pos))
- (setq gnus-newsgroup-threads (nconc threads gnus-newsgroup-threads)))))
+ ;;!!! This is kinda bogus. We assume that in LINE is non-nil,
+ ;;!!! then we want to insert at the beginning of the buffer.
+ ;;!!! That happens to be true with Gnus now, but that may
+ ;;!!! change in the future. Perhaps.
+ (gnus-data-enter-list
+ (if line nil current) data (- (point) old-pos))
+ (setq gnus-newsgroup-threads
+ (nconc threads gnus-newsgroup-threads))
+ (gnus-data-compute-positions))))
(defun gnus-number-to-header (number)
"Return the header for article NUMBER."
(headers in-headers)
references)
(while (and parent
- headers
(not (zerop generation))
(setq references (mail-header-references headers)))
- (when (and references
- (setq parent (gnus-parent-id references))
- (setq headers (car (gnus-id-to-thread parent))))
- (decf generation)))
+ (setq headers (if (and references
+ (setq parent (gnus-parent-id references)))
+ (car (gnus-id-to-thread parent))
+ nil))
+ (decf generation))
(and (not (eq headers in-headers))
headers)))
"Remove the thread that has ID in it."
(let (headers thread last-id)
;; First go up in this thread until we find the root.
- (setq last-id (gnus-root-id id))
- (setq headers (list (car (gnus-id-to-thread last-id))
- (caadr (gnus-id-to-thread last-id))))
+ (setq last-id (gnus-root-id id)
+ headers (message-flatten-list (gnus-id-to-thread last-id)))
;; We have now found the real root of this thread. It might have
;; been gathered into some loose thread, so we have to search
;; through the threads to find the thread we wanted.
(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)
"Sort THREADS."
(if (not gnus-thread-sort-functions)
threads
- (gnus-message 7 "Sorting threads...")
+ (gnus-message 8 "Sorting threads...")
(prog1
(sort threads (gnus-make-sort-function gnus-thread-sort-functions))
- (gnus-message 7 "Sorting threads...done"))))
+ (gnus-message 8 "Sorting threads...done"))))
(defun gnus-sort-articles (articles)
"Sort ARTICLES."
(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
(defsubst gnus-article-sort-by-date (h1 h2)
"Sort articles by root article date."
- (gnus-time-less
+ (time-less-p
(gnus-date-get-time (mail-header-date h1))
(gnus-date-get-time (mail-header-date h2))))
(> (gnus-thread-total-score h1) (gnus-thread-total-score h2)))
(defun gnus-thread-total-score (thread)
- ;; This function find the total score of THREAD.
+ ;; This function find the total score of THREAD.
(cond ((null thread)
0)
((consp thread)
(defvar gnus-tmp-root-expunged nil)
(defvar gnus-tmp-dummy-line nil)
+(defvar gnus-tmp-header)
+(defun gnus-extra-header (type &optional header)
+ "Return the extra header of TYPE."
+ (or (cdr (assq type (mail-header-extra (or header gnus-tmp-header))))
+ ""))
+
(defun gnus-summary-prepare-threads (threads)
"Prepare summary buffer from THREADS and indentation LEVEL.
THREADS is either a list of `(PARENT [(CHILD1 [(GRANDCHILD ...]...) ...])'
(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
(cdr (assq number gnus-newsgroup-scored))
(memq number gnus-newsgroup-processable))))))
-(defun gnus-select-newsgroup (group &optional read-all)
+(defun gnus-select-newsgroup (group &optional read-all select-articles)
"Select newsgroup GROUP.
-If READ-ALL is non-nil, all articles in the group are selected."
+If READ-ALL is non-nil, all articles in the group are selected.
+If SELECT-ARTICLES, only select those articles from GROUP."
(let* ((entry (gnus-gethash group gnus-newsrc-hashtb))
;;!!! Dirty hack; should be removed.
(gnus-summary-ignore-duplicates
- (if (eq (car (gnus-find-method-for-group group)) 'nnvirtual)
+ (if (eq (car (gnus-find-method-for-group group)) 'nnvirtual)
t
gnus-summary-ignore-duplicates))
(info (nth 2 entry))
(setq gnus-newsgroup-name group)
(setq gnus-newsgroup-unselected nil)
(setq gnus-newsgroup-unreads (gnus-list-of-unread-articles group))
+ (gnus-summary-setup-default-charset)
;; Adjust and set lists of article marks.
(when info
(setq gnus-newsgroup-processable nil)
(gnus-update-read-articles group gnus-newsgroup-unreads)
- (unless (gnus-ephemeral-group-p gnus-newsgroup-name)
- (gnus-group-update-group group))
- (setq articles (gnus-articles-to-read group read-all))
+ (if (setq articles select-articles)
+ (setq gnus-newsgroup-unselected
+ (gnus-sorted-intersection
+ gnus-newsgroup-unreads
+ (gnus-sorted-complement gnus-newsgroup-unreads articles)))
+ (setq articles (gnus-articles-to-read group read-all)))
(cond
((null articles)
;; Init the dependencies hash table.
(setq gnus-newsgroup-dependencies
(gnus-make-hashtable (length articles)))
+ (gnus-set-global-variables)
;; Retrieve the headers and read them in.
(gnus-message 5 "Fetching headers for %s..." gnus-newsgroup-name)
(setq gnus-newsgroup-headers
;; Removed marked articles that do not exist.
(gnus-update-missing-marks
(gnus-sorted-complement fetched-articles articles))
- ;; Let the Gnus agent mark articles as read.
- (when gnus-agent
- (gnus-agent-get-undownloaded-list))
;; We might want to build some more threads first.
(when (and gnus-fetch-old-headers
(eq gnus-headers-retrieved-by 'nov))
(if (eq gnus-fetch-old-headers 'invisible)
(gnus-build-all-threads)
(gnus-build-old-threads)))
+ ;; Let the Gnus agent mark articles as read.
+ (when gnus-agent
+ (gnus-agent-get-undownloaded-list))
;; Check whether auto-expire is to be done in this group.
(setq gnus-newsgroup-auto-expire
(gnus-group-auto-expirable-p group))
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))
(let ((types gnus-article-mark-lists)
(info (gnus-get-info gnus-newsgroup-name))
(uncompressed '(score bookmark killed))
- type list newmarked symbol)
+ type list newmarked symbol delta-marks)
(when info
- ;; Add all marks lists that are non-nil to the list of marks lists.
+ ;; Add all marks lists to the list of marks lists.
(while (setq type (pop types))
- (when (setq list (symbol-value
+ (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))))
-
- (push (cons (cdr type)
- (if (memq (cdr type) uncompressed) list
- (gnus-compress-sequence
- (set symbol (sort list '<)) t)))
- newmarked)))
-
+ (setq list (cdr all)))))
+
+ (or (memq (cdr type) uncompressed)
+ (setq list (gnus-compress-sequence (set symbol (sort list '<)) t)))
+
+ (when (gnus-check-backend-function 'request-set-mark
+ gnus-newsgroup-name)
+ ;; uncompressed:s are not proper flags (they are cons cells)
+ ;; cache is a internal gnus flag
+ (unless (memq (cdr type) (cons 'cache uncompressed))
+ (let* ((old (cdr (assq (cdr type) (gnus-info-marks info))))
+ (del (gnus-remove-from-range (gnus-copy-sequence old) list))
+ (add (gnus-remove-from-range (gnus-copy-sequence list) old)))
+ (if add
+ (push (list add 'add (list (cdr type))) delta-marks))
+ (if del
+ (push (list del 'del (list (cdr type))) delta-marks)))))
+
+ (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)
"This function sets the mode line of the article or summary buffers.
If WHERE is `summary', the summary mode line format will be used."
;; Is this mode line one we keep updated?
- (when (memq where gnus-updated-mode-lines)
+ (when (and (memq where gnus-updated-mode-lines)
+ (symbol-value
+ (intern (format "gnus-%s-mode-line-format-spec" where))))
(let (mode-string)
(save-excursion
;; We evaluate this in the summary buffer since these
;; We might have to chop a bit of the string off...
(when (> (length mode-string) max-len)
(setq mode-string
- (concat (gnus-truncate-string mode-string (- max-len 3))
+ (concat (truncate-string-to-width mode-string (- max-len 3))
"...")))
;; Pad the mode string a bit.
(setq mode-string (format (format "%%-%ds" max-len) mode-string))))
(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)
;; Then we add the read articles to the range.
(gnus-add-to-range
ninfo (setq articles (sort articles '<))))))
-
+
(defun gnus-group-make-articles-read (group articles)
"Update the info of GROUP to say that ARTICLES are read."
(let* ((num 0)
;; 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)
(or dependencies
(save-excursion (set-buffer gnus-summary-buffer)
gnus-newsgroup-dependencies)))
- headers id id-dep ref-dep end ref)
+ headers id end ref
+ (mail-parse-charset gnus-newsgroup-charset))
(save-excursion
(set-buffer nntp-server-buffer)
;; Translate all TAB characters into SPACE characters.
(subst-char-in-region (point-min) (point-max) ?\t ? t)
+ (subst-char-in-region (point-min) (point-max) ?\r ? t)
(gnus-run-hooks 'gnus-parse-headers-hook)
(let ((case-fold-search t)
- in-reply-to header p lines)
+ in-reply-to header p lines chars)
(goto-char (point-min))
;; Search to the beginning of the next header. Error messages
;; do not begin with 2 or 3.
(progn
(goto-char p)
(if (search-forward "\nsubject: " nil t)
- (funcall
- gnus-unstructured-field-decoder (nnheader-header-value))
+ (funcall gnus-decode-encoded-word-function
+ (nnheader-header-value))
"(none)"))
;; From.
(progn
(goto-char p)
(if (search-forward "\nfrom: " nil t)
- (funcall
- gnus-structured-field-decoder (nnheader-header-value))
+ (funcall gnus-decode-encoded-word-function
+ (nnheader-header-value))
"(nobody)"))
;; Date.
(progn
(setq ref2 (substring in-reply-to (match-beginning 0)
(match-end 0)))
(when (> (length ref2) (length ref))
- (setq ref ref2))))
+ (setq ref ref2)))
+ ref)
(setq ref nil))))
;; Chars.
- 0
+ (progn
+ (goto-char p)
+ (if (search-forward "\nchars: " nil t)
+ (if (numberp (setq chars (ignore-errors (read cur))))
+ chars 0)
+ 0))
;; Lines.
(progn
(goto-char p)
(progn
(goto-char p)
(and (search-forward "\nxref: " nil t)
- (nnheader-header-value)))))
+ (nnheader-header-value)))
+ ;; Extra.
+ (when gnus-extra-headers
+ (let ((extra gnus-extra-headers)
+ out)
+ (while extra
+ (goto-char p)
+ (when (search-forward
+ (concat "\n" (symbol-name (car extra)) ": ") nil t)
+ (push (cons (car extra) (nnheader-header-value))
+ out))
+ (pop extra))
+ out))))
(when (equal id ref)
(setq ref nil))
(widen))
(nreverse headers)))))
-;; The following macros and functions were written by Felix Lee
-;; <flee@cse.psu.edu>.
-
-(defmacro gnus-nov-read-integer ()
- '(prog1
- (if (= (following-char) ?\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)))
-
-;; This function has to be called with point after the article number
-;; on the beginning of the line.
-(defsubst gnus-nov-parse-line (number dependencies &optional force-new)
- (let ((eol (gnus-point-at-eol))
- (buffer (current-buffer))
- header)
-
- ;; overview: [num subject from date id refs chars lines misc]
- (unwind-protect
- (progn
- (narrow-to-region (point) eol)
- (unless (eobp)
- (forward-char))
-
- (setq header
- (make-full-mail-header
- number ; number
- (funcall
- gnus-unstructured-field-decoder (gnus-nov-field)) ; subject
- (funcall
- gnus-structured-field-decoder (gnus-nov-field)) ; from
- (gnus-nov-field) ; date
- (or (gnus-nov-field)
- (nnheader-generate-fake-message-id)) ; id
- (gnus-nov-field) ; refs
- (gnus-nov-read-integer) ; chars
- (gnus-nov-read-integer) ; lines
- (unless (= (following-char) ?\n)
- (gnus-nov-field))))) ; misc
-
- (widen))
-
- (when gnus-alter-header-function
- (funcall gnus-alter-header-function header))
- (gnus-dependencies-add-header header dependencies force-new)))
-
;; Goes through the xover lines and returns a list of vectors
(defun gnus-get-newsgroup-headers-xover (sequence &optional
force-new dependencies
;; Get the Xref when the users reads the articles since most/some
;; NNTP servers do not include Xrefs when using XOVER.
(setq gnus-article-internal-prepare-hook '(gnus-article-get-xrefs))
- (let ((cur nntp-server-buffer)
+ (let ((mail-parse-charset gnus-newsgroup-charset)
+ (cur nntp-server-buffer)
(dependencies (or dependencies gnus-newsgroup-dependencies))
number headers header)
(save-excursion
(set-buffer nntp-server-buffer)
+ (subst-char-in-region (point-min) (point-max) ?\r ? t)
;; Allow the user to mangle the headers before parsing them.
(gnus-run-hooks 'gnus-parse-headers-hook)
(goto-char (point-min))
(save-restriction
(nnheader-narrow-to-headers)
(goto-char (point-min))
- (when (or (and (eq (downcase (following-char)) ?x)
+ (when (or (and (eq (downcase (char-after)) ?x)
(looking-at "Xref:"))
(search-forward "\nXref:" nil t))
(goto-char (1+ (match-end 0)))
(mail-header-set-xref headers xref)))))))
(defun gnus-summary-insert-subject (id &optional old-header use-old-header)
- "Find article ID and insert the summary line for that article."
- (let ((header (cond ((and old-header use-old-header)
- old-header)
- ((and (numberp id)
- (gnus-number-to-header id))
- (gnus-number-to-header id))
- (t
- (gnus-read-header id))))
- (number (and (numberp id) id))
- pos d)
+ "Find article ID and insert the summary line for that article.
+OLD-HEADER can either be a header or a line number to insert
+the subject line on."
+ (let* ((line (and (numberp old-header) old-header))
+ (old-header (and (vectorp old-header) old-header))
+ (header (cond ((and old-header use-old-header)
+ old-header)
+ ((and (numberp id)
+ (gnus-number-to-header id))
+ (gnus-number-to-header id))
+ (t
+ (gnus-read-header id))))
+ (number (and (numberp id) id))
+ d)
(when header
;; Rebuild the thread that this article is part of and go to the
;; article we have fetched.
gnus-newsgroup-sparse))
(setq gnus-newsgroup-ancient (delq number gnus-newsgroup-ancient))
(push number gnus-newsgroup-limit)
- (gnus-rebuild-thread (mail-header-id header))
+ (gnus-rebuild-thread (mail-header-id header) line)
(gnus-summary-goto-subject number nil t))
(when (and (numberp number)
(> number 0))
;; Just return the current article.
(list (gnus-summary-article-number))))))
+(defmacro gnus-summary-iterate (arg &rest forms)
+ "Iterate over the process/prefixed articles and do FORMS.
+ARG is the interactive prefix given to the command. FORMS will be
+executed with point over the summary line of the articles."
+ (let ((articles (make-symbol "gnus-summary-iterate-articles")))
+ `(let ((,articles (gnus-summary-work-articles ,arg)))
+ (while ,articles
+ (gnus-summary-goto-subject (car ,articles))
+ ,@forms
+ (pop ,articles)))))
+
+(put 'gnus-summary-iterate 'lisp-indent-function 1)
+(put 'gnus-summary-iterate 'edebug-form-spec '(form body))
+
(defun gnus-summary-save-process-mark ()
"Push the current set of process marked articles on the stack."
(interactive)
;; Recenter only when requested. Suggested by popovich@park.cs.columbia.edu.
(let* ((top (cond ((< (window-height) 4) 0)
((< (window-height) 7) 1)
- (t 2)))
+ (t (if (numberp gnus-auto-center-summary)
+ gnus-auto-center-summary
+ 2))))
(height (1- (window-height)))
(bottom (save-excursion (goto-char (point-max))
(forward-line (- height))
;; first unread article is the article after the last read
;; article. Sounds logical, doesn't it?
(if (not (listp (cdr read)))
- (setq first (1+ (cdr read)))
+ (setq first (max (car active) (1+ (cdr read))))
;; `read' is a list of ranges.
(when (/= (setq nlast (or (and (numberp (car read)) (car read))
(caar read)))
1)
- (setq first 1))
+ (setq first (car active)))
(while read
(when first
(while (< first nlast)
(gnus-update-read-articles
group (append gnus-newsgroup-unreads gnus-newsgroup-unselected))
;; Set the current article marks.
- (let ((gnus-newsgroup-scored
+ (let ((gnus-newsgroup-scored
(if (and (not gnus-save-score)
(not non-destructive))
nil
gnus-exit-group-hook is called with no arguments if that value is non-nil."
(interactive)
(gnus-set-global-variables)
+ (when (gnus-buffer-live-p gnus-article-buffer)
+ (save-excursion
+ (set-buffer gnus-article-buffer)
+ (mm-destroy-parts gnus-article-mime-handles)))
(gnus-kill-save-kill-buffer)
(gnus-async-halt-prefetch)
(let* ((group gnus-newsgroup-name)
(mode major-mode)
(group-point nil)
(buf (current-buffer)))
+ (unless quit-config
+ ;; Do adaptive scoring, and possibly save score files.
+ (when gnus-newsgroup-adaptive
+ (gnus-score-adaptive))
+ (when gnus-use-scoring
+ (gnus-score-save)))
(gnus-run-hooks 'gnus-summary-prepare-exit-hook)
;; If we have several article buffers, we kill them at exit.
(unless gnus-single-article-buffer
;; Make all changes in this group permanent.
(unless quit-config
(gnus-run-hooks 'gnus-exit-group-hook)
- (gnus-summary-update-info)
- ;; Do adaptive scoring, and possibly save score files.
- (when gnus-newsgroup-adaptive
- (gnus-score-adaptive))
- (when gnus-use-scoring
- (gnus-score-save)))
+ (gnus-summary-update-info))
(gnus-close-group group)
;; Make sure where we were, and go to next newsgroup.
(set-buffer gnus-group-buffer)
(gnus-kill-buffer buf)))
(setq gnus-current-select-method gnus-select-method)
(pop-to-buffer gnus-group-buffer)
- ;; Clear the current group name.
(if (not quit-config)
(progn
(goto-char group-point)
(gnus-configure-windows 'group 'force))
(gnus-handle-ephemeral-exit quit-config))
+ ;; Clear the current group name.
(unless quit-config
(setq gnus-newsgroup-name nil)))))
gnus-expert-user
(gnus-y-or-n-p "Discard changes to this group and exit? "))
(gnus-async-halt-prefetch)
- (gnus-run-hooks 'gnus-summary-prepare-exit-hook)
+ (mapcar 'funcall
+ (delq 'gnus-summary-expire-articles
+ (copy-list gnus-summary-prepare-exit-hook)))
+ (when (gnus-buffer-live-p gnus-article-buffer)
+ (save-excursion
+ (set-buffer gnus-article-buffer)
+ (mm-destroy-parts gnus-article-mime-handles)))
;; If we have several article buffers, we kill them at exit.
(unless gnus-single-article-buffer
(gnus-kill-buffer gnus-article-buffer)
(defun gnus-summary-describe-briefly ()
"Describe summary mode commands briefly."
(interactive)
- (gnus-message 6
- (substitute-command-keys "\\<gnus-summary-mode-map>\\[gnus-summary-next-page]:Select \\[gnus-summary-next-unread-article]:Forward \\[gnus-summary-prev-unread-article]:Backward \\[gnus-summary-exit]:Exit \\[gnus-info-find-node]:Run Info \\[gnus-summary-describe-briefly]:This help")))
+ (gnus-message 6 (substitute-command-keys "\\<gnus-summary-mode-map>\\[gnus-summary-next-page]:Select \\[gnus-summary-next-unread-article]:Forward \\[gnus-summary-prev-unread-article]:Backward \\[gnus-summary-exit]:Exit \\[gnus-info-find-node]:Run Info \\[gnus-summary-describe-briefly]:This help")))
;; Walking around group mode buffer from summary mode.
;; We read in the article if we have to.
(and (not data)
force
- (gnus-summary-insert-subject article (and (vectorp force) force) t)
+ (gnus-summary-insert-subject
+ article
+ (if (or (numberp force) (vectorp force)) force)
+ t)
(setq data (gnus-data-find article)))
(goto-char b)
(if (not data)
(gnus-message 3 "Can't find article %d" article))
nil)
(goto-char (gnus-data-pos data))
+ (gnus-summary-position-point)
article)))
;; Walking around summary lines with displaying articles.
;; The requested article is different from the current article.
(prog1
(gnus-summary-display-article article all-headers)
- (setq did article))
+ (setq did article)
+ (when (or all-headers gnus-show-all-headers)
+ (gnus-article-show-all-headers)))
(when (or all-headers gnus-show-all-headers)
(gnus-article-show-all-headers))
'old))
(not unread) (not subject))
(gnus-summary-goto-article
(if backward (1- gnus-newsgroup-begin) (1+ gnus-newsgroup-end))
- nil t))
+ nil (count-lines (point-min) (point))))
;; Go to next/previous group.
(t
(unless (gnus-ephemeral-group-p gnus-newsgroup-name)
(gnus-summary-recenter)
(gnus-summary-position-point))
+(defun gnus-summary-scroll-down (lines)
+ "Scroll down (or up) one line current article.
+Argument LINES specifies lines to be scrolled down (or up if negative)."
+ (interactive "p")
+ (gnus-summary-scroll-up (- lines)))
+
(defun gnus-summary-next-same-subject ()
"Select next article which has the same subject as current one."
(interactive)
(gnus-summary-display-article (gnus-summary-article-number)))
(gnus-summary-position-point)))
+(defun gnus-summary-first-unread-subject ()
+ "Place the point on the subject line of the first unread article.
+Return nil if there are no unread articles."
+ (interactive)
+ (prog1
+ (when (gnus-summary-first-subject t)
+ (gnus-summary-show-thread)
+ (gnus-summary-first-subject t))
+ (gnus-summary-position-point)))
+
(defun gnus-summary-first-article ()
"Select the first article.
Return nil if there are no articles."
(interactive)
(prog1
(when (gnus-summary-first-subject)
- (gnus-summary-show-thread)
- (gnus-summary-first-subject)
- (gnus-summary-display-article (gnus-summary-article-number)))
+ (gnus-summary-show-thread)
+ (gnus-summary-first-subject)
+ (gnus-summary-display-article (gnus-summary-article-number)))
(gnus-summary-position-point)))
(defun gnus-summary-best-unread-article ()
(defun gnus-summary-goto-article (article &optional all-headers force)
"Fetch ARTICLE (article number or Message-ID) and display it if it exists.
-If ALL-HEADERS is non-nil, no header lines are hidden."
+If ALL-HEADERS is non-nil, no header lines are hidden.
+If FORCE, go to the article even if it isn't displayed. If FORCE
+is a number, it is the line the article is to be displayed on."
(interactive
(list
(completing-read
"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 "nLimit to articles older than (in days): \nP")
(prog1
(let ((data gnus-newsgroup-data)
- (cutoff (nnmail-days-to-time age))
+ (cutoff (days-to-time age))
articles d date is-younger)
(while (setq d (pop data))
(when (and (vectorp (gnus-data-header d))
(setq date (mail-header-date (gnus-data-header d))))
- (setq is-younger (nnmail-time-less
- (nnmail-time-since (nnmail-date-to-time date))
+ (setq is-younger (time-less-p
+ (time-since (date-to-time date))
cutoff))
(when (if younger-p
- (not is-younger)
- is-younger)
+ is-younger
+ (not is-younger))
(push (gnus-data-number d) articles))))
(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))
+ "Score 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)
'<)
(sort gnus-newsgroup-limit '<)))
article)
- (setq gnus-newsgroup-unreads gnus-newsgroup-limit)
+ (setq gnus-newsgroup-unreads
+ (gnus-intersection gnus-newsgroup-unreads gnus-newsgroup-limit))
(if all
(setq gnus-newsgroup-dormant nil
gnus-newsgroup-marked nil
;; after the current one.
(goto-char (point-max))
(gnus-summary-find-prev))
+ (gnus-set-mode-line 'summary)
;; We return how many articles were removed from the summary
;; buffer as a result of the new limit.
(- total (length gnus-newsgroup-data))))
(defsubst gnus-cut-thread (thread)
"Go forwards in the thread until we find an article that we want to display."
(when (or (eq gnus-fetch-old-headers 'some)
- (eq gnus-fetch-old-headers 'invisible)
+ (eq gnus-fetch-old-headers 'invisible)
(eq gnus-build-sparse-threads 'some)
(eq gnus-build-sparse-threads 'more))
;; Deal with old-fetched headers and sparse threads.
(interactive "P")
(let ((id (mail-header-id (gnus-summary-article-header)))
(limit (if limit (prefix-numeric-value limit)
- gnus-refer-thread-limit))
- fmethod root)
+ gnus-refer-thread-limit)))
;; We want to fetch LIMIT *old* headers, but we also have to
;; re-fetch all the headers in the current buffer, because many of
;; them may be undisplayed. So we adjust LIMIT.
(gnus-summary-article-sparse-p
(mail-header-number header))
(memq (mail-header-number header)
- gnus-newsgroup-limit)))
- h)
+ gnus-newsgroup-limit))))
(cond
;; If the article is present in the buffer we just go to it.
((and header
(interactive)
(gnus-group-edit-group gnus-newsgroup-name 'params))
+(defun gnus-summary-customize-parameters ()
+ "Customize the group parameters of the current group."
+ (interactive)
+ (gnus-group-customize gnus-newsgroup-name))
+
(defun gnus-summary-enter-digest-group (&optional force)
"Enter an nndoc group based on the current article.
If FORCE, force a digest interpretation. If not, try
(gnus-summary-remove-process-mark article)
(when (gnus-summary-display-article article)
(save-excursion
- (nnheader-temp-write nil
+ (with-temp-buffer
(insert-buffer-substring gnus-original-article-buffer)
;; Remove some headers that may lead nndoc to make
;; the wrong guess.
;; We have to require this here to make sure that the following
;; dynamic binding isn't shadowed by autoloading.
(require 'gnus-async)
+ (require 'gnus-art)
(let ((gnus-select-article-hook nil) ;Disable hook.
- (gnus-article-display-hook nil)
(gnus-mark-article-hook nil) ;Inhibit marking as read.
(gnus-use-article-prefetch nil)
(gnus-xmas-force-redisplay nil) ;Inhibit XEmacs redisplay.
(gnus-use-trees nil) ;Inhibit updating tree buffer.
(sum (current-buffer))
+ (gnus-display-mime-function nil)
(found nil)
point)
(gnus-save-hidden-threads
(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."
(set-buffer buffer)
(gnus-article-delete-invisible-text)
(let ((ps-left-header
- (list
+ (list
(concat "("
(mail-header-subject gnus-current-headers) ")")
(concat "("
(mail-header-from gnus-current-headers) ")")))
- (ps-right-header
- (list
- "/pagenumberstring load"
+ (ps-right-header
+ (list
+ "/pagenumberstring load"
(concat "("
(mail-header-date gnus-current-headers) ")"))))
(gnus-run-hooks 'gnus-ps-print-hook)
(if (not arg)
;; Select the article the normal way.
(gnus-summary-select-article nil 'force)
+ ;; We have to require this here to make sure that the following
+ ;; dynamic binding isn't shadowed by autoloading.
+ (require 'gnus-async)
+ (require 'gnus-art)
;; Bind the article treatment functions to nil.
(let ((gnus-have-all-headers t)
- gnus-article-display-hook
gnus-article-prepare-hook
+ gnus-article-decode-hook
+ gnus-display-mime-function
gnus-break-pages
- gnus-show-mime
gnus-visual)
+ ;; 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)))
(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)
+ (save-restriction
+ (article-narrow-to-head)
+ (setq hidden (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)
- (let ((article-inhibit-hiding t))
- (gnus-run-hooks 'gnus-article-display-hook))
- (when (or (not hidden) (and (numberp arg) (< arg 0)))
- (gnus-article-hide-headers)))))
+ (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 (or 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)))))))
(defun gnus-summary-show-all-headers ()
"Make all header lines visible."
(interactive)
(gnus-article-show-all-headers))
-(defun gnus-summary-toggle-mime (&optional arg)
- "Toggle MIME processing.
-If ARG is a positive number, turn MIME processing on."
- (interactive "P")
- (setq gnus-show-mime
- (if (null arg) (not gnus-show-mime)
- (> (prefix-numeric-value arg) 0)))
- (gnus-summary-select-article t 'force))
-
(defun gnus-summary-caesar-message (&optional arg)
"Caesar rotate the current article by 13.
The numerical prefix specifies how many places to rotate each letter
gnus-newsgroup-name)) ; Server
(list 'gnus-request-accept-article
to-newsgroup (list 'quote select-method)
- (not articles)) ; Accept form
+ (not articles) t) ; Accept form
(not articles))) ; Only save nov last time
;; Copy the article.
((eq action 'copy)
(set-buffer copy-buf)
(when (gnus-request-article-this-buffer article gnus-newsgroup-name)
(gnus-request-accept-article
- to-newsgroup select-method (not articles)))))
+ to-newsgroup select-method (not articles) t))))
;; Crosspost the article.
((eq action 'crosspost)
(let ((xref (message-tokenize-header
(gnus-summary-mark-article article gnus-canceled-mark)
(gnus-message 4 "Deleted article %s" article))
(t
- (let* ((entry
- (or
- (gnus-gethash (car art-group) gnus-newsrc-hashtb)
- (gnus-gethash
- (gnus-group-prefixed-name
- (car art-group)
- (or select-method
- (gnus-find-method-for-group to-newsgroup)))
- gnus-newsrc-hashtb)))
+ (let* ((pto-group (gnus-group-prefixed-name
+ (car art-group) to-method))
+ (entry
+ (gnus-gethash pto-group gnus-newsrc-hashtb))
(info (nth 2 entry))
(to-group (gnus-info-group info)))
;; Update the group that has been moved to.
(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)))
;;;!!!Why is this necessary?
(set-buffer gnus-summary-buffer)
-
+
(gnus-summary-goto-subject article)
(when (eq action 'move)
(gnus-summary-mark-article article gnus-canceled-mark))))
(defcustom gnus-summary-respool-default-method nil
"Default method for respooling an article.
If nil, use to the current newsgroup method."
- :type `(choice (gnus-select-method :value (nnml ""))
+ :type '(choice (gnus-select-method :value (nnml ""))
(const nil))
:group 'gnus-summary-mail)
(not (file-regular-p file))
(error "Can't read %s" file))
(save-excursion
- (set-buffer (get-buffer-create " *import file*"))
- (buffer-disable-undo (current-buffer))
+ (set-buffer (gnus-get-buffer-create " *import file*"))
(erase-buffer)
(insert-file-contents file)
(goto-char (point-min))
lines (count-lines (point-min) (point-max)))
(insert "From: " (read-string "From: ") "\n"
"Subject: " (read-string "Subject: ") "\n"
- "Date: " (timezone-make-date-arpa-standard
- (current-time-string (nth 5 atts))
- (current-time-zone now)
- (current-time-zone now))
+ "Date: " (message-make-date (nth 5 atts))
"\n"
"Message-ID: " (message-make-message-id) "\n"
"Lines: " (int-to-string lines) "\n"
;; 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
gnus-newsgroup-name)
(error "The current newsgroup does not support article deletion"))
;; Compute the list of articles to delete.
- (let ((articles (gnus-summary-work-articles n))
+ (let ((articles (sort (copy-sequence (gnus-summary-work-articles n)) '<))
not-deleted)
(if (and gnus-novice-user
(not (gnus-yes-or-no-p
If FORCE is non-nil, 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 ((mail-parse-charset gnus-newsgroup-charset))
+ (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"))
+ (gnus-summary-show-article t)
+ (gnus-article-edit-article
+ 'mime-to-mml
+ `(lambda (no-highlight)
+ (let ((mail-parse-charset ',gnus-newsgroup-charset))
+ (mml-to-mime)
+ (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)
"Make edits to the current article permanent."
(interactive)
;; Replace the article.
- (if (and (not read-only)
- (not (gnus-request-replace-article
- (cdr gnus-article-current) (car gnus-article-current)
- (current-buffer))))
- (error "Couldn't replace article")
- ;; Update the summary buffer.
- (if (and references
- (equal (message-tokenize-header references " ")
- (message-tokenize-header
- (or (message-fetch-field "references") "") " ")))
- ;; We only have to update this line.
- (save-excursion
- (save-restriction
- (message-narrow-to-head)
- (let ((head (buffer-string))
- header)
- (nnheader-temp-write nil
- (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
- (save-excursion
- (set-buffer gnus-summary-buffer)
- gnus-newsgroup-dependencies)
- t))))
- (save-excursion
- (set-buffer gnus-summary-buffer)
- (gnus-data-set-header
- (gnus-data-find (cdr gnus-article-current))
- header)
- (gnus-summary-update-article-line
- (cdr gnus-article-current) header))))))
- ;; Update threads.
- (set-buffer (or buffer gnus-summary-buffer))
- (gnus-summary-update-article (cdr gnus-article-current)))
- ;; Prettify the article buffer again.
- (unless no-highlight
- (save-excursion
- (set-buffer gnus-article-buffer)
- (gnus-run-hooks 'gnus-article-display-hook)
- (set-buffer gnus-original-article-buffer)
- (gnus-request-article
- (cdr gnus-article-current)
- (car gnus-article-current) (current-buffer))))
- ;; Prettify the summary buffer line.
- (when (gnus-visual-p 'summary-highlight 'highlight)
- (gnus-run-hooks 'gnus-visual-mark-article-hook))))
+ (let ((buf (current-buffer)))
+ (with-temp-buffer
+ (insert-buffer-substring buf)
+ (if (and (not read-only)
+ (not (gnus-request-replace-article
+ (cdr gnus-article-current) (car gnus-article-current)
+ (current-buffer) t)))
+ (error "Couldn't replace article")
+ ;; Update the summary buffer.
+ (if (and references
+ (equal (message-tokenize-header references " ")
+ (message-tokenize-header
+ (or (message-fetch-field "references") "") " ")))
+ ;; We only have to update this line.
+ (save-excursion
+ (save-restriction
+ (message-narrow-to-head)
+ (let ((head (buffer-string))
+ header)
+ (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
+ (save-excursion
+ (set-buffer gnus-summary-buffer)
+ gnus-newsgroup-dependencies)
+ t))))
+ (save-excursion
+ (set-buffer gnus-summary-buffer)
+ (gnus-data-set-header
+ (gnus-data-find (cdr gnus-article-current))
+ header)
+ (gnus-summary-update-article-line
+ (cdr gnus-article-current) header))))))
+ ;; Update threads.
+ (set-buffer (or buffer gnus-summary-buffer))
+ (gnus-summary-update-article (cdr gnus-article-current)))
+ ;; Prettify the article buffer again.
+ (unless no-highlight
+ (save-excursion
+ (set-buffer gnus-article-buffer)
+ ;;;!!! Fix this -- article should be rehighlighted.
+ ;;;(gnus-run-hooks 'gnus-article-display-hook)
+ (set-buffer gnus-original-article-buffer)
+ (gnus-request-article
+ (cdr gnus-article-current)
+ (car gnus-article-current) (current-buffer))))
+ ;; Prettify the summary buffer line.
+ (when (gnus-visual-p 'summary-highlight 'highlight)
+ (gnus-run-hooks 'gnus-visual-mark-article-hook))))))
(defun gnus-summary-edit-wash (key)
"Perform editing command KEY in the article buffer."
;;; Respooling
-(defun gnus-summary-respool-query (&optional silent)
+(defun gnus-summary-respool-query (&optional silent trace)
"Query where the respool algorithm would put this article."
(interactive)
(let (gnus-mark-article-hook)
(set-buffer gnus-original-article-buffer)
(save-restriction
(message-narrow-to-head)
- (let ((groups (nnmail-article-group 'identity)))
+ (let ((groups (nnmail-article-group 'identity trace)))
(unless silent
(if groups
(message "This message would go to %s"
(message "This message would go to no groups"))
groups))))))
+(defun gnus-summary-respool-trace ()
+ "Trace where the respool algorithm would put this article.
+Display a buffer showing all fancy splitting patterns which matched."
+ (interactive)
+ (gnus-summary-respool-query nil t))
+
;; Summary marking commands.
(defun gnus-summary-kill-same-subject-and-select (&optional unmark)
"Mark ARTICLE replied and update the summary line."
(push article gnus-newsgroup-replied)
(let ((buffer-read-only nil))
- (when (gnus-summary-goto-subject article)
+ (when (gnus-summary-goto-subject article nil t)
(gnus-summary-update-secondary-mark article))))
(defun gnus-summary-set-bookmark (article)
(delq article gnus-newsgroup-processable)))
(when (gnus-summary-goto-subject article)
(gnus-summary-show-thread)
+ (gnus-summary-goto-subject article)
(gnus-summary-update-secondary-mark article)))
(defun gnus-summary-remove-process-mark (article)
(setq gnus-newsgroup-processable (delq article gnus-newsgroup-processable))
(when (gnus-summary-goto-subject article)
(gnus-summary-show-thread)
+ (gnus-summary-goto-subject article)
(gnus-summary-update-secondary-mark article)))
(defun gnus-summary-set-saved-mark (article)
The difference between N and the actual number of articles marked is
returned."
(interactive "p")
+ (gnus-summary-show-thread)
(let ((backward (< n 0))
(gnus-summary-goto-unread
(and gnus-summary-goto-unread
(setq mark (gnus-request-update-mark gnus-newsgroup-name article mark))
;; Check for auto-expiry.
(when (and gnus-newsgroup-auto-expire
- (or (= mark gnus-killed-mark) (= mark gnus-del-mark)
- (= mark gnus-catchup-mark) (= mark gnus-low-score-mark)
- (= mark gnus-ancient-mark)
- (= mark gnus-read-mark) (= mark gnus-souped-mark)
- (= mark gnus-duplicate-mark)))
+ (memq mark gnus-auto-expirable-marks))
(setq mark gnus-expirable-mark)
+ ;; Let the backend know about the mark change.
+ (setq mark (gnus-request-update-mark gnus-newsgroup-name article mark))
(push article gnus-newsgroup-expirable))
;; Set the mark in the buffer.
(gnus-summary-update-mark mark 'unread)
"Mark the current article quickly as unread with MARK."
(let* ((article (gnus-summary-article-number))
(old-mark (gnus-summary-article-mark article)))
+ ;; Allow the backend to change the mark.
+ (setq mark (gnus-request-update-mark gnus-newsgroup-name article mark))
(if (eq mark old-mark)
t
(if (<= article 0)
(push article gnus-newsgroup-dormant))
(t
(push article gnus-newsgroup-unreads)))
- (setq gnus-newsgroup-reads
- (delq (assq article gnus-newsgroup-reads)
- gnus-newsgroup-reads))
+ (gnus-pull article gnus-newsgroup-reads)
;; See whether the article is to be put in the cache.
(and gnus-use-cache
(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))))
"Mark ARTICLE with MARK. MARK can be any character.
Four MARK strings are reserved: `? ' (unread), `?!' (ticked),
`??' (dormant) and `?E' (expirable).
-If MARK is nil, then the default character `?D' is used.
+If MARK is nil, then the default character `?r' is used.
If ARTICLE is nil, then the article on the current line will be
marked."
;; The mark might be a string.
(when (stringp mark)
(setq mark (aref mark 0)))
;; If no mark is given, then we check auto-expiring.
- (and (not no-expire)
- gnus-newsgroup-auto-expire
- (or (not mark)
- (and (gnus-characterp mark)
- (or (= mark gnus-killed-mark) (= mark gnus-del-mark)
- (= mark gnus-catchup-mark) (= mark gnus-low-score-mark)
- (= mark gnus-read-mark) (= mark gnus-souped-mark)
- (= mark gnus-duplicate-mark))))
- (setq mark gnus-expirable-mark))
- (let* ((mark (or mark gnus-del-mark))
- (article (or article (gnus-summary-article-number)))
- (old-mark (gnus-summary-article-mark article)))
+ (when (null mark)
+ (setq mark gnus-del-mark))
+ (when (and (not no-expire)
+ gnus-newsgroup-auto-expire
+ (memq mark gnus-auto-expirable-marks))
+ (setq mark gnus-expirable-mark))
+ (let ((article (or article (gnus-summary-article-number)))
+ (old-mark (gnus-summary-article-mark article)))
+ ;; Allow the backend to change the mark.
+ (setq mark (gnus-request-update-mark gnus-newsgroup-name article mark))
(if (eq mark old-mark)
t
(unless article
(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))))
(let ((forward (cdr (assq type gnus-summary-mark-positions)))
(buffer-read-only nil))
(re-search-backward "[\n\r]" (gnus-point-at-bol) 'move-to-limit)
- (when (looking-at "\r")
- (incf forward))
- (when (and forward
- (<= (+ forward (point)) (point-max)))
- ;; Go to the right position on the line.
- (goto-char (+ forward (point)))
- ;; Replace the old mark with the new mark.
- (subst-char-in-region (point) (1+ (point)) (following-char) mark)
- ;; Optionally update the marks by some user rule.
- (when (eq type 'unread)
- (gnus-data-set-mark
- (gnus-data-find (gnus-summary-article-number)) mark)
- (gnus-summary-update-line (eq mark gnus-unread-mark))))))
+ (when forward
+ (when (looking-at "\r")
+ (incf forward))
+ (when (<= (+ forward (point)) (point-max))
+ ;; Go to the right position on the line.
+ (goto-char (+ forward (point)))
+ ;; Replace the old mark with the new mark.
+ (subst-char-in-region (point) (1+ (point)) (char-after) mark)
+ ;; Optionally update the marks by some user rule.
+ (when (eq type 'unread)
+ (gnus-data-set-mark
+ (gnus-data-find (gnus-summary-article-number)) mark)
+ (gnus-summary-update-line (eq mark gnus-unread-mark)))))))
(defun gnus-mark-article-as-read (article &optional mark)
"Enter ARTICLE in the pertinent lists and remove it from others."
(push article gnus-newsgroup-dormant))
(t
(push article gnus-newsgroup-unreads)))
- (setq gnus-newsgroup-reads
- (delq (assq article gnus-newsgroup-reads)
- gnus-newsgroup-reads))
+ (gnus-pull article gnus-newsgroup-reads)
t)))
(defalias 'gnus-summary-mark-as-unread-forward
The difference between N and the actual number of articles marked is
returned."
(interactive "p")
- (gnus-summary-mark-forward n gnus-del-mark t))
+ (gnus-summary-mark-forward n gnus-del-mark gnus-inhibit-user-auto-expire))
(defun gnus-summary-mark-as-read-backward (n)
"Mark the N articles as read backwards.
The difference between N and the actual number of articles marked is
returned."
(interactive "p")
- (gnus-summary-mark-forward (- n) gnus-del-mark t))
+ (gnus-summary-mark-forward
+ (- n) gnus-del-mark gnus-inhibit-user-auto-expire))
(defun gnus-summary-mark-as-read (&optional article mark)
"Mark current article as read.
(gnus-summary-article-header parent-article))))
(unless (and message-id (not (equal message-id "")))
(error "No message-id in desired parent"))
- ;; We don't want the article to be marked as read.
- (let (gnus-mark-article-hook)
- (gnus-summary-select-article t t nil current-article))
- (set-buffer gnus-original-article-buffer)
- (let ((buf (format "%s" (buffer-string))))
- (nnheader-temp-write nil
- (insert buf)
- (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"))
- (unless (gnus-request-replace-article
- current-article (car gnus-article-current)
- (current-buffer))
- (error "Couldn't replace article"))))
+ (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")))
(set-buffer gnus-summary-buffer)
(gnus-summary-unmark-all-processable)
(gnus-summary-update-article current-article)
(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)))
(article (intern (format "gnus-article-sort-by-%s" predicate)))
(gnus-thread-sort-functions
- (list
- (if (not reverse)
- thread
- `(lambda (t1 t2)
- (,thread t2 t1)))))
+ (if (not reverse)
+ thread
+ `(lambda (t1 t2)
+ (,thread t2 t1))))
(gnus-article-sort-functions
- (list
- (if (not reverse)
- article
- `(lambda (t1 t2)
- (,article t2 t1)))))
+ (if (not reverse)
+ article
+ `(lambda (t1 t2)
+ (,article t2 t1))))
(buffer-read-only)
(gnus-summary-prepare-hook nil))
;; We do the sorting by regenerating the threads.
(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 'gnus-summary-save-in-rmail))
+ (let ((gnus-default-article-saver 'rmail-output-to-rmail-file))
(gnus-summary-save-article arg)))
(defun gnus-summary-save-article-file (&optional arg)
"Pipe the current article through PROGRAM."
(interactive "sProgram: ")
(gnus-summary-select-article)
- (let ((mail-header-separator "")
- (art-buf (get-buffer gnus-article-buffer)))
+ (let ((mail-header-separator ""))
(gnus-eval-in-buffer-window gnus-article-buffer
(save-restriction
(widen)
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)
- (memq 'respool
- (assoc (symbol-name
- (car (gnus-find-method-for-group
- (symbol-name group))))
- gnus-valid-select-methods))))
+ (symbol-value group)
+ (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."
(error "No such group: %s" to-newsgroup)))
to-newsgroup))
+(defun gnus-summary-save-parts (type dir n reverse)
+ "Save parts matching TYPE to DIR.
+If REVERSE, save parts that do not match TYPE."
+ (interactive
+ (list (read-string "Save parts of type: " "image/.*")
+ (read-file-name "Save to directory: " t nil t)
+ 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 (mm-dissect-buffer) (mm-uu-dissect))))
+ (when handles
+ (gnus-summary-save-parts-1 type dir handles reverse))))))
+
+(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 (car (mm-handle-type handle))))
+ (string-match type (car (mm-handle-type handle))))
+ (let ((file (expand-file-name
+ (file-name-nondirectory
+ (or
+ (mail-content-type-get
+ (mm-handle-disposition handle) 'filename)
+ (concat gnus-newsgroup-name "." gnus-current-article)))
+ 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)
(lambda (f)
(if (equal f " ")
f
- (gnus-quote-arg-for-sh-or-csh f)))
+ (mm-quote-arg f)))
files " ")))))
(setq ps (cdr ps)))))
(if (and gnus-view-pseudos (not not-view))
(setq list (cdr list))))
(let ((face (cdar list)))
(unless (eq face (get-text-property beg 'face))
- (gnus-put-text-property
+ (gnus-put-text-property-excluding-characters-with-faces
beg end 'face
(setq face (if (boundp face) (symbol-value face) face)))
(when gnus-summary-highlight-line-function
(setq unread (cdr unread)))
(when (<= prev (cdr active))
(push (cons prev (cdr active)) read))
+ (setq read (if (> (length read) 1) (nreverse read) read))
(if compute
- (if (> (length read) 1) (nreverse read) read)
+ read
(save-excursion
(set-buffer gnus-group-buffer)
(gnus-undo-register
(gnus-info-set-read ',info ',(gnus-info-read info))
(gnus-get-unread-articles-in-group ',info (gnus-active ,group))
(gnus-group-update-group ,group t))))
+ ;; Propagate the read marks to the backend.
+ (if (gnus-check-backend-function 'request-set-mark group)
+ (let ((del (gnus-remove-from-range (gnus-info-read info) read))
+ (add (gnus-remove-from-range read (gnus-info-read info))))
+ (when (or add del)
+ (unless (gnus-check-group group)
+ (error "Can't open server for %s" group))
+ (gnus-request-set-mark
+ group (delq nil (list (if add (list add 'add '(read)))
+ (if del (list del 'del '(read)))))))))
;; Enter this list into the group info.
- (gnus-info-set-read
- info (if (> (length read) 1) (nreverse read) read))
+ (gnus-info-set-read info read)
;; Set the number of unread articles in gnus-newsrc-hashtb.
(gnus-get-unread-articles-in-group info (gnus-active group))
t))))
(gnus-summary-exit))
buffers)))))
+(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))))
+
+;;;
+;;; Mime Commands
+;;;
+
+(defun gnus-summary-display-buttonized (&optional show-all-parts)
+ "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")
+ (require 'gnus-art)
+ (let ((gnus-unbuttonized-mime-types nil)
+ (gnus-mime-display-multipart-as-mixed show-all-parts))
+ (gnus-summary-show-article)))
+
+(defun gnus-summary-repair-multipart (article)
+ "Add a Content-Type header to a multipart article without one."
+ (interactive (list (gnus-summary-article-number)))
+ (gnus-with-article article
+ (message-narrow-to-head)
+ (goto-char (point-max))
+ (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)))
+
+(defun gnus-summary-toggle-display-buttonized ()
+ "Toggle the buttonizing of the article buffer."
+ (interactive)
+ (require 'gnus-art)
+ (if (setq gnus-inhibit-mime-unbuttonizing
+ (not gnus-inhibit-mime-unbuttonizing))
+ (let ((gnus-unbuttonized-mime-types nil))
+ (gnus-summary-show-article))
+ (gnus-summary-show-article)))
+
+;;;
+;;; 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))
+
+;;;
+;;; 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)