:type 'string)
(defcustom gnus-summary-goto-unread t
- "*If non-nil, marking commands will go to the next unread article.
-If `never', \\<gnus-summary-mode-map>\\[gnus-summary-next-page] will go to the next article,
-whether it is read or not."
+ "*If t, marking commands will go to the next unread article.
+If `never', commands that usually go to the next unread article, will
+go to the next article, whether it is read or not.
+If nil, only the marking commands will go to the next (un)read article."
:group 'gnus-summary
:type '(choice (const :tag "off" nil)
(const never)
"?" gnus-summary-mark-as-dormant
"\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-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
"r" gnus-summary-refer-parent-article
"R" gnus-summary-refer-references
"g" gnus-summary-show-article
- "s" gnus-summary-isearch-article)
+ "s" gnus-summary-isearch-article
+ "P" gnus-summary-print-article)
(gnus-define-keys (gnus-summary-wash-map "W" gnus-summary-mode-map)
"b" gnus-article-add-buttons
"Score"
(nconc
(list
- ["Enter score..." gnus-summary-score-entry t])
+ ["Enter score..." gnus-summary-score-entry t]
+ ["Customize" gnus-score-customize t])
(gnus-make-score-map 'increase)
(gnus-make-score-map 'lower)
'(("Mark"
["Save in RMAIL mbox" gnus-summary-save-article-rmail t]
["Save body in file" gnus-summary-save-article-body-file t]
["Pipe through a filter" gnus-summary-pipe-output t]
- ["Add to SOUP packet" gnus-soup-add-article t])
+ ["Add to SOUP packet" gnus-soup-add-article t]
+ ["Print" gnus-summary-print-article t])
("Backend"
["Respool article..." gnus-summary-respool-article t]
["Move article..." gnus-summary-move-article
["Uuencode and post" gnus-uu-post-news t]
["Followup via news" gnus-summary-followup-to-mail t]
["Followup via news and yank"
- gnus-summary-followup-with-original-to-mail t]
+ gnus-summary-followup-to-mail-with-original t]
;;("Draft"
;;["Send" gnus-summary-send-draft t]
;;["Send bounced" gnus-resend-bounced-mail t])
(easy-menu-define
gnus-summary-misc-menu gnus-summary-mode-map ""
'("Misc"
- ("Mark"
- ("Read"
- ["Mark as read" gnus-summary-mark-as-read-forward t]
- ["Mark same subject and select"
- gnus-summary-kill-same-subject-and-select t]
- ["Mark same subject" gnus-summary-kill-same-subject t]
- ["Catchup" gnus-summary-catchup t]
- ["Catchup all" gnus-summary-catchup-all t]
- ["Catchup to here" gnus-summary-catchup-to-here t]
- ["Catchup region" gnus-summary-mark-region-as-read t]
- ["Mark excluded" gnus-summary-limit-mark-excluded-as-read t])
- ("Various"
- ["Tick" gnus-summary-tick-article-forward t]
- ["Mark as dormant" gnus-summary-mark-as-dormant t]
- ["Remove marks" gnus-summary-clear-mark-forward t]
- ["Set expirable mark" gnus-summary-mark-as-expirable t]
- ["Set bookmark" gnus-summary-set-bookmark t]
- ["Remove bookmark" gnus-summary-remove-bookmark t])
- ("Limit"
- ["Marks..." gnus-summary-limit-to-marks t]
- ["Subject..." gnus-summary-limit-to-subject t]
- ["Author..." gnus-summary-limit-to-author t]
- ["Score" gnus-summary-limit-to-score t]
- ["Unread" gnus-summary-limit-to-unread t]
- ["Non-dormant" gnus-summary-limit-exclude-dormant t]
- ["Articles" gnus-summary-limit-to-articles t]
- ["Pop limit" gnus-summary-pop-limit t]
- ["Show dormant" gnus-summary-limit-include-dormant t]
- ["Hide childless dormant"
- gnus-summary-limit-exclude-childless-dormant t]
- ;;["Hide thread" gnus-summary-limit-exclude-thread t]
- ["Show expunged" gnus-summary-show-all-expunged t])
- ("Process mark"
- ["Set mark" gnus-summary-mark-as-processable t]
- ["Remove mark" gnus-summary-unmark-as-processable t]
- ["Remove all marks" gnus-summary-unmark-all-processable t]
- ["Mark above" gnus-uu-mark-over t]
- ["Mark series" gnus-uu-mark-series t]
- ["Mark region" gnus-uu-mark-region t]
- ["Mark by regexp..." gnus-uu-mark-by-regexp t]
- ["Mark all" gnus-uu-mark-all t]
- ["Mark buffer" gnus-uu-mark-buffer t]
- ["Mark sparse" gnus-uu-mark-sparse t]
- ["Mark thread" gnus-uu-mark-thread t]
- ["Unmark thread" gnus-uu-unmark-thread t]
- ("Process Mark Sets"
- ["Kill" gnus-summary-kill-process-mark t]
- ["Yank" gnus-summary-yank-process-mark
- gnus-newsgroup-process-stack]
- ["Save" gnus-summary-save-process-mark t])))
+ ("Mark Read"
+ ["Mark as read" gnus-summary-mark-as-read-forward t]
+ ["Mark same subject and select"
+ gnus-summary-kill-same-subject-and-select t]
+ ["Mark same subject" gnus-summary-kill-same-subject t]
+ ["Catchup" gnus-summary-catchup t]
+ ["Catchup all" gnus-summary-catchup-all t]
+ ["Catchup to here" gnus-summary-catchup-to-here t]
+ ["Catchup region" gnus-summary-mark-region-as-read t]
+ ["Mark excluded" gnus-summary-limit-mark-excluded-as-read t])
+ ("Mark Various"
+ ["Tick" gnus-summary-tick-article-forward t]
+ ["Mark as dormant" gnus-summary-mark-as-dormant t]
+ ["Remove marks" gnus-summary-clear-mark-forward t]
+ ["Set expirable mark" gnus-summary-mark-as-expirable t]
+ ["Set bookmark" gnus-summary-set-bookmark t]
+ ["Remove bookmark" gnus-summary-remove-bookmark t])
+ ("Mark Limit"
+ ["Marks..." gnus-summary-limit-to-marks t]
+ ["Subject..." gnus-summary-limit-to-subject t]
+ ["Author..." gnus-summary-limit-to-author t]
+ ["Score" gnus-summary-limit-to-score t]
+ ["Unread" gnus-summary-limit-to-unread t]
+ ["Non-dormant" gnus-summary-limit-exclude-dormant t]
+ ["Articles" gnus-summary-limit-to-articles t]
+ ["Pop limit" gnus-summary-pop-limit t]
+ ["Show dormant" gnus-summary-limit-include-dormant t]
+ ["Hide childless dormant"
+ gnus-summary-limit-exclude-childless-dormant t]
+ ;;["Hide thread" gnus-summary-limit-exclude-thread t]
+ ["Show expunged" gnus-summary-show-all-expunged t])
+ ("Process Mark"
+ ["Set mark" gnus-summary-mark-as-processable t]
+ ["Remove mark" gnus-summary-unmark-as-processable t]
+ ["Remove all marks" gnus-summary-unmark-all-processable t]
+ ["Mark above" gnus-uu-mark-over t]
+ ["Mark series" gnus-uu-mark-series t]
+ ["Mark region" gnus-uu-mark-region t]
+ ["Mark by regexp..." gnus-uu-mark-by-regexp t]
+ ["Mark all" gnus-uu-mark-all t]
+ ["Mark buffer" gnus-uu-mark-buffer t]
+ ["Mark sparse" gnus-uu-mark-sparse t]
+ ["Mark thread" gnus-uu-mark-thread t]
+ ["Unmark thread" gnus-uu-unmark-thread t]
+ ("Process Mark Sets"
+ ["Kill" gnus-summary-kill-process-mark t]
+ ["Yank" gnus-summary-yank-process-mark
+ gnus-newsgroup-process-stack]
+ ["Save" gnus-summary-save-process-mark t]))
("Scroll article"
["Page forward" gnus-summary-next-page t]
["Page backward" gnus-summary-prev-page t]
["Sort by author" gnus-summary-sort-by-author 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 score" gnus-summary-sort-by-score t]
+ ["Sort by lines" gnus-summary-sort-by-lines t])
("Help"
["Fetch group FAQ" gnus-summary-fetch-faq t]
["Describe group" gnus-summary-describe-group t]
("Modes"
["Pick and read" gnus-pick-mode t]
["Binary" gnus-binary-mode t])
+ ("Regeneration"
+ ["Regenerate" gnus-summary-prepare t]
+ ["Insert cached articles" gnus-summary-insert-cached-articles t]
+ ["Toggle threading" gnus-summary-toggle-threads t])
["Filter articles..." gnus-summary-execute-command t]
["Run command on subjects..." gnus-summary-universal-argument t]
["Toggle line truncation" gnus-summary-toggle-truncation t]
\\{gnus-summary-mode-map}"
(interactive)
- (when (and menu-bar-mode
- (gnus-visual-p 'summary-menu 'menu))
+ (when (gnus-visual-p 'summary-menu 'menu)
(gnus-summary-make-menu-bar))
(kill-all-local-variables)
(gnus-summary-make-local-variables)
(make-local-variable 'gnus-summary-line-format)
(make-local-variable 'gnus-summary-line-format-spec)
(make-local-variable 'gnus-summary-mark-positions)
- (gnus-update-format-specifications nil 'summary 'summary-mode 'summary-dummy)
- (gnus-update-summary-mark-positions)
(gnus-make-local-hook 'post-command-hook)
(gnus-add-hook 'post-command-hook 'gnus-clear-inboxes-moved nil t)
- (run-hooks 'gnus-summary-mode-hook))
+ (run-hooks 'gnus-summary-mode-hook)
+ (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."
(setcdr list (cdr data))
(setcdr data ilist)
(when offset
- (gnus-data-update-list (cdr data) offset)))
+ (gnus-data-update-list (cdr list) offset)))
(setq gnus-newsgroup-data-reverse nil))))
(defun gnus-data-remove (article &optional offset)
(let ((data gnus-newsgroup-data))
(if (= (gnus-data-number (car data)) article)
- (setq gnus-newsgroup-data (cdr gnus-newsgroup-data)
- gnus-newsgroup-data-reverse nil)
+ (progn
+ (setq gnus-newsgroup-data (cdr gnus-newsgroup-data)
+ gnus-newsgroup-data-reverse nil)
+ (when offset
+ (gnus-data-update-list gnus-newsgroup-data offset)))
(while (cdr data)
(when (= (gnus-data-number (cadr data)) article)
(setcdr data (cddr 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)))))
+(defmacro gnus-summary-article-sparse-p (article)
+ "Say whether this article is a sparse article or not."
+ ` (memq ,article gnus-newsgroup-sparse))
+
+(defmacro gnus-summary-article-ancient-p (article)
+ "Say whether this article is a sparse article or not."
+ `(memq ,article gnus-newsgroup-ancient))
+
(defun gnus-article-parent-p (number)
"Say whether this article is a parent or not."
(let ((data (gnus-data-find-list number)))
(set-buffer gnus-article-buffer)
(setq gnus-summary-buffer summary))))))
+(defun gnus-summary-article-unread-p (article)
+ "Say whether ARTICLE is unread or not."
+ (memq article gnus-newsgroup-unreads))
+
(defun gnus-summary-first-article-p (&optional article)
"Return whether ARTICLE is the first article in the buffer."
(if (not (setq article (or article (gnus-summary-article-number))))
(let ((gnus-replied-mark 129)
(gnus-score-below-mark 130)
(gnus-score-over-mark 130)
- (thread nil)
- (gnus-visual nil)
(spec gnus-summary-line-format-spec)
- pos)
+ thread gnus-visual pos)
(save-excursion
(gnus-set-work-buffer)
(let ((gnus-summary-line-format-spec spec))
(gnus-tmp-from (mail-header-from gnus-tmp-header))
(gnus-tmp-name
(cond
- ((string-match "(.+)" gnus-tmp-from)
- (substring gnus-tmp-from
- (1+ (match-beginning 0)) (1- (match-end 0))))
((string-match "<[^>]+> *$" gnus-tmp-from)
(let ((beg (match-beginning 0)))
(or (and (string-match "^\"[^\"]*\"" gnus-tmp-from)
(substring gnus-tmp-from (1+ (match-beginning 0))
(1- (match-end 0))))
(substring gnus-tmp-from 0 beg))))
+ ((string-match "(.+)" gnus-tmp-from)
+ (substring gnus-tmp-from
+ (1+ (match-beginning 0)) (1- (match-end 0))))
(t gnus-tmp-from)))
(gnus-tmp-subject (mail-header-subject gnus-tmp-header))
(gnus-tmp-number (mail-header-number gnus-tmp-header))
(setq threads (cdr threads)))
result))
+(defun gnus-thread-loop-p (root thread)
+ "Say whether ROOT is in THREAD."
+ (let ((th (cdr thread)))
+ (while (and th
+ (not (eq (caar th) root)))
+ (pop th))
+ (if th
+ ;; We have found a loop.
+ (let (ref-dep)
+ (setcdr thread (delq (car th) (cdr thread)))
+ (if (boundp (setq ref-dep (intern "none"
+ gnus-newsgroup-dependencies)))
+ (setcdr (symbol-value ref-dep)
+ (nconc (cdr (symbol-value ref-dep))
+ (list (car th))))
+ (set ref-dep (list nil (car th))))
+ 1)
+ ;; Recurse down into the sub-threads and look for loops.
+ (apply '+
+ (mapcar
+ (lambda (thread) (gnus-thread-loop-p root thread))
+ (cdr thread))))))
+
(defun gnus-make-threads ()
"Go through the dependency hashtb and find the roots. Return all threads."
(let (threads)
- (mapatoms
- (lambda (refs)
- (unless (car (symbol-value refs))
- ;; These threads do not refer back to any other articles,
- ;; so they're roots.
- (setq threads (append (cdr (symbol-value refs)) threads))))
- gnus-newsgroup-dependencies)
+ (while (catch 'infloop
+ (mapatoms
+ (lambda (refs)
+ ;; Deal with self-referencing References loops.
+ (when (and (car (symbol-value refs))
+ (not (zerop
+ (apply
+ '+
+ (mapcar
+ (lambda (thread)
+ (gnus-thread-loop-p
+ (car (symbol-value refs)) thread))
+ (cdr (symbol-value refs)))))))
+ (setq threads nil)
+ (throw 'infloop t))
+ (unless (car (symbol-value refs))
+ ;; These threads do not refer back to any other articles,
+ ;; so they're roots.
+ (setq threads (append (cdr (symbol-value refs)) threads))))
+ gnus-newsgroup-dependencies)))
threads))
(defun gnus-build-sparse-threads ()
(defun gnus-rebuild-thread (id)
"Rebuild the thread containing ID."
(let ((buffer-read-only nil)
- current thread data)
+ old-pos current thread data)
(if (not gnus-show-threads)
(setq thread (list (car (gnus-id-to-thread id))))
;; Get the thread this article is part of.
(setq thread (gnus-remove-thread id)))
+ (setq old-pos (gnus-point-at-bol))
(setq current (save-excursion
(and (zerop (forward-line -1))
(gnus-summary-article-number))))
(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)
- (gnus-data-compute-positions)
+ (gnus-data-enter-list current data (- (point) old-pos))
(setq gnus-newsgroup-threads (nconc threads gnus-newsgroup-threads)))))
(defun gnus-number-to-header (number)
(defun gnus-remove-thread-1 (thread)
"Remove the thread THREAD recursively."
- (let ((number (mail-header-number (car thread)))
- pos)
- (when (setq pos (text-property-any
- (point-min) (point-max) 'gnus-number number))
- (goto-char pos)
- (gnus-delete-line)
- (gnus-data-remove number))
- (setq thread (cdr thread))
+ (let ((number (mail-header-number (pop thread)))
+ d)
+ (setq thread (reverse thread))
(while thread
- (gnus-remove-thread-1 (pop thread)))))
+ (gnus-remove-thread-1 (pop thread)))
+ (when (setq d (gnus-data-find number))
+ (goto-char (gnus-data-pos d))
+ (gnus-data-remove
+ number
+ (- (gnus-point-at-bol)
+ (prog1
+ (1+ (gnus-point-at-eol))
+ (gnus-delete-line)))))))
(defun gnus-sort-threads (threads)
"Sort THREADS."
(gnus-article-sort-by-number
(gnus-thread-header h1) (gnus-thread-header h2)))
+(defsubst gnus-article-sort-by-lines (h1 h2)
+ "Sort articles by article Lines header."
+ (< (mail-header-lines h1)
+ (mail-header-lines h2)))
+
+(defun gnus-thread-sort-by-lines (h1 h2)
+ "Sort threads by root article Lines header."
+ (gnus-article-sort-by-lines
+ (gnus-thread-header h1) (gnus-thread-header h2)))
+
(defsubst gnus-article-sort-by-author (h1 h2)
"Sort articles by root author."
(string-lessp
gnus-tmp-header nil))
;; If the article lies outside the current limit,
;; then we do not display it.
- ((and (not (memq number gnus-newsgroup-limit))
- (not gnus-tmp-dummy-line))
+ ((not (memq number gnus-newsgroup-limit))
(setq gnus-tmp-gathered
(nconc (mapcar
(lambda (h) (mail-header-number (car h)))
default-score)
gnus-summary-mark-below)
;; Don't touch sparse articles.
- (not (memq number gnus-newsgroup-sparse))
- (not (memq number gnus-newsgroup-ancient)))
+ (not (gnus-summary-article-sparse-p number))
+ (not (gnus-summary-article-ancient-p number)))
(setq gnus-newsgroup-unreads
(delq number gnus-newsgroup-unreads))
(if gnus-newsgroup-auto-expire
gnus-tmp-from (mail-header-from gnus-tmp-header)
gnus-tmp-name
(cond
- ((string-match "(.+)" gnus-tmp-from)
- (substring gnus-tmp-from
- (1+ (match-beginning 0)) (1- (match-end 0))))
((string-match "<[^>]+> *$" gnus-tmp-from)
(setq beg-match (match-beginning 0))
(or (and (string-match "^\"[^\"]*\"" gnus-tmp-from)
(substring gnus-tmp-from (1+ (match-beginning 0))
(1- (match-end 0))))
(substring gnus-tmp-from 0 beg-match)))
+ ((string-match "(.+)" gnus-tmp-from)
+ (substring gnus-tmp-from
+ (1+ (match-beginning 0)) (1- (match-end 0))))
(t gnus-tmp-from)))
(when (string= gnus-tmp-name "")
(setq gnus-tmp-name gnus-tmp-from))
(< (or (cdr (assq number gnus-newsgroup-scored))
gnus-summary-default-score 0)
gnus-summary-mark-below)
- (not (memq number gnus-newsgroup-ancient)))
+ (not (gnus-summary-article-ancient-p number)))
(setq gnus-newsgroup-unreads
(delq number gnus-newsgroup-unreads))
(if gnus-newsgroup-auto-expire
;; GROUP is successfully selected.
(or gnus-newsgroup-headers t)))))
-(defun gnus-articles-to-read (group read-all)
+(defun gnus-articles-to-read (group &optional read-all)
;; Find out what articles the user wants to read.
(let* ((articles
;; Select all articles if `read-all' is non-nil, or if there
(when (or (> id (cdr active))
(< id (car active)))
(setq articles (delq id articles))))))
- (gnus-undo-register
- `(progn
- (gnus-info-set-marks ,info ,(gnus-info-marks info))
- (gnus-info-set-read ,info ,(gnus-info-read info))
- (gnus-group-update-group group t)))
+ (save-excursion
+ (set-buffer gnus-group-buffer)
+ (gnus-undo-register
+ `(progn
+ (gnus-info-set-marks ',info ',(gnus-info-marks info) t)
+ (gnus-info-set-read ',info ',(gnus-info-read info))
+ (gnus-get-unread-articles-in-group ',info (gnus-active ,group))
+ (gnus-group-update-group ,group t))))
;; If the read list is nil, we init it.
(and active
(null (gnus-info-read info))
;; Message-ID.
(progn
(goto-char p)
- (if (search-forward "\nmessage-id: " nil t)
- (setq id (nnheader-header-value))
- ;; If there was no message-id, we just fake one to make
- ;; subsequent routines simpler.
- (setq id (concat "none+"
- (int-to-string
- (setq gnus-newsgroup-none-id
- (1+ gnus-newsgroup-none-id)))))))
+ (setq id (if (search-forward "\nmessage-id: " nil t)
+ (nnheader-header-value)
+ ;; If there was no message-id, we just fake one
+ ;; to make subsequent routines simpler.
+ (nnheader-generate-fake-message-id))))
;; References.
(progn
(goto-char p)
'(prog1
(if (= (following-char) ?\t)
0
- (let ((num (condition-case nil (read buffer) (error nil))))
+ (let ((num (ignore-errors (read buffer))))
(if (numberp num) num 0)))
(unless (eobp)
(forward-char 1))))
(defmacro gnus-nov-field ()
'(buffer-substring (point) (if (gnus-nov-skip-field) (1- (point)) eol)))
-(defvar gnus-nov-none-counter 0)
+;; (defvar gnus-nov-none-counter 0)
;; This function has to be called with point after the article number
;; on the beginning of the line.
header ref id id-dep ref-dep)
;; overview: [num subject from date id refs chars lines misc]
- (narrow-to-region (point) eol)
- (unless (eobp)
- (forward-char))
-
- (setq header
- (vector
- number ; number
- (gnus-nov-field) ; subject
- (gnus-nov-field) ; from
- (gnus-nov-field) ; date
- (setq id (or (gnus-nov-field)
- (concat "none+"
- (int-to-string
- (incf gnus-nov-none-counter))))) ; id
- (progn
- (let ((beg (point)))
- (search-forward "\t" eol)
- (if (search-backward ">" beg t)
- (setq ref
- (buffer-substring
- (1+ (point))
- (search-backward "<" beg t)))
- (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)
+ (unwind-protect
+ (progn
+ (narrow-to-region (point) eol)
+ (unless (eobp)
+ (forward-char))
+
+ (setq header
+ (vector
+ number ; number
+ (gnus-nov-field) ; subject
+ (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))
+ (search-backward "<" beg t)))
+ (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))
;; We build the thread tree.
(when (equal id ref)
(push header headers))
(forward-line 1))
(error
- (gnus-error 4 "Strange nov line")))
+ (gnus-error 4 "Strange nov line (%d)"
+ (count-lines (point-min) (point)))))
(forward-line 1))
(nreverse headers))))
(let ((header (if (and old-header use-old-header)
old-header (gnus-read-header id)))
(number (and (numberp id) id))
- pos)
+ pos d)
(when header
;; Rebuild the thread that this article is part of and go to the
;; article we have fetched.
(when (and (not gnus-show-threads)
old-header)
- (when (setq pos (text-property-any
- (point-min) (point-max) 'gnus-number
- (mail-header-number old-header)))
- (goto-char pos)
- (gnus-delete-line)
- (gnus-data-remove (mail-header-number old-header))))
+ (when (setq d (gnus-data-find (mail-header-number old-header)))
+ (goto-char (gnus-data-pos d))
+ (gnus-data-remove
+ number
+ (- (gnus-point-at-bol)
+ (prog1
+ (1+ (gnus-point-at-eol))
+ (gnus-delete-line))))))
(when old-header
(mail-header-set-number header (mail-header-number old-header)))
(setq gnus-newsgroup-sparse
(gnus-summary-reselect-current-group all t))
(defun gnus-summary-update-info ()
- (let ((group gnus-newsgroup-name))
- (when gnus-newsgroup-kill-headers
- (setq gnus-newsgroup-killed
- (gnus-compress-sequence
- (nconc
- (gnus-set-sorted-intersection
- (gnus-uncompress-range gnus-newsgroup-killed)
- (setq gnus-newsgroup-unselected
- (sort gnus-newsgroup-unselected '<)))
- (setq gnus-newsgroup-unreads
- (sort gnus-newsgroup-unreads '<)))
- t)))
- (unless (listp (cdr gnus-newsgroup-killed))
- (setq gnus-newsgroup-killed (list gnus-newsgroup-killed)))
- (let ((headers gnus-newsgroup-headers))
- (run-hooks 'gnus-exit-group-hook)
- (unless gnus-save-score
- (setq gnus-newsgroup-scored nil))
- ;; Set the new ranges of read articles.
- (gnus-update-read-articles
- group (append gnus-newsgroup-unreads gnus-newsgroup-unselected))
- ;; Set the current article marks.
- (gnus-update-marks)
- ;; Do the cross-ref thing.
- (when gnus-use-cross-reference
- (gnus-mark-xrefs-as-read group headers gnus-newsgroup-unreads))
- ;; Do adaptive scoring, and possibly save score files.
- (when gnus-newsgroup-adaptive
- (gnus-score-adaptive))
- (when gnus-use-scoring
- (gnus-score-save))
- ;; Do not switch windows but change the buffer to work.
- (set-buffer gnus-group-buffer)
- (unless (gnus-ephemeral-group-p gnus-newsgroup-name)
- (gnus-group-update-group group)))))
+ (save-excursion
+ (let ((group gnus-newsgroup-name))
+ (when gnus-newsgroup-kill-headers
+ (setq gnus-newsgroup-killed
+ (gnus-compress-sequence
+ (nconc
+ (gnus-set-sorted-intersection
+ (gnus-uncompress-range gnus-newsgroup-killed)
+ (setq gnus-newsgroup-unselected
+ (sort gnus-newsgroup-unselected '<)))
+ (setq gnus-newsgroup-unreads
+ (sort gnus-newsgroup-unreads '<)))
+ t)))
+ (unless (listp (cdr gnus-newsgroup-killed))
+ (setq gnus-newsgroup-killed (list gnus-newsgroup-killed)))
+ (let ((headers gnus-newsgroup-headers))
+ (run-hooks 'gnus-exit-group-hook)
+ (unless gnus-save-score
+ (setq gnus-newsgroup-scored nil))
+ ;; Set the new ranges of read articles.
+ (gnus-update-read-articles
+ group (append gnus-newsgroup-unreads gnus-newsgroup-unselected))
+ ;; Set the current article marks.
+ (gnus-update-marks)
+ ;; Do the cross-ref thing.
+ (when gnus-use-cross-reference
+ (gnus-mark-xrefs-as-read group headers gnus-newsgroup-unreads))
+ ;; Do adaptive scoring, and possibly save score files.
+ (when gnus-newsgroup-adaptive
+ (gnus-score-adaptive))
+ (when gnus-use-scoring
+ (gnus-score-save))
+ ;; Do not switch windows but change the buffer to work.
+ (set-buffer gnus-group-buffer)
+ (unless (gnus-ephemeral-group-p gnus-newsgroup-name)
+ (gnus-group-update-group group))))))
(defun gnus-summary-exit (&optional temporary)
"Exit reading current newsgroup, and then return to group selection mode.
"exiting"))
(gnus-summary-next-group nil group backward)))
(t
- (gnus-summary-walk-group-buffer
- gnus-newsgroup-name cmd unread backward)))))))
+ (when (gnus-key-press-event-p last-input-event)
+ (gnus-summary-walk-group-buffer
+ gnus-newsgroup-name cmd unread backward))))))))
(defun gnus-summary-walk-group-buffer (from-group cmd unread backward)
(let ((keystrokes '((?\C-n (gnus-group-next-unread-group 1))
(while (and
thread
(or
- (memq (mail-header-number (car thread)) gnus-newsgroup-sparse)
- (memq (mail-header-number (car thread)) gnus-newsgroup-ancient))
- (or (<= (length (cdr thread)) 1)
- (gnus-invisible-cut-children (cdr thread))))
- (setq thread (cadr thread))))
+ (gnus-summary-article-sparse-p (mail-header-number (car thread)))
+ (gnus-summary-article-ancient-p
+ (mail-header-number (car thread))))
+ (progn
+ (if (<= (length (cdr thread)) 1)
+ (setq thread (cadr thread))
+ (when (gnus-invisible-cut-children (cdr thread))
+ (let ((th (cdr thread)))
+ (while th
+ (if (memq (mail-header-number (caar th))
+ gnus-newsgroup-limit)
+ (setq thread (car th)
+ th nil)
+ (setq th (cdr th)))))))))
+ ))
thread)
(defun gnus-cut-threads (threads)
;; If this article is dormant and has absolutely no visible
;; children, then this article isn't visible.
(and (memq number gnus-newsgroup-dormant)
- (= children 0))
- ;; If this is "fetch-old-headered" and there is only one
- ;; visible child (or less), then we don't want this article.
+ (zerop children))
+ ;; If this is "fetch-old-headered" and there is no
+ ;; visible children, then we don't want this article.
(and (eq gnus-fetch-old-headers 'some)
- (memq number gnus-newsgroup-ancient)
+ (gnus-summary-article-ancient-p number)
(zerop children))
;; If this is a sparsely inserted article with no children,
;; we don't want it.
(and (eq gnus-build-sparse-threads 'some)
- (memq number gnus-newsgroup-sparse)
+ (gnus-summary-article-sparse-p number)
(zerop children))
;; If we use expunging, and this article is really
;; low-scored, then we don't want this article.
;; It's not the current article, so we take a bet on
;; the value we got from the server.
(mail-header-references header)))
- (if ref
+ (if (and ref
+ (not (equal ref "")))
(unless (gnus-summary-refer-article (gnus-parent-id ref skip))
(gnus-message 1 "Couldn't find parent"))
(gnus-message 1 "No references in article %d"
(let ((ref (mail-header-references (gnus-summary-article-header)))
(current (gnus-summary-article-number))
(n 0))
- ;; For each Message-ID in the References header...
- (while (string-match "<[^>]*>" ref)
- (incf n)
- ;; ... fetch that article.
- (gnus-summary-refer-article
- (prog1 (match-string 0 ref)
- (setq ref (substring ref (match-end 0))))))
- (gnus-summary-goto-subject current)
- (gnus-summary-position-point)
- n))
+ (if (or (not ref)
+ (equal ref ""))
+ (error "No References in the current article")
+ ;; For each Message-ID in the References header...
+ (while (string-match "<[^>]*>" ref)
+ (incf n)
+ ;; ... fetch that article.
+ (gnus-summary-refer-article
+ (prog1 (match-string 0 ref)
+ (setq ref (substring ref (match-end 0))))))
+ (gnus-summary-goto-subject current)
+ (gnus-summary-position-point)
+ n)))
(defun gnus-summary-refer-article (message-id)
"Fetch an article specified by MESSAGE-ID."
(setq message-id (concat message-id ">")))
(let* ((header (gnus-id-to-header message-id))
(sparse (and header
- (memq (mail-header-number header)
- gnus-newsgroup-sparse))))
+ (gnus-summary-article-sparse-p
+ (mail-header-number header)))))
(if header
(prog1
;; The article is present in the buffer, to we just go to it.
(setq point (point)))
;; We didn't find it, so we go to the next article.
(set-buffer sum)
- (if (not (if backward (gnus-summary-find-prev)
- (gnus-summary-find-next)))
- ;; No more articles.
- (setq found t)
- ;; Select the next article and adjust point.
- (gnus-summary-select-article)
- (set-buffer gnus-article-buffer)
- (widen)
- (goto-char (if backward (point-max) (point-min))))))
+ (setq found 'not)
+ (while (eq found 'not)
+ (if (not (if backward (gnus-summary-find-prev)
+ (gnus-summary-find-next)))
+ ;; No more articles.
+ (setq found t)
+ ;; Select the next article and adjust point.
+ (unless (gnus-summary-article-sparse-p
+ (gnus-summary-article-number))
+ (setq found nil)
+ (gnus-summary-select-article)
+ (set-buffer gnus-article-buffer)
+ (widen)
+ (goto-char (if backward (point-max) (point-min))))))))
(gnus-message 7 ""))
;; Return whether we found the regexp.
(when (eq found 'found)
(when gnus-break-pages
(gnus-narrow-to-page))))
+(defun gnus-summary-print-article (&optional filename)
+ "Generate and print a PostScript image of the article buffer.
+
+If the optional argument FILENAME is nil, send the image to the printer.
+If FILENAME is a string, save the PostScript image in a file with that
+name. If FILENAME is a number, prompt the user for the name of the file
+to save in."
+ (interactive (list (ps-print-preprint current-prefix-arg)))
+ (gnus-summary-select-article)
+ (gnus-eval-in-buffer-window gnus-article-buffer
+ (let ((buffer (generate-new-buffer " *print*")))
+ (unwind-protect
+ (progn
+ (copy-to-buffer buffer (point-min) (point-max))
+ (set-buffer buffer)
+ (article-delete-invisible-text)
+ (ps-print-buffer-with-faces filename))
+ (kill-buffer buffer)))))
+
(defun gnus-summary-show-article (&optional arg)
"Force re-fetching of the current article.
If ARG (the prefix) is non-nil, show the raw article without any
(unless action
(setq action 'move))
(gnus-set-global-variables)
+ ;; Disable marking as read.
+ (let (gnus-mark-article-hook)
+ (save-window-excursion
+ (gnus-summary-select-article)))
;; Check whether the source group supports the required functions.
(cond ((and (eq action 'move)
(not (gnus-check-backend-function
to-newsgroup select-method (not articles))))
;; Crosspost the article.
((eq action 'crosspost)
- (let ((xref (mail-header-xref (gnus-summary-article-header article))))
- (setq new-xref (concat gnus-newsgroup-name ":" article))
- (if (and xref (not (string= xref "")))
- (progn
- (when (string-match "^Xref: " xref)
- (setq xref (substring xref (match-end 0))))
- (setq new-xref (concat xref " " new-xref)))
- (setq new-xref (concat (system-name) " " new-xref)))
+ (let ((xref (message-tokenize-header
+ (mail-header-xref (gnus-summary-article-header article))
+ " ")))
+ (setq new-xref (concat (gnus-group-real-name gnus-newsgroup-name)
+ ":" article))
+ (unless xref
+ (setq xref (list (system-name))))
+ (setq new-xref
+ (concat
+ (mapconcat 'identity
+ (delete "Xref:" (delete new-xref xref))
+ " ")
+ new-xref))
(save-excursion
(set-buffer copy-buf)
(gnus-request-article-this-buffer article gnus-newsgroup-name)
(set-buffer copy-buf)
(gnus-request-article-this-buffer article gnus-newsgroup-name)
(nnheader-replace-header
- "xref" (concat new-xref " " (gnus-group-prefixed-name
- (car art-group) to-method)
+ "xref" (concat new-xref " " (car art-group)
":" (cdr art-group)))
(gnus-request-replace-article
article gnus-newsgroup-name (current-buffer)))))
(interactive "P")
(gnus-summary-move-article n nil nil 'crosspost))
-(defvar gnus-summary-respool-default-method nil
+(defcustom gnus-summary-respool-default-method nil
"Default method for respooling an article.
-If nil, use to the current newsgroup method.")
+If nil, use to the current newsgroup method."
+ :type 'gnus-select-method-name
+ :group 'gnus-summary)
(defun gnus-summary-respool-article (&optional n method)
"Respool the current article.
;; This backend supports expiry.
(let* ((total (gnus-group-total-expirable-p gnus-newsgroup-name))
(expirable (if total
- (gnus-list-of-read-articles gnus-newsgroup-name)
+ (progn
+ ;; We need to update the info for
+ ;; this group for `gnus-list-of-read-articles'
+ ;; to give us the right answer.
+ (gnus-summary-update-info)
+ (gnus-list-of-read-articles gnus-newsgroup-name))
(setq gnus-newsgroup-expirable
(sort gnus-newsgroup-expirable '<))))
(expiry-wait (if now 'immediate
;; Summary sorting commands
(defun gnus-summary-sort-by-number (&optional reverse)
- "Sort summary buffer by article number.
+ "Sort the summary buffer by article number.
Argument REVERSE means reverse order."
(interactive "P")
(gnus-summary-sort 'number reverse))
(defun gnus-summary-sort-by-author (&optional reverse)
- "Sort summary buffer by author name alphabetically.
+ "Sort the summary buffer by author name alphabetically.
If case-fold-search is non-nil, case of letters is ignored.
Argument REVERSE means reverse order."
(interactive "P")
(gnus-summary-sort 'author reverse))
(defun gnus-summary-sort-by-subject (&optional reverse)
- "Sort summary buffer by subject alphabetically. `Re:'s are ignored.
+ "Sort the summary buffer by subject alphabetically. `Re:'s are ignored.
If case-fold-search is non-nil, case of letters is ignored.
Argument REVERSE means reverse order."
(interactive "P")
(gnus-summary-sort 'subject reverse))
(defun gnus-summary-sort-by-date (&optional reverse)
- "Sort summary buffer by date.
+ "Sort the summary buffer by date.
Argument REVERSE means reverse order."
(interactive "P")
(gnus-summary-sort 'date reverse))
(defun gnus-summary-sort-by-score (&optional reverse)
- "Sort summary buffer by score.
+ "Sort the summary buffer by score.
Argument REVERSE means reverse order."
(interactive "P")
(gnus-summary-sort 'score reverse))
+(defun gnus-summary-sort-by-lines (&optional reverse)
+ "Sort the summary buffer by article length.
+Argument REVERSE means reverse order."
+ (interactive "P")
+ (gnus-summary-sort 'lines reverse))
+
(defun gnus-summary-sort (predicate reverse)
"Sort summary buffer by PREDICATE. REVERSE means reverse order."
(gnus-set-global-variables)
(when (cond
((stringp match)
;; Regular expression.
- (condition-case ()
- (re-search-forward match nil t)
- (error nil)))
+ (ignore-errors
+ (re-search-forward match nil t)))
((gnus-functionp match)
;; Function.
(save-restriction
(setq result (eval match)))))
(setq split-name (append (cdr method) split-name))
(cond ((stringp result)
- (push result split-name))
+ (push (expand-file-name
+ result gnus-article-save-directory)
+ split-name))
((consp result)
(setq split-name (append result split-name)))))))))
split-name))
(gnus-summary-position-point)
;; If all commands are to be bunched up on one line, we collect
;; them here.
- (if gnus-view-pseudos-separately
- ()
+ (unless gnus-view-pseudos-separately
(let ((ps (setq pslist (sort pslist 'gnus-pseudos<)))
files action)
(while ps
(or (cdr (assq 'action (cadr ps))) "2")))
(push (cdr (assq 'name (cadr ps))) files)
(setcdr ps (cddr ps)))
- (if (not files)
- ()
+ (when files
(when (not (string-match "%s" action))
(push " " files))
(push " " files)
- (and (assq 'execute (car ps))
- (setcdr (assq 'execute (car ps))
- (funcall (if (string-match "%s" action)
- 'format 'concat)
- action
- (mapconcat (lambda (f) f) files " ")))))
+ (when (assq 'execute (car ps))
+ (setcdr (assq 'execute (car ps))
+ (funcall (if (string-match "%s" action)
+ 'format 'concat)
+ action
+ (mapconcat (lambda (f) f) files " ")))))
(setq ps (cdr ps)))))
(if (and gnus-view-pseudos (not not-view))
(while pslist
;; This is an article number.
(setq header (or header (gnus-summary-article-header id))))
(if (and header
- (not (memq (mail-header-number header) gnus-newsgroup-sparse)))
+ (not (gnus-summary-article-sparse-p (mail-header-number header))))
;; We have found the header.
header
;; We have to really fetch the header to this article.
(save-excursion
(set-buffer nntp-server-buffer)
(when (setq where (gnus-request-head id group))
+ (nnheader-fold-continuation-lines)
(goto-char (point-max))
(insert ".\n")
(goto-char (point-min))
(insert " Article retrieved.\n"))
(if (not (setq header (car (gnus-get-newsgroup-headers nil t))))
() ; Malformed head.
- (unless (memq (mail-header-number header) gnus-newsgroup-sparse)
+ (unless (gnus-summary-article-sparse-p (mail-header-number header))
(when (and (stringp id)
(not (string= (gnus-group-real-name group)
(car where))))
(setq unread (cdr unread)))
(when (<= prev (cdr active))
(push (cons prev (cdr active)) read))
- (gnus-undo-register
- `(progn
- (gnus-info-set-marks ,info ,(gnus-info-marks info))
- (gnus-info-set-read ,info ,(gnus-info-read info))
- (gnus-get-unread-articles-in-group ,info (gnus-active ,group))))
+ (save-excursion
+ (set-buffer gnus-group-buffer)
+ (gnus-undo-register
+ `(progn
+ (gnus-info-set-marks ',info ',(gnus-info-marks info) t)
+ (gnus-info-set-read ',info ',(gnus-info-read info))
+ (gnus-get-unread-articles-in-group ',info (gnus-active ,group))
+ (gnus-group-update-group ,group t))))
;; Enter this list into the group info.
(gnus-info-set-read
info (if (> (length read) 1) (nreverse read) read))