;;; gnus-sum.el --- summary mode commands for Gnus
;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
+;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
(unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
(eval-when-compile
(require 'cl))
+(eval-when-compile
+ (when (featurep 'xemacs)
+ (require 'easy-mmode))) ; for `define-minor-mode'
(defvar tool-bar-mode)
(defvar gnus-tmp-header)
:version "23.1" ;; No Gnus
:type 'boolean)
+(defcustom gnus-summary-stop-at-end-of-message nil
+ "If non-nil, don't select the next message when using `SPC'."
+ :link '(custom-manual "(gnus)Group Maneuvering")
+ :group 'gnus-summary-maneuvering
+ :version "24.1"
+ :type 'boolean)
+
(defcustom gnus-fetch-old-headers nil
"*Non-nil means that Gnus will try to build threads by grabbing old headers.
If an unread article in the group refers to an older, already
:group 'gnus-summary-format
:type 'string)
-(defcustom gnus-summary-goto-unread t
+(defcustom gnus-summary-goto-unread nil
"*If t, many commands will go to the next unread article.
This applies to marking commands as well as other commands that
\"naturally\" select the next article, like, for instance, `SPC' at
\(they go to the next article instead). If `never', commands that
usually go to the next unread article, will go to the next article,
whether it is read or not."
+ :version "24.1"
:group 'gnus-summary-marks
:link '(custom-manual "(gnus)Setting Marks")
:type '(choice (const :tag "off" nil)
:type '(choice (const :tag "none" nil)
(sexp :menu-tag "first" t)))
-(defcustom gnus-auto-select-subject 'unread
+(defcustom gnus-auto-select-subject 'unseen-or-unread
"*Says what subject to place under point when entering a group.
This variable can either be the symbols `first' (place point on the
line of the first unseen article or, if all article have been seen, on the
subject line of the first unread article), or a function to be called to
place point on some subject line."
- :version "22.1"
+ :version "24.1"
:group 'gnus-group-select
:type '(choice (const best)
(const unread)
:group 'gnus-summary
:type 'boolean)
-(defcustom gnus-single-article-buffer t
+(defcustom gnus-single-article-buffer nil
"*If non-nil, display all articles in the same buffer.
If nil, each group will get its own article buffer."
+ :version "24.1"
:group 'gnus-article-various
:type 'boolean)
:group 'gnus-summary-marks
:type 'character)
-(defcustom gnus-souped-mark ?F
- "*Mark used for souped articles."
- :group 'gnus-summary-marks
- :type 'character)
-
(defcustom gnus-kill-file-mark ?X
"*Mark used for articles killed by kill files."
:group 'gnus-summary-marks
(defcustom gnus-auto-expirable-marks
(list gnus-killed-mark gnus-del-mark gnus-catchup-mark
gnus-low-score-mark gnus-ancient-mark gnus-read-mark
- gnus-souped-mark gnus-duplicate-mark)
+ gnus-duplicate-mark)
"*The list of marks converted into expiration if a group is auto-expirable."
- :version "21.1"
+ :version "24.1"
:group 'gnus-summary
:type '(repeat character))
:group 'gnus-summary
:type 'boolean)
+(defcustom gnus-mark-copied-or-moved-articles-as-expirable nil
+ "If non-nil, mark articles copied or moved to auto-expire group as expirable.
+If nil, the expirable marks will be unchanged except that the marks
+will be removed when copying or moving articles to a group that has
+not turned auto-expire on. If non-nil, articles that have been read
+will be marked as expirable when being copied or moved to a group in
+which auto-expire is turned on."
+ :version "23.2"
+ :type 'boolean
+ :group 'gnus-summary-marks)
+
(defcustom gnus-view-pseudos nil
"*If `automatic', pseudo-articles will be viewed automatically.
If `not-confirm', pseudos will be viewed automatically, and the user
:group 'gnus-various
:type 'hook)
-(defcustom gnus-summary-update-hook
- (list 'gnus-summary-highlight-line)
+(defcustom gnus-summary-update-hook nil
"*A hook called when a summary line is changed.
The hook will not be called if `gnus-visual' is nil.
"Whether Gnus should parse all headers made available to it.
This is mostly relevant for slow back ends where the user may
wish to widen the summary buffer to include all headers
-that were fetched. Say, for nnultimate groups."
+that were fetched."
:version "22.1"
:group 'gnus-summary
:type '(choice boolean regexp))
"?" 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-m\C-n" gnus-summary-sort-by-most-recent-number
"\C-c\C-s\C-l" gnus-summary-sort-by-lines
"\C-c\C-s\C-c" gnus-summary-sort-by-chars
"\C-c\C-s\C-a" gnus-summary-sort-by-author
"\C-c\C-s\C-t" gnus-summary-sort-by-recipient
"\C-c\C-s\C-s" gnus-summary-sort-by-subject
"\C-c\C-s\C-d" gnus-summary-sort-by-date
+ "\C-c\C-s\C-m\C-d" gnus-summary-sort-by-most-recent-date
"\C-c\C-s\C-i" gnus-summary-sort-by-score
"\C-c\C-s\C-o" gnus-summary-sort-by-original
"\C-c\C-s\C-r" gnus-summary-sort-by-random
"=" gnus-summary-expand-window
"\C-x\C-s" gnus-summary-reselect-current-group
"\M-g" gnus-summary-rescan-group
- "w" gnus-summary-stop-page-breaking
"\C-c\C-r" gnus-summary-caesar-message
"f" gnus-summary-followup
"F" gnus-summary-followup-with-original
[follow-link] mouse-face
"m" gnus-summary-mail-other-window
"a" gnus-summary-post-news
- "i" gnus-summary-news-other-window
"x" gnus-summary-limit-to-unread
"s" gnus-summary-isearch-article
"t" gnus-summary-toggle-header
"d" gnus-article-display-face
"s" gnus-treat-smiley
"D" gnus-article-remove-images
+ "W" gnus-html-show-images
"f" gnus-treat-from-picon
"m" gnus-treat-mail-picon
"n" gnus-treat-newsgroups-picon)
"h" gnus-summary-save-article-folder
"v" gnus-summary-save-article-vm
"p" gnus-summary-pipe-output
- "P" gnus-summary-muttprint
- "s" gnus-soup-add-article)
+ "P" gnus-summary-muttprint)
(gnus-define-keys (gnus-summary-mime-map "K" gnus-summary-mode-map)
"b" gnus-summary-display-buttonized
["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]
["Print with Muttprint..." gnus-summary-muttprint t]
["Print" gnus-summary-print-article
,@(if (featurep 'xemacs) '(t)
["Set expirable mark" gnus-summary-mark-as-expirable t]
["Set bookmark" gnus-summary-set-bookmark t]
["Remove bookmark" gnus-summary-remove-bookmark t])
- ("Registry Mark"
- ["Important" gnus-registry-set-article-Important-mark t]
- ["Not Important" gnus-registry-remove-article-Important-mark t]
- ["Work" gnus-registry-set-article-Work-mark t]
- ["Not Work" gnus-registry-remove-article-Work-mark t]
- ["Later" gnus-registry-set-article-Later-mark t]
- ["Not Later" gnus-registry-remove-article-Later-mark t]
- ["Personal" gnus-registry-set-article-Personal-mark t]
- ["Not Personal" gnus-registry-remove-article-Personal-mark t]
- ["To Do" gnus-registry-set-article-To-Do-mark t]
- ["Not To Do" gnus-registry-remove-article-To-Do-mark t])
("Limit to"
["Marks..." gnus-summary-limit-to-marks t]
["Subject..." gnus-summary-limit-to-subject t]
gnus-newsgroup-process-stack]
["Save" gnus-summary-save-process-mark t]
["Run command on marked..." gnus-summary-universal-argument t]))
+ ("Registry Marks")
("Scroll article"
["Page forward" gnus-summary-next-page
,@(if (featurep 'xemacs) '(t)
["Pop article off history" gnus-summary-pop-article t])
("Sort"
["Sort by number" gnus-summary-sort-by-number t]
+ ["Sort by most recent number" gnus-summary-sort-by-most-recent-number t]
["Sort by author" gnus-summary-sort-by-author t]
["Sort by recipient" gnus-summary-sort-by-recipient t]
["Sort by subject" gnus-summary-sort-by-subject t]
["Sort by date" gnus-summary-sort-by-date t]
+ ["Sort by most recent date" gnus-summary-sort-by-most-recent-date t]
["Sort by score" gnus-summary-sort-by-score t]
["Sort by lines" gnus-summary-sort-by-lines t]
["Sort by characters" gnus-summary-sort-by-chars t]
(declare-function turn-on-gnus-mailing-list-mode "gnus-ml" ())
-
+(defvar bookmark-make-record-function)
\f
(defun gnus-summary-mode (&optional group)
(gnus-simplify-mode-line)
(setq major-mode 'gnus-summary-mode)
(setq mode-name "Summary")
- (make-local-variable 'minor-mode-alist)
(use-local-map gnus-summary-mode-map)
(buffer-disable-undo)
(setq buffer-read-only t ;Disable modification
show-trailing-whitespace nil)
(setq truncate-lines t)
- (setq selective-display t)
- (setq selective-display-ellipses t) ;Display `...'
+ (add-to-invisibility-spec '(gnus-sum . t))
(gnus-summary-set-display-table)
(gnus-set-default-directory)
(make-local-variable 'gnus-summary-line-format)
(gnus-run-mode-hooks 'gnus-summary-mode-hook)
(turn-on-gnus-mailing-list-mode)
(mm-enable-multibyte)
+ (set (make-local-variable 'bookmark-make-record-function)
+ 'gnus-summary-bookmark-make-record)
(gnus-update-format-specifications nil 'summary 'summary-mode 'summary-dummy)
(gnus-update-summary-mark-positions))
(save-excursion
(let (config)
(goto-char (point-min))
- (while (search-forward "\r" nil t)
- (push (1- (point)) config))
+ (while (not (eobp))
+ (when (eq (get-char-property (point-at-eol) 'invisible) 'gnus-sum)
+ (push (save-excursion (forward-line 0) (point)) config))
+ (forward-line 1))
config)))
(defun gnus-restore-hidden-threads-configuration (config)
(save-excursion
(let (point (inhibit-read-only t))
(while (setq point (pop config))
- (when (and (< point (point-max))
- (goto-char point)
- (eq (char-after) ?\n))
- (subst-char-in-region point (1+ point) ?\n ?\r))))))
+ (goto-char point)
+ (gnus-summary-hide-thread)))))
;; Various summary mode internalish functions.
(defun gnus-summary-set-article-display-arrow (pos)
"Update the overlay arrow to point to line at position POS."
- (when (and gnus-summary-display-arrow
- (boundp 'overlay-arrow-position)
- (boundp 'overlay-arrow-string))
+ (when gnus-summary-display-arrow
+ (make-local-variable 'overlay-arrow-position)
+ (make-local-variable 'overlay-arrow-string)
(save-excursion
(goto-char pos)
(beginning-of-line)
(if (= gnus-tmp-lines -1)
(setq gnus-tmp-lines "?")
(setq gnus-tmp-lines (number-to-string gnus-tmp-lines)))
- (gnus-put-text-property
- (point)
- (progn (eval gnus-summary-line-format-spec) (point))
- 'gnus-number gnus-tmp-number)
+ (condition-case ()
+ (gnus-put-text-property
+ (point)
+ (progn (eval gnus-summary-line-format-spec) (point))
+ 'gnus-number gnus-tmp-number)
+ (error (gnus-message 5 "Error updating the summary line")))
(when (gnus-visual-p 'summary-highlight 'highlight)
(forward-line -1)
+ (gnus-summary-highlight-line)
(gnus-run-hooks 'gnus-summary-update-hook)
(forward-line 1))))
'score))
;; Do visual highlighting.
(when (gnus-visual-p 'summary-highlight 'highlight)
+ (gnus-summary-highlight-line)
(gnus-run-hooks 'gnus-summary-update-hook)))))
(defvar gnus-tmp-new-adopts nil)
(consp (cdr elem)) ; The cdr has to be a list.
(symbolp (car elem)) ; Has to be a symbol in there.
(not (memq (car elem) vars))
- (ignore-errors ; So we set it.
+ (ignore-errors
(push (car elem) vars)
- (make-local-variable (car elem))
- (set (car elem) (eval (nth 1 elem))))))))
+ ;; Variables like `gnus-show-threads' that are globally
+ ;; bound, if used as group parameters, need to get to be
+ ;; buffer-local, whereas just parameters like `gcc-self',
+ ;; `timestamp', etc. should not be bound as variables.
+ (if (boundp (car elem))
+ (set (make-local-variable (car elem)) (eval (nth 1 elem)))
+ (eval (nth 1 elem))))))))
(defun gnus-summary-read-group (group &optional show-all no-article
kill-buffer no-display backward
(progn
(set-buffer gnus-group-buffer)
(gnus-group-jump-to-group group)
- (gnus-group-next-unread-group 1)
(gnus-configure-windows 'group 'force))
(gnus-handle-ephemeral-exit quit-config))
;; Finally signal the quit.
;; Even after binding max-lisp-eval-depth, the recursive
;; sorter might fail for very long threads. In that case,
;; try using a (less well-tested) non-recursive sorter.
- (error (gnus-sort-threads-loop
+ (error (gnus-message 9 "Sorting threads with loop...")
+ (gnus-sort-threads-loop
threads (gnus-make-sort-function
gnus-thread-sort-functions))))
(gnus-message 8 "Sorting threads...done"))))
"Sort threads such that the thread with the most recently dated article comes first."
(> (gnus-thread-latest-date h1) (gnus-thread-latest-date h2)))
+; Since this is called not only to sort the top-level threads, but
+; also in recursive sorts to order the articles within a thread, each
+; article will be processed many times. Thus it speeds things up
+; quite a bit to use gnus-date-get-time, which caches the time value.
(defun gnus-thread-latest-date (thread)
"Return the highest article date in THREAD."
- (let ((previous-time 0))
- (apply 'max
- (mapcar
- (lambda (header)
- (setq previous-time
- (condition-case ()
- (time-to-seconds (mail-header-parse-date
- (mail-header-date header)))
- (error previous-time))))
- (sort
- (message-flatten-list thread)
- (lambda (h1 h2)
- (< (mail-header-number h1)
- (mail-header-number h2))))))))
+ (apply 'max
+ (mapcar (lambda (header) (gnus-float-time
+ (gnus-date-get-time
+ (mail-header-date header))))
+ (message-flatten-list thread))))
(defun gnus-thread-total-score-1 (root)
;; This function find the total score of the thread below ROOT.
(setq gnus-tmp-lines "?")
(setq gnus-tmp-lines (number-to-string gnus-tmp-lines)))
(gnus-put-text-property
- (point)
- (progn (eval gnus-summary-line-format-spec) (point))
+ (point)
+ (progn (eval gnus-summary-line-format-spec) (point))
'gnus-number number)
- (when gnus-visual-p
- (forward-line -1)
- (gnus-run-hooks 'gnus-summary-update-hook)
- (forward-line 1))
+ (when gnus-visual-p
+ (forward-line -1)
+ (gnus-summary-highlight-line)
+ (when gnus-summary-update-hook
+ (gnus-run-hooks 'gnus-summary-update-hook))
+ (forward-line 1))
- (setq gnus-tmp-prev-subject simp-subject)))
+ (setq gnus-tmp-prev-subject simp-subject)))
(when (nth 1 thread)
(push (list (max 0 gnus-tmp-level)
(mm-decode-coding-string (gnus-status-message group) charset))))
(unless (gnus-request-group group t)
- (when (equal major-mode 'gnus-summary-mode)
- (gnus-kill-buffer (current-buffer)))
- (error "Couldn't request group %s: %s"
- (mm-decode-coding-string group charset)
- (mm-decode-coding-string (gnus-status-message group) charset)))
+ (when (equal major-mode 'gnus-summary-mode)
+ (gnus-kill-buffer (current-buffer)))
+ (error "Couldn't request group %s: %s"
+ (mm-decode-coding-string group charset)
+ (mm-decode-coding-string (gnus-status-message group) charset)))
(when gnus-agent
(gnus-agent-possibly-alter-active group (gnus-active group) info)
(types gnus-article-mark-lists)
marks var articles article mark mark-type
bgn end)
+ ;; Hack to avoid adjusting marks for imap.
+ (when (eq (car (gnus-find-method-for-group (gnus-info-group info)))
+ 'nnimap)
+ (setq min 1))
(dolist (marks marked-lists)
(setq mark (car marks)
(when add
(push (list add 'add (list (cdr type))) delta-marks))
(when del
+ ;; Don't delete marks from outside the active range. This
+ ;; shouldn't happen, but is a sanity check.
+ (setq del (gnus-sorted-range-intersection
+ (gnus-active gnus-newsgroup-name) del))
(push (list del 'del (list (cdr type))) delta-marks))))
(when list
(when (> (length mode-string) max-len)
(setq mode-string
(concat (truncate-string-to-width mode-string (- max-len 3))
- "...")))
- ;; Pad the mode string a bit.
- (setq mode-string (format (format "%%-%ds" max-len) mode-string))))
+ "...")))))
;; Update the mode line.
(setq mode-line-buffer-identification
(gnus-mode-line-buffer-identification (list mode-string)))
"Look through all the headers and mark the Xrefs as read."
(let ((virtual (gnus-virtual-group-p from-newsgroup))
name info xref-hashtb idlist method nth4)
- (save-excursion
- (set-buffer gnus-group-buffer)
+ (with-current-buffer gnus-group-buffer
(when (setq xref-hashtb
(gnus-create-xref-hashtb from-newsgroup headers unreads))
(mapatoms
(when (and gnus-auto-center-summary
(not (eq gnus-auto-center-summary 'vertical)))
(gnus-horizontal-recenter))
- (recenter n))
+ (if (fboundp 'recenter-top-bottom)
+ (recenter-top-bottom n)
+ (recenter n)))
+
+(put 'gnus-recenter 'isearch-scroll t)
+
+(defun gnus-forward-line-ignore-invisible (n)
+ "Move N lines forward (backward if N is negative).
+Like forward-line, but skip over (and don't count) invisible lines."
+ (let (done)
+ (while (and (> n 0) (not done))
+ ;; If the following character is currently invisible,
+ ;; skip all characters with that same `invisible' property value.
+ (while (gnus-invisible-p (point))
+ (goto-char (gnus-next-char-property-change (point))))
+ (forward-line 1)
+ (if (eobp)
+ (setq done t)
+ (setq n (1- n))))
+ (while (and (< n 0) (not done))
+ (forward-line -1)
+ (if (bobp) (setq done t)
+ (setq n (1+ n))
+ (while (and (not (bobp)) (gnus-invisible-p (1- (point))))
+ (goto-char (gnus-previous-char-property-change (point))))))))
(defun gnus-summary-recenter ()
"Center point in the summary window.
gnus-auto-center-summary
(/ (1- (window-height)) 2)))))
(height (1- (window-height)))
- (bottom (save-excursion (goto-char (point-max))
- (forward-line (- height))
- (point)))
+ (bottom (save-excursion
+ (goto-char (point-max))
+ (gnus-forward-line-ignore-invisible (- height))
+ (point)))
(window (get-buffer-window (current-buffer))))
(when (get-buffer-window gnus-article-buffer)
;; Only do recentering when the article buffer is displayed,
;; Set the window start to either `bottom', which is the biggest
;; possible valid number, or the second line from the top,
;; whichever is the least.
- (let ((top-pos (save-excursion (forward-line (- top)) (point))))
+ (let ((top-pos (save-excursion
+ (gnus-forward-line-ignore-invisible (- top))
+ (point))))
(if (> bottom top-pos)
;; Keep the second line from the top visible
(set-window-start window top-pos)
;; visible, or revert to using TOP-POS.
(save-excursion
(goto-char (point-max))
- (forward-line -1)
+ (gnus-forward-line-ignore-invisible -1)
(let ((last-line-start (point)))
(goto-char bottom)
(set-window-start window (point) t)
(when (not (pos-visible-in-window-p last-line-start window))
- (forward-line 1)
+ (gnus-forward-line-ignore-invisible 1)
(set-window-start window (min (point) top-pos) t)))))))
;; Do horizontal recentering while we're at it.
(when (and (get-buffer-window (current-buffer) t)
;;; Dead summaries.
-(defvar gnus-dead-summary-mode-map nil)
-
-(unless gnus-dead-summary-mode-map
- (setq gnus-dead-summary-mode-map (make-keymap))
- (suppress-keymap gnus-dead-summary-mode-map)
- (substitute-key-definition
- 'undefined 'gnus-summary-wake-up-the-dead gnus-dead-summary-mode-map)
- (dolist (key '("\C-d" "\r" "\177" [delete]))
- (define-key gnus-dead-summary-mode-map
- key 'gnus-summary-wake-up-the-dead))
- (dolist (key '("q" "Q"))
- (define-key gnus-dead-summary-mode-map key 'bury-buffer)))
-
-(defvar gnus-dead-summary-mode nil
- "Minor mode for Gnus summary buffers.")
-
-(defun gnus-dead-summary-mode (&optional arg)
+(defvar gnus-dead-summary-mode-map
+ (let ((map (make-keymap)))
+ (suppress-keymap map)
+ (substitute-key-definition 'undefined 'gnus-summary-wake-up-the-dead map)
+ (dolist (key '("\C-d" "\r" "\177" [delete]))
+ (define-key map key 'gnus-summary-wake-up-the-dead))
+ (dolist (key '("q" "Q"))
+ (define-key map key 'bury-buffer))
+ map))
+
+(define-minor-mode gnus-dead-summary-mode
"Minor mode for Gnus summary buffers."
- (interactive "P")
- (when (eq major-mode 'gnus-summary-mode)
- (make-local-variable 'gnus-dead-summary-mode)
- (setq gnus-dead-summary-mode
- (if (null arg) (not gnus-dead-summary-mode)
- (> (prefix-numeric-value arg) 0)))
- (when gnus-dead-summary-mode
- (add-minor-mode
- 'gnus-dead-summary-mode " Dead" gnus-dead-summary-mode-map))))
+ :lighter " Dead" :keymap gnus-dead-summary-mode-map
+ (unless (derived-mode-p 'gnus-summary-mode)
+ (setq gnus-dead-summary-mode nil)))
(defun gnus-deaden-summary ()
"Make the current summary buffer into a dead summary buffer."
(defun gnus-summary-describe-briefly ()
"Describe summary mode commands briefly."
(interactive)
- (gnus-message 6 (substitute-command-keys "\\<gnus-summary-mode-map>\\[gnus-summary-next-page]:Select \\[gnus-summary-next-unread-article]:Forward \\[gnus-summary-prev-unread-article]:Backward \\[gnus-summary-exit]:Exit \\[gnus-info-find-node]:Run Info \\[gnus-summary-describe-briefly]:This help")))
+ (gnus-message 6 "%s" (substitute-command-keys "\\<gnus-summary-mode-map>\\[gnus-summary-next-page]:Select \\[gnus-summary-next-unread-article]:Forward \\[gnus-summary-prev-unread-article]:Backward \\[gnus-summary-exit]:Exit \\[gnus-info-find-node]:Run Info \\[gnus-summary-describe-briefly]:This help")))
;; Walking around group mode buffer from summary mode.
"Go to the first subject satisfying any non-nil constraint.
If UNREAD is non-nil, the article should be unread.
If UNDOWNLOADED is non-nil, the article should be undownloaded.
-If UNSEEN is non-nil, the article should be unseen.
+If UNSEEN is non-nil, the article should be unseen as well as unread.
Returns the article selected or nil if there are no matching articles."
(interactive "P")
(cond
(and undownloaded
(memq num gnus-newsgroup-undownloaded))
(and unseen
- (memq num gnus-newsgroup-unseen)))))))
+ (memq num gnus-newsgroup-unseen)
+ (memq num gnus-newsgroup-unreads)))))))
(setq data (cdr data)))
(prog1
(if data
(t
(unless (gnus-ephemeral-group-p gnus-newsgroup-name)
(gnus-summary-jump-to-group gnus-newsgroup-name))
- (let ((cmd last-command-char)
+ (let ((cmd (if (featurep 'xemacs)
+ last-command-char
+ last-command-event))
(point
(with-current-buffer gnus-group-buffer
(point)))
(setq endp (or (gnus-article-next-page lines)
(gnus-article-only-boring-p))))
(when endp
- (cond (stop
+ (cond ((or stop gnus-summary-stop-at-end-of-message)
(gnus-message 3 "End of message"))
(circular
(gnus-summary-beginning-of-article))
(gnus-summary-position-point)))
(defun gnus-summary-first-unseen-or-unread-subject ()
- "Place the point on the subject line of the first unseen article or,
-if all article have been seen, on the subject line of the first unread
+ "Place the point on the subject line of the first unseen and unread article.
+If all article have been seen, on the subject line of the first unread
article."
(interactive)
(prog1
(gnus-summary-position-point))))
(defun gnus-summary-limit-strange-charsets-predicate (header)
- (let ((string (concat (mail-header-subject header)
- (mail-header-from header)))
- charset found)
- (dotimes (i (1- (length string)))
- (setq charset (format "%s" (char-charset (aref string (1+ i)))))
- (when (string-match "unicode\\|big\\|japanese" charset)
- (setq found t)))
- found))
+ (when (fboundp 'char-charset)
+ (let ((string (concat (mail-header-subject header)
+ (mail-header-from header)))
+ charset found)
+ (dotimes (i (1- (length string)))
+ (setq charset (format "%s" (char-charset (aref string (1+ i)))))
+ (when (string-match "unicode\\|big\\|japanese" charset)
+ (setq found t)))
+ found)))
(defun gnus-summary-limit-to-predicate (predicate)
"Limit to articles where PREDICATE returns non-nil.
(when (and (vectorp (gnus-data-header d))
(setq date (mail-header-date (gnus-data-header d))))
(setq is-younger (time-less-p
- (time-since (condition-case ()
- (date-to-time date)
- (error '(0 0))))
+ (time-since (gnus-date-get-time date))
cutoff))
(when (if younger-p
is-younger
(defalias 'gnus-summary-delete-marked-as-read 'gnus-summary-limit-to-unread)
(make-obsolete
- 'gnus-summary-delete-marked-as-read 'gnus-summary-limit-to-unread)
+ 'gnus-summary-delete-marked-as-read 'gnus-summary-limit-to-unread "Emacs 20.4")
(defun gnus-summary-limit-to-unread (&optional all)
"Limit the summary buffer to articles that are not marked as read.
gnus-killed-mark gnus-spam-mark gnus-kill-file-mark
gnus-low-score-mark gnus-expirable-mark
gnus-canceled-mark gnus-catchup-mark gnus-sparse-mark
- gnus-duplicate-mark gnus-souped-mark)
+ gnus-duplicate-mark)
'reverse)))
(defun gnus-summary-limit-to-headers (match &optional reverse)
(dolist (data gnus-newsgroup-data)
(let (gnus-mark-article-hook)
(gnus-summary-select-article t t nil (gnus-data-number data)))
- (save-excursion
- (set-buffer gnus-article-buffer)
+ (with-current-buffer gnus-article-buffer
(article-goto-body)
(let* ((case-fold-search t)
(found (if headersp
(defalias 'gnus-summary-delete-marked-with 'gnus-summary-limit-exclude-marks)
(make-obsolete 'gnus-summary-delete-marked-with
- 'gnus-summary-limit-exclude-marks)
+ 'gnus-summary-limit-exclude-marks "Emacs 20.4")
(defun gnus-summary-limit-exclude-marks (marks &optional reverse)
"Exclude articles that are marked with MARKS (e.g. \"DK\").
(setq group (format "%s-%d" gnus-newsgroup-name article))
(gnus-summary-remove-process-mark article)
(when (gnus-summary-display-article article)
- (save-excursion
+ (save-excursion ;;What for?
(with-temp-buffer
(insert-buffer-substring gnus-original-article-buffer)
;; Remove some headers that may lead nndoc to make
remain unencoded after running this function, it is likely an
invalid IDNA string (`xn--bar' is invalid).
-You must have GNU Libidn (`http://www.gnu.org/software/libidn/')
+You must have GNU Libidn (URL `http://www.gnu.org/software/libidn/')
installed for this command to work."
(interactive "P")
(if (not (and (condition-case nil (require 'idna)
gnus-newsgroup-name))
(to-method (or select-method
(gnus-find-method-for-group to-newsgroup)))
- (move-is-internal (gnus-method-equal from-method to-method)))
+ (move-is-internal (gnus-server-equal from-method to-method)))
(gnus-request-move-article
article ; Article to move
gnus-newsgroup-name ; From newsgroup
to-newsgroup (list 'quote select-method)
(not articles) t) ; Accept form
(not articles) ; Only save nov last time
- move-is-internal))) ; is this move internal?
+ (and move-is-internal
+ to-newsgroup ; Not respooling
+ (gnus-group-real-name to-newsgroup))))) ; Is this move internal?
;; Copy the article.
((eq action 'copy)
(with-current-buffer copy-buf
(list (cdr art-group)))))
;; See whether the article is to be put in the cache.
- (let ((marks (if (gnus-group-auto-expirable-p to-group)
- gnus-article-mark-lists
- (delete '(expirable . expire)
- (copy-sequence gnus-article-mark-lists))))
- (to-article (cdr art-group)))
+ (let* ((expirable (gnus-group-auto-expirable-p to-group))
+ (marks (if expirable
+ gnus-article-mark-lists
+ (delete '(expirable . expire)
+ (copy-sequence gnus-article-mark-lists))))
+ (to-article (cdr art-group)))
;; Enter the article into the cache in the new group,
;; if that is required.
to-group (cdar marks) (list to-article) info)))
(setq marks (cdr marks)))
- (gnus-request-set-mark
- to-group (list (list (list to-article) 'add to-marks))))
+ (when (and expirable
+ gnus-mark-copied-or-moved-articles-as-expirable
+ (not (memq 'expire to-marks)))
+ ;; Mark this article as expirable.
+ (push 'expire to-marks)
+ (when (equal to-group gnus-newsgroup-name)
+ (push to-article gnus-newsgroup-expirable))
+ ;; Copy the expirable mark to other group.
+ (gnus-add-marked-articles
+ to-group 'expire (list to-article) info))
+
+ (when to-marks
+ (gnus-request-set-mark
+ to-group (list (list (list to-article) 'add to-marks)))))
(gnus-dribble-enter
(concat "(gnus-group-set-info '"
;;;!!!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))))
+ (save-excursion
+ (gnus-summary-goto-subject article)
+ (gnus-summary-mark-article article gnus-canceled-mark)))))
(push article articles-to-update-marks))
- (apply 'gnus-summary-remove-process-mark articles-to-update-marks)
+ (save-excursion
+ (apply 'gnus-summary-remove-process-mark articles-to-update-marks))
;; Re-activate all groups that have been moved to.
(with-current-buffer gnus-group-buffer
(let ((gnus-group-marked to-groups))
;; Delete the articles.
(setq not-deleted (gnus-request-expire-articles
articles gnus-newsgroup-name 'force))
- (while articles
- (gnus-summary-remove-process-mark (car articles))
- ;; The backend might not have been able to delete the article
- ;; after all.
- (unless (memq (car articles) not-deleted)
- (gnus-summary-mark-article (car articles) gnus-canceled-mark))
- (let* ((article (car articles))
- (ghead (gnus-data-header
- (assoc article (gnus-data-list nil)))))
- (run-hook-with-args 'gnus-summary-article-delete-hook
- 'delete ghead gnus-newsgroup-name nil
- nil))
- (setq articles (cdr articles)))
+ (save-excursion
+ (while articles
+ (gnus-summary-remove-process-mark (car articles))
+ ;; The backend might not have been able to delete the article
+ ;; after all.
+ (unless (memq (car articles) not-deleted)
+ (gnus-summary-mark-article (car articles) gnus-canceled-mark))
+ (let* ((article (car articles))
+ (ghead (gnus-data-header
+ (assoc article (gnus-data-list nil)))))
+ (run-hook-with-args 'gnus-summary-article-delete-hook
+ 'delete ghead gnus-newsgroup-name nil
+ nil))
+ (setq articles (cdr articles))))
(when not-deleted
(gnus-message 4 "Couldn't delete articles %s" not-deleted)))
(gnus-summary-position-point)
(t gnus-no-mark))
'replied)
(when (gnus-visual-p 'summary-highlight 'highlight)
+ (gnus-summary-highlight-line)
(gnus-run-hooks 'gnus-summary-update-hook))
t)
;; Go to the right position on the line.
(goto-char (+ forward (point)))
;; Replace the old mark with the new mark.
- (subst-char-in-region (point) (1+ (point)) (char-after) mark)
+ (let ((to-insert
+ (mm-subst-char-in-string
+ (char-after) mark
+ (buffer-substring (point) (1+ (point))))))
+ (delete-region (point) (1+ (point)))
+ (insert to-insert))
;; Optionally update the marks by some user rule.
(when (eq type 'unread)
(gnus-data-set-mark
(defalias 'gnus-summary-mark-as-unread-forward
'gnus-summary-tick-article-forward)
(make-obsolete 'gnus-summary-mark-as-unread-forward
- 'gnus-summary-tick-article-forward)
+ 'gnus-summary-tick-article-forward "Emacs 20.4")
(defun gnus-summary-tick-article-forward (n)
"Tick N articles forwards.
If N is negative, tick backwards instead.
(defalias 'gnus-summary-mark-as-unread-backward
'gnus-summary-tick-article-backward)
(make-obsolete 'gnus-summary-mark-as-unread-backward
- 'gnus-summary-tick-article-backward)
+ 'gnus-summary-tick-article-backward "Emacs 20.4")
(defun gnus-summary-tick-article-backward (n)
"Tick N articles backwards.
The difference between N and the number of articles ticked is returned."
(gnus-summary-mark-forward (- n) gnus-ticked-mark))
(defalias 'gnus-summary-mark-as-unread 'gnus-summary-tick-article)
-(make-obsolete 'gnus-summary-mark-as-unread 'gnus-summary-tick-article)
+(make-obsolete 'gnus-summary-mark-as-unread 'gnus-summary-tick-article "Emacs 20.4")
(defun gnus-summary-tick-article (&optional article clear-mark)
"Mark current article as unread.
Optional 1st argument ARTICLE specifies article number to be marked as unread.
(gnus-message 6 "Threading is now %s" (if gnus-show-threads "on" "off"))
(gnus-summary-position-point)))
+(eval-and-compile
+ (if (fboundp 'remove-overlays)
+ (defalias 'gnus-remove-overlays 'remove-overlays)
+ (defun gnus-remove-overlays (beg end name val)
+ "Clear BEG and END of overlays whose property NAME has value VAL.
+For compatibility with Emacs 21 and XEmacs."
+ (dolist (ov (gnus-overlays-in beg end))
+ (when (eq (gnus-overlay-get ov name) val)
+ (gnus-delete-overlay ov))))))
+
(defun gnus-summary-show-all-threads ()
"Show all threads."
(interactive)
- (save-excursion
- (let ((buffer-read-only nil))
- (subst-char-in-region (point-min) (point-max) ?\^M ?\n t)))
+ (gnus-remove-overlays (point-min) (point-max) 'invisible 'gnus-sum)
(gnus-summary-position-point))
(defun gnus-summary-show-thread ()
"Show thread subtrees.
Returns nil if no thread was there to be shown."
(interactive)
- (let ((buffer-read-only nil)
- (orig (point))
- (end (point-at-eol))
- ;; Leave point at bol
- (beg (progn (beginning-of-line) (point))))
- (prog1
- ;; Any hidden lines here?
- (search-forward "\r" end t)
- (subst-char-in-region beg end ?\^M ?\n t)
+ (let* ((orig (point))
+ (end (point-at-eol))
+ ;; Leave point at bol
+ (beg (progn (beginning-of-line) (if (bobp) (point) (1- (point)))))
+ (eoi (when (eq (get-char-property end 'invisible) 'gnus-sum)
+ (if (fboundp 'next-single-char-property-change)
+ (or (next-single-char-property-change end 'invisible)
+ (point-max))
+ (while (progn
+ (end-of-line 2)
+ (and (not (eobp))
+ (eq (get-char-property (point) 'invisible)
+ 'gnus-sum))))
+ (point)))))
+ (when eoi
+ (gnus-remove-overlays beg eoi 'invisible 'gnus-sum)
(goto-char orig)
- (gnus-summary-position-point))))
+ (gnus-summary-position-point)
+ eoi)))
(defun gnus-summary-maybe-hide-threads ()
"If requested, hide the threads that should be hidden."
will not be hidden.
Returns nil if no threads were there to be hidden."
(interactive)
- (let ((buffer-read-only nil)
- (start (point))
+ (let ((start (point))
+ (starteol (line-end-position))
(article (gnus-summary-article-number)))
(goto-char start)
;; Go forward until either the buffer ends or the subthread ends.
(when (and (not (eobp))
(or (zerop (gnus-summary-next-thread 1 t))
(goto-char (point-max))))
- (prog1
- (if (and (> (point) start)
- (search-backward "\n" start t))
- (progn
- (subst-char-in-region start (point) ?\n ?\^M)
- (gnus-summary-goto-subject article))
- (goto-char start)
- nil)))))
+ (if (and (> (point) start)
+ ;; FIXME: this should actually search for a non-invisible \n.
+ (search-backward "\n" start t))
+ (progn
+ (when (> (point) starteol)
+ (gnus-remove-overlays starteol (point) 'invisible 'gnus-sum)
+ (let ((ol (gnus-make-overlay starteol (point) nil t nil)))
+ (gnus-overlay-put ol 'invisible 'gnus-sum)
+ (gnus-overlay-put ol 'evaporate t)))
+ (gnus-summary-goto-subject article))
+ (goto-char start)
+ nil))))
(defun gnus-summary-go-to-next-thread (&optional previous)
"Go to the same level (or less) next thread.
((> unmark 0)
(gnus-summary-mark-article-as-unread gnus-unread-mark))
((= unmark 0)
- (gnus-summary-mark-article-as-unread gnus-expirable-mark))
+ (gnus-summary-mark-article nil gnus-expirable-mark))
(t
(gnus-summary-mark-article-as-unread gnus-ticked-mark)))
(setq articles (cdr articles))))
(interactive "P")
(gnus-summary-sort 'number reverse))
+(defun gnus-summary-sort-by-most-recent-number (&optional reverse)
+ "Sort the summary buffer by most recent article number.
+Argument REVERSE means reverse order."
+ (interactive "P")
+ (gnus-summary-sort 'most-recent-number reverse))
+
(defun gnus-summary-sort-by-random (&optional reverse)
"Randomize the order in the summary buffer.
Argument REVERSE means to randomize in reverse order."
(interactive "P")
(gnus-summary-sort 'date reverse))
+(defun gnus-summary-sort-by-most-recent-date (&optional reverse)
+ "Sort the summary buffer by most recent date.
+Argument REVERSE means reverse order."
+ (interactive "P")
+ (gnus-summary-sort 'most-recent-date reverse))
+
(defun gnus-summary-sort-by-score (&optional reverse)
"Sort the summary buffer by score.
Argument REVERSE means reverse order."
(gnus-message 1 "Article %d is unsaveable" article))
;; This is a real article.
(save-window-excursion
- (let ((gnus-display-mime-function (when decode
- gnus-display-mime-function))
- (gnus-article-prepare-hook (when decode
- gnus-article-prepare-hook)))
- (gnus-summary-select-article t t nil article)
- (gnus-summary-goto-subject article)))
+ (gnus-summary-select-article decode decode nil article)
+ (gnus-summary-goto-subject article))
(with-current-buffer save-buffer
(erase-buffer)
(insert-buffer-substring (if decode
(gnus-set-mode-line 'summary)
n))
-(defun gnus-summary-pipe-output (&optional arg headers)
+(defun gnus-summary-pipe-output (&optional n sym)
"Pipe the current article to a subprocess.
If N is a positive number, pipe the N next articles.
If N is a negative number, pipe the N previous articles.
If N is nil and any articles have been marked with the process mark,
pipe those articles instead.
-If HEADERS (the symbolic prefix) is given, force including all headers."
+The default command to which articles are piped is specified by the
+variable `gnus-summary-pipe-output-default-command'; if it is nil, you
+will be prompted for the command.
+
+The properties `:decode' and `:headers' that are put to the function
+symbol `gnus-summary-save-in-pipe' control whether this function
+decodes articles and what headers to keep (see the doc string for the
+`gnus-default-article-saver' variable). If SYM (the symbolic prefix)
+is neither omitted nor the symbol `r', force including all headers
+regardless of the `:headers' property. If it is the symbol `r',
+articles that are not decoded and include all headers will be piped
+no matter what the properties `:decode' and `:headers' are."
(interactive (gnus-interactive "P\ny"))
(require 'gnus-art)
- (let ((gnus-default-article-saver 'gnus-summary-save-in-pipe))
- (if headers
- (let ((gnus-save-all-headers t)
- (headers (get gnus-default-article-saver :headers)))
- (unwind-protect
- (progn
- (put gnus-default-article-saver :headers nil)
- (gnus-summary-save-article arg t))
- (put gnus-default-article-saver :headers headers)))
- (gnus-summary-save-article arg t)))
- (let ((buffer (get-buffer "*Shell Command Output*")))
- (when (and buffer
- (not (zerop (buffer-size buffer))))
- (gnus-configure-windows 'pipe))))
+ (let* ((articles (gnus-summary-work-articles n))
+ (result-buffer "*Shell Command Output*")
+ (all-headers (not (memq sym '(nil r))))
+ (gnus-save-all-headers (or all-headers gnus-save-all-headers))
+ (raw (eq sym 'r))
+ (headers (get 'gnus-summary-save-in-pipe :headers))
+ command result)
+ (unless (numberp (car articles))
+ (error "No article to pipe"))
+ (setq command (gnus-read-shell-command
+ (concat "Shell command on "
+ (if (cdr articles)
+ (format "these %d articles" (length articles))
+ "this article")
+ ": ")
+ gnus-summary-pipe-output-default-command))
+ (when (string-equal command "")
+ (error "A command is required"))
+ (when all-headers
+ (put 'gnus-summary-save-in-pipe :headers nil))
+ (unwind-protect
+ (while articles
+ (gnus-summary-goto-subject (pop articles))
+ (save-window-excursion (gnus-summary-save-in-pipe command raw))
+ (when (and (get-buffer result-buffer)
+ (not (zerop (buffer-size (get-buffer result-buffer)))))
+ (setq result (concat result (with-current-buffer result-buffer
+ (buffer-string))))))
+ (put 'gnus-summary-save-in-pipe :headers headers))
+ (unless (zerop (length result))
+ (if (with-current-buffer (get-buffer-create result-buffer)
+ (erase-buffer)
+ (insert result)
+ (prog1
+ (and (= (count-lines (point-min) (point)) 1)
+ (progn
+ (end-of-line 0)
+ (<= (current-column)
+ (window-width (minibuffer-window)))))
+ (goto-char (point-min))))
+ (message "%s" (substring result 0 -1))
+ (message nil)
+ (gnus-configure-windows 'pipe)))))
(defun gnus-summary-save-article-mail (&optional arg)
"Append the current article to a Unix mail box file.
(gnus-summary-limit (gnus-sorted-nunion old new))))
(gnus-summary-position-point)))
+;;; Bookmark support for Gnus.
+(declare-function bookmark-make-record-default
+ "bookmark" (&optional no-file no-context posn))
+(declare-function bookmark-prop-get "bookmark" (bookmark prop))
+(declare-function bookmark-default-handler "bookmark" (bmk))
+(declare-function bookmark-get-bookmark-record "bookmark" (bmk))
+(defvar bookmark-yank-point)
+(defvar bookmark-current-buffer)
+
+(defun gnus-summary-bookmark-make-record ()
+ "Make a bookmark entry for a Gnus summary buffer."
+ (let (pos buf)
+ (unless (and (derived-mode-p 'gnus-summary-mode) gnus-article-current)
+ (save-restriction ; FIXME is it necessary to widen?
+ (widen) (setq pos (point))) ; Set position in gnus-article buffer.
+ (setq buf "art") ; We are recording bookmark from article buffer.
+ (setq bookmark-yank-point (point))
+ (setq bookmark-current-buffer (current-buffer))
+ (gnus-article-show-summary)) ; Go back in summary buffer.
+ ;; We are now recording bookmark from summary buffer.
+ (unless buf (setq buf "sum"))
+ (let* ((subject (elt (gnus-summary-article-header) 1))
+ (grp (car gnus-article-current))
+ (art (cdr gnus-article-current))
+ (head (gnus-summary-article-header art))
+ (id (mail-header-id head)))
+ `(,subject
+ ,@(condition-case nil
+ (bookmark-make-record-default 'no-file 'no-context pos)
+ (wrong-number-of-arguments
+ (bookmark-make-record-default 'point-only)))
+ (location . ,(format "Gnus-%s %s:%d:%s" buf grp art id))
+ (group . ,grp) (article . ,art)
+ (message-id . ,id) (handler . gnus-summary-bookmark-jump)))))
+
+;;;###autoload
+(defun gnus-summary-bookmark-jump (bookmark)
+ "Handler function for record returned by `gnus-summary-bookmark-make-record'.
+BOOKMARK is a bookmark name or a bookmark record."
+ (let ((group (bookmark-prop-get bookmark 'group))
+ (article (bookmark-prop-get bookmark 'article))
+ (id (bookmark-prop-get bookmark 'message-id))
+ (buf (car (split-string (bookmark-prop-get bookmark 'location)))))
+ (gnus-fetch-group group (list article))
+ (gnus-summary-insert-cached-articles)
+ (gnus-summary-goto-article id nil 'force)
+ ;; FIXME we have to wait article buffer is ready (only large buffer)
+ ;; Is there a better solution to know that?
+ ;; If we don't wait `bookmark-default-handler' will have no chance
+ ;; to set position. However there is no error, just wrong pos.
+ (sit-for 1)
+ (when (string= buf "Gnus-art")
+ (other-window 1))
+ (bookmark-default-handler
+ `(""
+ (buffer . ,(current-buffer))
+ . ,(bookmark-get-bookmark-record bookmark)))))
+
(gnus-summary-make-all-marking-commands)
(gnus-ems-redefine)
;; coding: iso-8859-1
;; End:
-;; arch-tag: 17c6748f-6d00-4d36-bf01-835c42f31235
;;; gnus-sum.el ends here