;;; gnus-sum.el --- summary mode commands for Gnus
;; Copyright (C) 1996,97,98 Free Software Foundation, Inc.
-;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
;; This file is part of GNU Emacs.
(require 'gnus-range)
(require 'gnus-int)
(require 'gnus-undo)
+(require 'gnus-util)
(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)
(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)
"*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."
: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
: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.")
+
;;; 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)
(?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)))
;; Byte-compiler warning.
(defvar gnus-article-mode-map)
+;; MIME stuff.
+
+(defvar gnus-encoded-word-method-alist
+ '(("chinese" mail-decode-encoded-word-string rfc1843-decode-string)
+ (".*" mail-decode-encoded-word-string))
+ "Alist of regexps (to match group names) and lists of functions to be applied.")
+
+(defun gnus-multi-decode-encoded-word-string (string)
+ "Apply the functions from `gnus-encoded-word-method-alist' that match."
+ (let ((alist gnus-encoded-word-method-alist)
+ elem)
+ (while (setq elem (pop alist))
+ (when (string-match (car elem) gnus-newsgroup-name)
+ (pop elem)
+ (while elem
+ (setq string (funcall (pop elem) string)))
+ (setq alist nil)))
+ 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
"\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
"L" gnus-summary-lower-score
"\M-i" gnus-symbolic-argument
"h" gnus-summary-select-article-buffer
-
+
"V" gnus-summary-score-map
"X" gnus-uu-extract-map
"S" gnus-summary-send-map)
[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
"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
"d" gnus-article-treat-dumbquotes)
"b" gnus-article-hide-boring-headers
"s" gnus-article-hide-signature
"c" gnus-article-hide-citation
+ "C" gnus-article-hide-citation-in-followups
"p" gnus-article-hide-pgp
"P" gnus-article-hide-pem
"\C-c" gnus-article-hide-citation-maybe)
"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)
+
(gnus-define-keys (gnus-summary-wash-time-map "T" gnus-summary-wash-map)
"z" gnus-article-date-ut
"u" gnus-article-date-ut
"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)
["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])
("Date"
["Local" gnus-article-date-local t]
["ISO8601" gnus-article-date-iso8601 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)])
["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]
+ ["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]
(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-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))
(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
(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))
(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)
(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)
(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.
gnus-newsgroup-dependencies)))
threads))
+;; Build the thread tree.
+(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
+if it was already present.
+
+If `gnus-summary-ignore-duplicates' is nil then duplicate Message-IDs
+will not be entered in the DEPENDENCIES table. Otherwise duplicate
+Message-IDs will be renamed be renamed to a unique Message-ID before
+being entered.
+
+Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise."
+ (let* ((id (mail-header-id header))
+ (id-dep (and id (intern id dependencies)))
+ ref ref-dep ref-header)
+ ;; Enter this `header' in the `dependencies' table.
+ (cond
+ ((not id-dep)
+ (setq header nil))
+ ;; The first two cases do the normal part: enter a new `header'
+ ;; in the `dependencies' table.
+ ((not (boundp id-dep))
+ (set id-dep (list header)))
+ ((null (car (symbol-value id-dep)))
+ (setcar (symbol-value id-dep) header))
+
+ ;; From here the `header' was already present in the
+ ;; `dependencies' table.
+ (force-new
+ ;; Overrides an existing entry;
+ ;; just set the header part of the entry.
+ (setcar (symbol-value id-dep) header))
+
+ ;; Renames the existing `header' to a unique Message-ID.
+ ((not gnus-summary-ignore-duplicates)
+ ;; An article with this Message-ID has already been seen.
+ ;; We rename the Message-ID.
+ (set (setq id-dep (intern (setq id (nnmail-message-id)) dependencies))
+ (list header))
+ (mail-header-set-id header id))
+
+ ;; The last case ignores an existing entry, except it adds any
+ ;; additional Xrefs (in case the two articles came from different
+ ;; servers.
+ ;; Also sets `header' to `nil' meaning that the `dependencies'
+ ;; table was *not* modified.
+ (t
+ (mail-header-set-xref
+ (car (symbol-value id-dep))
+ (concat (or (mail-header-xref (car (symbol-value id-dep)))
+ "")
+ (or (mail-header-xref header) "")))
+ (setq header nil)))
+
+ (when header
+ ;; First check if that we are not creating a References loop.
+ (setq ref (gnus-parent-id (mail-header-references header)))
+ (while (and ref
+ (setq ref-dep (intern-soft ref dependencies))
+ (boundp ref-dep)
+ (setq ref-header (car (symbol-value ref-dep))))
+ (if (string= id ref)
+ ;; Yuk! This is a reference loop. Make the article be a
+ ;; root article.
+ (progn
+ (mail-header-set-references (car (symbol-value id-dep)) "none")
+ (setq ref nil))
+ (setq ref (gnus-parent-id (mail-header-references ref-header)))))
+ (setq ref (gnus-parent-id (mail-header-references header)))
+ (setq ref-dep (intern (or ref "none") dependencies))
+ (if (boundp ref-dep)
+ (setcdr (symbol-value ref-dep)
+ (nconc (cdr (symbol-value ref-dep))
+ (list (symbol-value id-dep))))
+ (set ref-dep (list nil (symbol-value id-dep)))))
+ header))
+
(defun gnus-build-sparse-threads ()
(let ((headers gnus-newsgroup-headers)
- (deps gnus-newsgroup-dependencies)
+ (gnus-summary-ignore-duplicates t)
header references generation relations
- cthread subject child end pthread relation new-child children)
+ 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)))
(when (search-backward "<" nil t)
- ;; This is a rather weak for of loop-checking, but if
- ;; an article contains the same Message-ID twice in
- ;; the References header, this will catch it. I haven't
- ;; considered other forms of thread loop preventions,
- ;; though -- I think one should probably go through
- ;; the entire thread after building it and break
- ;; any loops that are found.
- (unless (member (setq new-child (buffer-substring (point) end))
- children)
- (push (list (incf generation)
- child (setq child new-child)
- subject)
- relations)
- (push child children))))
- (push (list (1+ generation) child nil subject) relations)
+ (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.
- (setq relations (sort relations 'car-less-than-car))
- (while (setq relation (pop relations))
- (when (if (boundp (setq cthread (intern (cadr relation) deps)))
- (unless (car (symbol-value cthread))
- ;; Make this article the parent of these threads.
- (setcar (symbol-value cthread)
- (vector gnus-reffed-article-number
- (cadddr relation)
- "" ""
- (cadr relation)
- (or (caddr relation) "") 0 0 "")))
- (set cthread (list (vector gnus-reffed-article-number
- (cadddr relation)
- "" "" (cadr relation)
- (or (caddr relation) "") 0 0 ""))))
- (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)
- ;; Make this new thread the child of its parent.
- (if (boundp (setq pthread (intern (or (caddr relation) "none") deps)))
- (setcdr (symbol-value pthread)
- (nconc (cdr (symbol-value pthread))
- (list (symbol-value cthread))))
- (set pthread (list nil (symbol-value cthread))))))
+ (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 (cdr heads))
(setq id (symbol-name refs))
(while (and (setq id (gnus-build-get-header id))
- (not (car (gnus-gethash
- id gnus-newsgroup-dependencies)))))
+ (not (car (gnus-id-to-thread id)))))
(setq heads nil)))))
gnus-newsgroup-dependencies)))
+;; 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-decode-encoded-word-function
+ (gnus-nov-field)) ; subject
+ (funcall gnus-decode-encoded-word-function
+ (gnus-nov-field)) ; from
+ (gnus-nov-field) ; date
+ (or (gnus-nov-field)
+ (nnheader-generate-fake-message-id)) ; id
+ (gnus-nov-field) ; refs
+ (gnus-nov-read-integer) ; chars
+ (gnus-nov-read-integer) ; lines
+ (unless (= (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)))
+
(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
(defun gnus-build-all-threads ()
"Read all the headers."
- (let ((deps gnus-newsgroup-dependencies)
- (gnus-summary-ignore-duplicates t)
- found header article)
+ (let ((gnus-summary-ignore-duplicates t)
+ (dependencies gnus-newsgroup-dependencies)
+ header article)
(save-excursion
(set-buffer nntp-server-buffer)
(let ((case-fold-search nil))
(goto-char (point-min))
(while (not (eobp))
(ignore-errors
- (setq article (read (current-buffer)))
- (setq header (gnus-nov-parse-line article deps)))
+ (setq article (read (current-buffer))
+ 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)))
(defun gnus-root-id (id)
"Return the id of the root of the thread where ID appears."
(let (last-id prev)
- (while (and id (setq prev (car (gnus-gethash
- id gnus-newsgroup-dependencies))))
+ (while (and id (setq prev (car (gnus-id-to-thread id))))
(setq last-id id
id (gnus-parent-id (mail-header-references prev))))
last-id))
(defun gnus-remove-thread (id &optional dont-remove)
"Remove the thread that has ID in it."
- (let ((dep gnus-newsgroup-dependencies)
- headers thread last-id)
+ (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.
(if thread
(unless dont-remove
(setq gnus-newsgroup-threads (delq thread gnus-newsgroup-threads)))
- (setq thread (gnus-gethash last-id dep)))
+ (setq thread (gnus-id-to-thread last-id)))
(when thread
(prog1
thread ; We return this thread.
(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."
(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))))
(apply gnus-thread-score-function
(or (append
(mapcar 'gnus-thread-total-score
- (cdr (gnus-gethash (mail-header-id root)
- gnus-newsgroup-dependencies)))
+ (cdr (gnus-id-to-thread (mail-header-id root))))
(when (> (mail-header-number root) 0)
(list (or (cdr (assq (mail-header-number root)
gnus-newsgroup-scored))
(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-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))
;; 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 mode-string (- max-len 3))
"...")))
;; Pad the mode string a bit.
(setq mode-string (format (format "%%-%ds" max-len) mode-string))))
;; 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)
(or dependencies
(save-excursion (set-buffer gnus-summary-buffer)
gnus-newsgroup-dependencies)))
- headers id id-dep ref-dep end ref)
+ headers id end ref)
(save-excursion
(set-buffer nntp-server-buffer)
;; Translate all TAB characters into SPACE characters.
(subst-char-in-region (point-min) (point-max) ?\t ? 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)
(funcall gnus-alter-header-function header)
(setq id (mail-header-id header)
ref (gnus-parent-id (mail-header-references header))))
-
- ;; We do the threading while we read the headers. The
- ;; message-id and the last reference are both entered into
- ;; the same hash table. Some tippy-toeing around has to be
- ;; done in case an article has arrived before the article
- ;; which it refers to.
- (if (boundp (setq id-dep (intern id dependencies)))
- (if (and (car (symbol-value id-dep))
- (not force-new))
- ;; An article with this Message-ID has already been seen.
- (if gnus-summary-ignore-duplicates
- ;; We ignore this one, except we add
- ;; any additional Xrefs (in case the two articles
- ;; came from different servers).
- (progn
- (mail-header-set-xref
- (car (symbol-value id-dep))
- (concat (or (mail-header-xref
- (car (symbol-value id-dep)))
- "")
- (or (mail-header-xref header) "")))
- (setq header nil))
- ;; We rename the Message-ID.
- (set
- (setq id-dep (intern (setq id (nnmail-message-id))
- dependencies))
- (list header))
- (mail-header-set-id header id))
- (setcar (symbol-value id-dep) header))
- (set id-dep (list header)))
- (when header
- (if (boundp (setq ref-dep (intern (or ref "none") dependencies)))
- (setcdr (symbol-value ref-dep)
- (nconc (cdr (symbol-value ref-dep))
- (list (symbol-value id-dep))))
- (set ref-dep (list nil (symbol-value id-dep))))
+
+ (when (setq header
+ (gnus-dependencies-add-header
+ header dependencies force-new))
(push header headers))
(goto-char (point-max))
(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)))
-
-;; (defvar gnus-nov-none-counter 0)
-
-;; This function has to be called with point after the article number
-;; on the beginning of the line.
-(defun gnus-nov-parse-line (number dependencies &optional force-new)
- (let ((eol (gnus-point-at-eol))
- (buffer (current-buffer))
- header ref id id-dep ref-dep)
-
- ;; overview: [num subject from date id refs chars lines misc]
- (unwind-protect
- (progn
- (narrow-to-region (point) eol)
- (unless (eobp)
- (forward-char))
-
- (setq header
- (vector
- number ; number
- (funcall
- gnus-unstructured-field-decoder (gnus-nov-field)) ; subject
- (funcall
- gnus-structured-field-decoder (gnus-nov-field)) ; from
- (gnus-nov-field) ; date
- (setq id (or (gnus-nov-field)
- (nnheader-generate-fake-message-id))) ; id
- (progn
- (let ((beg (point)))
- (search-forward "\t" eol)
- (if (search-backward ">" beg t)
- (setq ref
- (buffer-substring
- (1+ (point))
- (or (search-backward "<" beg t) beg)))
- (setq ref nil))
- (goto-char beg))
- (gnus-nov-field)) ; refs
- (gnus-nov-read-integer) ; chars
- (gnus-nov-read-integer) ; lines
- (if (= (following-char) ?\n)
- nil
- (gnus-nov-field))))) ; misc
-
- (widen))
-
- (when gnus-alter-header-function
- (funcall gnus-alter-header-function header)
- (setq id (mail-header-id header)
- ref (gnus-parent-id (mail-header-references header))))
-
- ;; We build the thread tree.
- (when (equal id ref)
- ;; This article refers back to itself. Naughty, naughty.
- (setq ref nil))
- (if (boundp (setq id-dep (intern id dependencies)))
- (if (and (car (symbol-value id-dep))
- (not force-new))
- ;; An article with this Message-ID has already been seen.
- (if gnus-summary-ignore-duplicates
- ;; We ignore this one, except we add any additional
- ;; Xrefs (in case the two articles came from different
- ;; servers.
- (progn
- (mail-header-set-xref
- (car (symbol-value id-dep))
- (concat (or (mail-header-xref
- (car (symbol-value id-dep)))
- "")
- (or (mail-header-xref header) "")))
- (setq header nil))
- ;; We rename the Message-ID.
- (set
- (setq id-dep (intern (setq id (nnmail-message-id))
- dependencies))
- (list header))
- (mail-header-set-id header id))
- (setcar (symbol-value id-dep) header))
- (set id-dep (list header)))
- (when header
- (if (boundp (setq ref-dep (intern (or ref "none") dependencies)))
- (setcdr (symbol-value ref-dep)
- (nconc (cdr (symbol-value ref-dep))
- (list (symbol-value id-dep))))
- (set ref-dep (list nil (symbol-value id-dep)))))
- header))
-
;; Goes through the xover lines and returns a list of vectors
(defun gnus-get-newsgroup-headers-xover (sequence &optional
force-new dependencies
(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)
+ "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))
(t
(gnus-read-header id))))
(number (and (numberp id) id))
- pos d)
+ 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))
;;; Process/prefix in the summary buffer
(defun gnus-summary-work-articles (n)
- "Return a list of articles to be worked upon. The prefix argument,
-the list of process marked articles, and the current article will be
-taken into consideration."
+ "Return a list of articles to be worked upon.
+The prefix argument, the list of process marked articles, and the
+current article will be taken into consideration."
(save-excursion
(set-buffer gnus-summary-buffer)
(cond
;; 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))))
+
+(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)
;; 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
(setq group-point (point))
(if temporary
nil ;Nothing to do.
+ (when (gnus-buffer-live-p gnus-article-buffer)
+ (save-excursion
+ (set-buffer gnus-article-buffer)
+ (mapcar 'mm-destroy-part 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)
(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-y-or-n-p "Discard changes to this group and exit? "))
(gnus-async-halt-prefetch)
(gnus-run-hooks 'gnus-summary-prepare-exit-hook)
+ (when (gnus-buffer-live-p gnus-article-buffer)
+ (save-excursion
+ (set-buffer gnus-article-buffer)
+ (mapcar 'mm-destroy-part 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)
(gnus-handle-ephemeral-exit quit-config)))))
(defun gnus-handle-ephemeral-exit (quit-config)
- "Handle movement when leaving an ephemeral group. The state
-which existed when entering the ephemeral is reset."
+ "Handle movement when leaving an ephemeral group.
+The state which existed when entering the ephemeral is reset."
(if (not (buffer-name (car quit-config)))
(gnus-configure-windows 'group 'force)
(set-buffer (car quit-config))
;; 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.
(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)
(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
(interactive "nTime in days: \nP")
(prog1
(let ((data gnus-newsgroup-data)
- (cutoff (nnmail-days-to-time age))
+ (cutoff (days-to-time age))
articles d date is-younger)
(while (setq d (pop data))
(when (and (vectorp (gnus-data-header d))
(setq date (mail-header-date (gnus-data-header d))))
- (setq is-younger (nnmail-time-less
- (nnmail-time-since (nnmail-date-to-time date))
+ (setq is-younger (time-less-p
+ (time-since (date-to-time date))
cutoff))
- (when (if younger-p is-younger (not is-younger))
+ (when (if younger-p
+ is-younger
+ (not is-younger))
(push (gnus-data-number d) articles))))
(gnus-summary-limit (nreverse articles)))
(gnus-summary-position-point)))
'<)
(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
(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.
(gnus-use-trees nil) ;Inhibit updating tree buffer.
(sum (current-buffer))
(found nil)
- point)
+ point gnus-display-mime-function)
(gnus-save-hidden-threads
(gnus-summary-select-article)
(set-buffer gnus-article-buffer)
(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)
(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)
(gnus-summary-select-article nil 'force)))
(gnus-summary-goto-subject gnus-current-article)
(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
(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.
;;;!!!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))))
(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"
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
"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 buf)
+ (if (and (not read-only)
+ (not (gnus-request-replace-article
+ (cdr gnus-article-current) (car gnus-article-current)
+ (current-buffer)
+ (not gnus-article-decoded-p))))
+ (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)
+ (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)
(= mark gnus-read-mark) (= mark gnus-souped-mark)
(= mark gnus-duplicate-mark)))
(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
(let* ((mark (or mark gnus-del-mark))
(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
(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
(gnus-summary-select-article t t nil current-article))
(set-buffer gnus-original-article-buffer)
(let ((buf (format "%s" (buffer-string))))
- (nnheader-temp-write nil
+ (with-temp-buffer
(insert buf)
(goto-char (point-min))
(if (re-search-forward "^References: " nil t)
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)
(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))
(when (and header
(gnus-summary-article-sparse-p (mail-header-number header)))
(let* ((parent (gnus-parent-id (mail-header-references header)))
- (thread
- (and parent
- (gnus-gethash parent gnus-newsgroup-dependencies))))
+ (thread (and parent (gnus-id-to-thread parent))))
(when thread
(delq (assq header thread) thread))))
;; We have to really fetch the header to this article.
(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