;;; gnus-sum.el --- summary mode commands for Gnus
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
+;; Copyright (C) 1996-2011 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
;;; Code:
-;; For Emacs < 22.2.
+;; For Emacs <22.2 and XEmacs.
(eval-and-compile
(unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
(eval-when-compile
(autoload 'gnus-article-outlook-unwrap-lines "deuglify" nil t)
(autoload 'gnus-article-outlook-repair-attribution "deuglify" nil t)
(autoload 'gnus-article-outlook-rearrange-citation "deuglify" nil t)
+(autoload 'nnir-article-rsv "nnir" nil nil 'macro)
+(autoload 'nnir-article-group "nnir" nil nil 'macro)
(defcustom gnus-kill-summary-on-exit t
"*If non-nil, kill the summary buffer when you exit from it.
unread article), `best' (place point on the subject line of the
higest-scored article), `unseen' (place point on the subject line of
the first unseen article), `unseen-or-unread' (place point on the subject
-line of the first unseen article or, if all article have been seen, on the
+line of the first unseen article or, if all articles 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 "24.1"
:type 'boolean
:group 'gnus-summary-marks)
-(defcustom gnus-propagate-marks t
- "If non-nil, do not propagate marks to the backends."
- :version "23.1" ;; No Gnus
+(defcustom gnus-propagate-marks nil
+ "If non-nil, Gnus will store and retrieve marks from the backends.
+This means that marks will be stored both in .newsrc.eld and in
+the backend, and will slow operation down somewhat."
:type 'boolean
:group 'gnus-summary-marks)
(?c (or (mail-header-chars gnus-tmp-header) 0) ?d)
(?k (gnus-summary-line-message-size gnus-tmp-header) ?s)
(?L gnus-tmp-lines ?s)
+ (?Z (or ,(gnus-macroexpand-all
+ '(nnir-article-rsv (mail-header-number gnus-tmp-header)))
+ 0) ?d)
+ (?G (or ,(gnus-macroexpand-all
+ '(nnir-article-group (mail-header-number gnus-tmp-header)))
+ "") ?s)
+ (?g (or ,(gnus-macroexpand-all
+ '(gnus-group-short-name
+ (nnir-article-group (mail-header-number gnus-tmp-header))))
+ "") ?s)
(?O gnus-tmp-downloaded ?c)
(?I gnus-tmp-indentation ?s)
(?T (if (= gnus-tmp-level 0) "" (make-string (frame-width) ? )) ?s)
gnus-newsgroup-prepared gnus-summary-highlight-line-function
gnus-current-article gnus-current-headers gnus-have-all-headers
gnus-last-article gnus-article-internal-prepare-hook
+ (gnus-summary-article-delete-hook . global)
+ (gnus-summary-article-move-hook . global)
gnus-newsgroup-dependencies gnus-newsgroup-selected-overlay
gnus-newsgroup-scored gnus-newsgroup-kill-headers
gnus-thread-expunge-below
"a" gnus-summary-post-news
"x" gnus-summary-limit-to-unread
"s" gnus-summary-isearch-article
+ [tab] gnus-summary-widget-forward
"t" gnus-summary-toggle-header
"g" gnus-summary-show-article
"l" gnus-summary-goto-last-article
"D" gnus-summary-enter-digest-group
"R" gnus-summary-refer-references
"T" gnus-summary-refer-thread
+ "W" gnus-warp-to-article
"g" gnus-summary-show-article
"s" gnus-summary-isearch-article
+ [tab] gnus-summary-widget-forward
"P" gnus-summary-print-article
"S" gnus-sticky-article
"M" gnus-mailing-list-insinuate
"a" gnus-article-strip-headers-in-body ;; mnemonic: wash archive
"p" gnus-article-verify-x-pgp-sig
"d" gnus-article-treat-dumbquotes
+ "U" gnus-article-treat-non-ascii
"i" gnus-summary-idna-message)
(gnus-define-keys (gnus-summary-wash-deuglify-map "Y" gnus-summary-wash-map)
"d" gnus-article-display-face
"s" gnus-treat-smiley
"D" gnus-article-remove-images
- "W" gnus-html-show-images
+ "W" gnus-article-show-images
"f" gnus-treat-from-picon
"m" gnus-treat-mail-picon
"n" gnus-treat-newsgroups-picon
"v" gnus-version
"d" gnus-summary-describe-group
"h" gnus-summary-describe-briefly
- "i" gnus-info-find-node
- "C" gnus-group-fetch-control)
+ "i" gnus-info-find-node)
(gnus-define-keys (gnus-summary-backend-map "B" gnus-summary-mode-map)
"e" gnus-summary-expire-articles
gnus-article-remove-leading-whitespace t])
["Overstrike" gnus-article-treat-overstrike t]
["Dumb quotes" gnus-article-treat-dumbquotes t]
+ ["Non-ASCII" gnus-article-treat-non-ascii t]
["Emphasis" gnus-article-emphasize t]
["Word wrap" gnus-article-fill-cited-article t]
["Fill long lines" gnus-article-fill-long-lines t]
["Original sort" gnus-summary-sort-by-original t])
("Help"
["Describe group" gnus-summary-describe-group t]
- ["Fetch control message" gnus-group-fetch-control
- ,@(if (featurep 'xemacs) nil
- '(:help "Display the archived control message for the current group"))]
["Read manual" gnus-info-find-node t])
("Modes"
["Pick and read" gnus-pick-mode t]
((< c (* 1000 10000)) (format "%1.1fM" (/ c (* 1024.0 1024))))
(t (format "%dM" (/ c (* 1024.0 1024)))))))
+(defcustom gnus-user-date-format-alist
+ '(((gnus-seconds-today) . "Today, %H:%M")
+ ((+ 86400 (gnus-seconds-today)) . "Yesterday, %H:%M")
+ (604800 . "%A %H:%M") ; That's one week
+ ((gnus-seconds-month) . "%A %d")
+ ((gnus-seconds-year) . "%B %d")
+ (t . "%b %d %Y")) ; This one is used when no other
+ ; does match
+ "Specifies date format depending on age of article.
+This is an alist of items (AGE . FORMAT). AGE can be a number (of
+seconds) or a Lisp expression evaluating to a number. When the age of
+the article is less than this number, then use `format-time-string'
+with the corresponding FORMAT for displaying the date of the article.
+If AGE is not a number or a Lisp expression evaluating to a
+non-number, then the corresponding FORMAT is used as a default value.
+
+Note that the list is processed from the beginning, so it should be
+sorted by ascending AGE. Also note that items following the first
+non-number AGE will be ignored.
+
+You can use the functions `gnus-seconds-today', `gnus-seconds-month'
+and `gnus-seconds-year' in the AGE spec. They return the number of
+seconds passed since the start of today, of this month, of this year,
+respectively."
+ :version "24.1"
+ :group 'gnus-summary-format
+ :type '(alist :key-type sexp :value-type string))
+
+(defun gnus-user-date (messy-date)
+ "Format the messy-date according to `gnus-user-date-format-alist'.
+Returns \" ? \" if there's bad input or if another error occurs.
+Input should look like this: \"Sun, 14 Oct 2001 13:34:39 +0200\"."
+ (condition-case ()
+ (let* ((messy-date (gnus-float-time (gnus-date-get-time messy-date)))
+ (now (gnus-float-time))
+ ;;If we don't find something suitable we'll use this one
+ (my-format "%b %d '%y"))
+ (let* ((difference (- now messy-date))
+ (templist gnus-user-date-format-alist)
+ (top (eval (caar templist))))
+ (while (if (numberp top) (< top difference) (not top))
+ (progn
+ (setq templist (cdr templist))
+ (setq top (eval (caar templist)))))
+ (if (stringp (cdr (car templist)))
+ (setq my-format (cdr (car templist)))))
+ (format-time-string (eval my-format) (seconds-to-time messy-date)))
+ (error " ? ")))
(defun gnus-summary-set-local-parameters (group)
"Go through the local params of GROUP and set all variable specs in that list."
- (let ((vars '(quit-config))) ; Ignore quit-config.
+ (let ((vars '(quit-config active))) ; Ignore things that aren't
+ ; really variables.
(dolist (elem (gnus-group-find-parameter group))
(and (consp elem) ; Has to be a cons.
(consp (cdr elem)) ; The cdr has to be a list.
(gnus-group-jump-to-group group)
(gnus-group-next-unread-group 1))
(gnus-handle-ephemeral-exit quit-config)))
- (let ((grpinfo (gnus-get-info group)))
- (if (null (gnus-info-read grpinfo))
- (gnus-message 3 "Group %s contains no messages"
- (gnus-group-decoded-name group))
- (gnus-message 3 "Can't select group")))
+ (if (null (gnus-list-of-unread-articles group))
+ (gnus-message 3 "Group %s contains no messages" group)
+ (gnus-message 3 "Can't select group"))
nil)
;; The user did a `C-g' while prompting for number of articles,
;; so we exit this group.
;; gnus-summary-prepare-hook since kill processing may not
;; work with hidden articles.
(gnus-summary-maybe-hide-threads)
+ (gnus-configure-windows 'summary)
(when kill-buffer
(gnus-kill-or-deaden-summary kill-buffer))
(gnus-summary-auto-select-subject)
gnus-newsgroup-unreads
gnus-auto-select-first)
(progn
- (gnus-configure-windows 'summary)
(let ((art (gnus-summary-article-number)))
(unless (and (not gnus-plugged)
(or (memq art gnus-newsgroup-undownloaded)
(while (not (eobp))
(ignore-errors
(setq article (read (current-buffer))
- header (gnus-nov-parse-line article dependencies)))
+ header (gnus-nov-parse-line article dependencies t)))
(when header
(with-current-buffer gnus-summary-buffer
(push header gnus-newsgroup-headers)
(substring subject (match-end 1)))))
(mail-header-set-subject header subject))))))
-(defun gnus-fetch-headers (articles)
+(defun gnus-fetch-headers (articles &optional limit force-new dependencies)
"Fetch headers of ARTICLES."
(let ((name (gnus-group-decoded-name gnus-newsgroup-name)))
(gnus-message 5 "Fetching headers for %s..." name)
(setq gnus-headers-retrieved-by
(gnus-retrieve-headers
articles gnus-newsgroup-name
- ;; We might want to fetch old headers, but
- ;; not if there is only 1 article.
- (and (or (and
- (not (eq gnus-fetch-old-headers 'some))
- (not (numberp gnus-fetch-old-headers)))
- (> (length articles) 1))
- gnus-fetch-old-headers))))
+ (or limit
+ ;; We might want to fetch old headers, but
+ ;; not if there is only 1 article.
+ (and (or (and
+ (not (eq gnus-fetch-old-headers 'some))
+ (not (numberp gnus-fetch-old-headers)))
+ (> (length articles) 1))
+ gnus-fetch-old-headers)))))
(gnus-get-newsgroup-headers-xover
- articles nil nil gnus-newsgroup-name t)
- (gnus-get-newsgroup-headers))
+ articles force-new dependencies gnus-newsgroup-name t)
+ (gnus-get-newsgroup-headers dependencies force-new))
(gnus-message 5 "Fetching headers for %s...done" name))))
(defun gnus-select-newsgroup (group &optional read-all select-articles)
(mm-decode-coding-string group charset)
(mm-decode-coding-string (gnus-status-message group) charset)))
- (when gnus-agent
+ (when (and gnus-agent
+ (gnus-active group))
(gnus-agent-possibly-alter-active group (gnus-active group) info)
(setq gnus-summary-use-undownloaded-faces
(setq gnus-newsgroup-processable nil)
- (gnus-update-read-articles group gnus-newsgroup-unreads)
+ (gnus-update-read-articles group gnus-newsgroup-unreads t)
;; Adjust and set lists of article marks.
(when info
(defun gnus-articles-to-read (group &optional read-all)
"Find out what articles the user wants to read."
- (let* ((articles
+ (let* ((only-read-p t)
+ (articles
;; Select all articles if `read-all' is non-nil, or if there
;; are no unread articles.
(if (or read-all
(gnus-uncompress-range (gnus-active group)))
(gnus-cache-articles-in-group group))
;; Select only the "normal" subset of articles.
+ (setq only-read-p nil)
(gnus-sorted-nunion
(gnus-sorted-union gnus-newsgroup-dormant gnus-newsgroup-marked)
gnus-newsgroup-unreads)))
(let* ((cursor-in-echo-area nil)
(initial (gnus-parameter-large-newsgroup-initial
gnus-newsgroup-name))
+ (default (if only-read-p
+ (or initial gnus-large-newsgroup)
+ number))
(input
(read-string
- (format
- "How many articles from %s (%s %d): "
- (gnus-group-decoded-name gnus-newsgroup-name)
- (if initial "max" "default")
- number)
- (if initial
- (cons (number-to-string initial)
- 0)))))
+ (if only-read-p
+ (format
+ "How many articles from %s (available %d, default %d): "
+ (gnus-group-decoded-name
+ (gnus-group-real-name gnus-newsgroup-name))
+ number default)
+ (format
+ "How many articles from %s (%d available): "
+ (gnus-group-decoded-name
+ (gnus-group-real-name gnus-newsgroup-name))
+ default))
+ nil
+ nil
+ (number-to-string default))))
(if (string-match "^[ \t]*$" input) number input)))
((and (> scored marked) (< scored number)
(> (- scored number) 20))
(read-string
(format "%s %s (%d scored, %d total): "
"How many articles from"
- (gnus-group-decoded-name group)
+ (gnus-group-decoded-name
+ (gnus-group-real-name gnus-newsgroup-name))
scored number))))
(if (string-match "^[ \t]*$" input)
number input)))
(info (nth 2 entry))
(active (gnus-active group))
range)
- (when entry
+ (if (not entry)
+ ;; Group that Gnus doesn't know exists, but still allow the
+ ;; backend to set marks.
+ (gnus-request-set-mark
+ group (list (list (gnus-compress-sequence (sort articles #'<))
+ 'add '(read))))
+ ;; Normal, subscribed groups.
(setq range (gnus-compute-read-articles group articles))
(with-current-buffer gnus-group-buffer
(gnus-undo-register
;; Various summary commands
(defun gnus-summary-select-article-buffer ()
- "Reconfigure windows to show the article buffer."
+ "Reconfigure windows to show the article buffer.
+If `gnus-widen-article-buffer' is set, show only the article
+buffer."
(interactive)
(if (not (gnus-buffer-live-p gnus-article-buffer))
(error "There is no article buffer for this summary buffer")
(defun gnus-summary-rescan-group (&optional all)
"Exit the newsgroup, ask for new articles, and select the newsgroup."
(interactive "P")
- (gnus-summary-reselect-current-group all t))
+ (let ((config gnus-current-window-configuration))
+ (gnus-summary-reselect-current-group all t)
+ (gnus-configure-windows config)
+ (when (eq config 'article)
+ (gnus-summary-select-article))))
(defun gnus-summary-update-info (&optional non-destructive)
(save-excursion
(let* ((group gnus-newsgroup-name)
(quit-config (gnus-group-quit-config gnus-newsgroup-name))
(gnus-group-is-exiting-p t)
+ (article-buffer gnus-article-buffer)
(mode major-mode)
(group-point nil)
(buf (current-buffer)))
(when (eq mode 'gnus-summary-mode)
(gnus-kill-buffer buf)))
- ;; If we have several article buffers, we kill them at exit.
- (unless gnus-single-article-buffer
- (when (gnus-buffer-live-p gnus-article-buffer)
- (with-current-buffer gnus-article-buffer
- ;; Don't kill sticky article buffers
- (unless (eq major-mode 'gnus-sticky-article-mode)
- (gnus-kill-buffer gnus-article-buffer)
- (setq gnus-article-current nil))))
- (gnus-kill-buffer gnus-original-article-buffer))
-
(setq gnus-current-select-method gnus-select-method)
(set-buffer gnus-group-buffer)
(if quit-config
(if win (set-window-point win (point))))
(unless leave-hidden
(gnus-configure-windows 'group 'force)))
+
+ ;; If we have several article buffers, we kill them at exit.
+ (unless gnus-single-article-buffer
+ (when (gnus-buffer-live-p article-buffer)
+ (with-current-buffer article-buffer
+ ;; Don't kill sticky article buffers
+ (unless (eq major-mode 'gnus-sticky-article-mode)
+ (gnus-kill-buffer article-buffer)
+ (setq gnus-article-current nil))))
+ (gnus-kill-buffer gnus-original-article-buffer))
+
;; Clear the current group name.
(unless quit-config
(setq gnus-newsgroup-name nil)))))
(gnus-kill-buffer gnus-article-buffer)
(gnus-kill-buffer gnus-original-article-buffer)
(setq gnus-article-current nil))
+ ;; Return to the group buffer.
+ (gnus-configure-windows 'group 'force)
(if (not gnus-kill-summary-on-exit)
(gnus-deaden-summary)
(gnus-close-group group)
(gnus-async-prefetch-remove-group group)
(when (get-buffer gnus-article-buffer)
(bury-buffer gnus-article-buffer))
- ;; Return to the group buffer.
- (gnus-configure-windows 'group 'force)
;; Clear the current group name.
(setq gnus-newsgroup-name nil)
(unless (gnus-ephemeral-group-p group)
(null (get-buffer gnus-article-buffer))
(not (eq article (cdr gnus-article-current)))
(not (equal (car gnus-article-current)
- gnus-newsgroup-name))))
+ gnus-newsgroup-name))
+ (not (get-buffer gnus-original-article-buffer))))
(and (not gnus-single-article-buffer)
(or (null gnus-current-article)
+ (not (get-buffer gnus-original-article-buffer))
(not (eq gnus-current-article article))))
force)
;; The requested article is different from the current article.
(point
(with-current-buffer gnus-group-buffer
(point)))
+ (current-summary (current-buffer))
(group
(if (eq gnus-keep-same-level 'best)
(gnus-summary-best-group gnus-newsgroup-name)
(gnus-summary-search-group backward gnus-keep-same-level))))
- ;; For some reason, the group window gets selected. We change
- ;; it back.
- (select-window (get-buffer-window (current-buffer)))
;; Select next unread newsgroup automagically.
(cond
((or (not gnus-auto-select-next)
(gnus-summary-next-group nil group backward)))
(t
(when (gnus-key-press-event-p last-input-event)
+ ;; Somehow or other, we may now have selected a different
+ ;; window. Make point go back to the summary buffer.
+ (when (eq current-summary (current-buffer))
+ (select-window (get-buffer-window current-summary)))
(gnus-summary-walk-group-buffer
gnus-newsgroup-name cmd unread backward point))))))))
(gnus-summary-limit articles))
(gnus-summary-position-point))
-(defalias 'gnus-summary-delete-marked-as-read 'gnus-summary-limit-to-unread)
-(make-obsolete
- 'gnus-summary-delete-marked-as-read 'gnus-summary-limit-to-unread "Emacs 20.4")
-
(defun gnus-summary-limit-to-unread (&optional all)
"Limit the summary buffer to articles that are not marked as read.
If ALL is non-nil, limit strictly to unread articles."
(gnus-summary-limit gnus-newsgroup-replied))
(gnus-summary-position-point))
-(defalias 'gnus-summary-delete-marked-with 'gnus-summary-limit-exclude-marks)
-(make-obsolete 'gnus-summary-delete-marked-with
- '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\").
If REVERSE, limit the summary buffer to articles that are marked
article."
(interactive (list (mail-header-id (gnus-summary-article-header))))
(let ((articles (gnus-articles-in-thread
- (gnus-id-to-thread (gnus-root-id id)))))
+ (gnus-id-to-thread (gnus-root-id id))))
+ ;;we REALLY want the whole thread---this prevents cut-threads
+ ;;from removing the thread we want to include.
+ (gnus-fetch-old-headers nil)
+ (gnus-build-sparse-threads nil))
(prog1
(gnus-summary-limit (nconc articles gnus-newsgroup-limit))
(gnus-summary-limit-include-matching-articles
(gnus-summary-limit (append gnus-newsgroup-dormant gnus-newsgroup-limit))
(gnus-summary-position-point)))
+(defun gnus-summary-include-articles (articles)
+ "Fetch the headers for ARTICLES and then display the summary lines."
+ (let ((gnus-inhibit-demon t)
+ (gnus-agent nil)
+ (gnus-read-all-available-headers t))
+ (setq gnus-newsgroup-headers
+ (gnus-merge
+ 'list gnus-newsgroup-headers
+ (gnus-fetch-headers articles nil t)
+ 'gnus-article-sort-by-number))
+ (gnus-summary-limit (append articles gnus-newsgroup-limit))))
+
(defun gnus-summary-limit-exclude-dormant ()
"Hide all dormant articles."
(interactive)
(defun gnus-summary-refer-thread (&optional limit)
"Fetch all articles in the current thread.
-If LIMIT (the numerical prefix), fetch that many old headers instead
-of what's specified by the `gnus-refer-thread-limit' variable."
+If no backend-specific 'request-thread function is available
+fetch LIMIT (the numerical prefix) old headers. If LIMIT is nil
+fetch what's specified by the `gnus-refer-thread-limit'
+variable."
(interactive "P")
- (let ((id (mail-header-id (gnus-summary-article-header)))
- (limit (if limit (prefix-numeric-value limit)
- gnus-refer-thread-limit)))
- (unless (eq gnus-fetch-old-headers 'invisible)
- (gnus-message 5 "Fetching headers for %s..." gnus-newsgroup-name)
- ;; Retrieve the headers and read them in.
- (if (eq (if (numberp limit)
- (gnus-retrieve-headers
- (list (min
- (+ (mail-header-number
- (gnus-summary-article-header))
- limit)
- gnus-newsgroup-end))
- gnus-newsgroup-name (* limit 2))
- ;; gnus-refer-thread-limit is t, i.e. fetch _all_
- ;; headers.
- (gnus-retrieve-headers (list gnus-newsgroup-end)
- gnus-newsgroup-name limit))
- 'nov)
- (gnus-build-all-threads)
- (error "Can't fetch thread from back ends that don't support NOV"))
- (gnus-message 5 "Fetching headers for %s...done" gnus-newsgroup-name))
+ (gnus-warp-to-article)
+ (let* ((header (gnus-summary-article-header))
+ (id (mail-header-id header))
+ (gnus-inhibit-demon t)
+ (gnus-summary-ignore-duplicates t)
+ (gnus-read-all-available-headers t)
+ (limit (if limit (prefix-numeric-value limit)
+ gnus-refer-thread-limit)))
+ (setq gnus-newsgroup-headers
+ (gnus-merge
+ 'list gnus-newsgroup-headers
+ (if (gnus-check-backend-function
+ 'request-thread gnus-newsgroup-name)
+ (gnus-request-thread header)
+ (let* ((last (if (numberp limit)
+ (min (+ (mail-header-number header)
+ limit)
+ gnus-newsgroup-highest)
+ gnus-newsgroup-highest))
+ (subject (gnus-simplify-subject
+ (mail-header-subject header)))
+ (refs (split-string (or (mail-header-references header)
+ "")))
+ (gnus-parse-headers-hook
+ (lambda () (goto-char (point-min))
+ (keep-lines
+ (regexp-opt (append refs (list id subject)))))))
+ (gnus-fetch-headers (list last) (if (numberp limit)
+ (* 2 limit) limit) t)))
+ 'gnus-article-sort-by-number))
(gnus-summary-limit-include-thread id)))
(defun gnus-summary-refer-article (message-id)
(defun gnus-summary-enter-digest-group (&optional force)
"Enter an nndoc group based on the current article.
-If FORCE, force a digest interpretation. If not, try
-to guess what the document format is."
+If FORCE, force a digest interpretation. If not, try to guess
+what the document format is.
+
+To control what happens when you exit the group, see the
+`gnus-auto-select-on-ephemeral-exit' variable."
(interactive "P")
(let ((conf gnus-current-window-configuration))
(save-window-excursion
(t
(error "Couldn't select virtual nndoc group")))))
+(defun gnus-summary-widget-forward (arg)
+ "Move point to the next field or button in the article.
+With optional ARG, move across that many fields."
+ (interactive "p")
+ (gnus-summary-select-article)
+ (gnus-configure-windows 'article)
+ (select-window (gnus-get-buffer-window gnus-article-buffer))
+ (widget-forward arg))
+
(defun gnus-summary-isearch-article (&optional regexp-p)
"Do incremental search forward on the current article.
If REGEXP-P (the prefix) is non-nil, do regexp isearch."
(ps-despool filename))
(defun gnus-print-buffer ()
- (let ((buffer (generate-new-buffer " *print*")))
- (unwind-protect
- (progn
- (copy-to-buffer buffer (point-min) (point-max))
- (set-buffer buffer)
- (gnus-remove-text-with-property 'gnus-decoration)
- (when (gnus-visual-p 'article-highlight 'highlight)
- ;; Copy-to-buffer doesn't copy overlay. So redo
- ;; highlight.
- (let ((gnus-article-buffer buffer))
- (gnus-article-highlight-citation t)
- (gnus-article-highlight-signature)
- (gnus-article-emphasize)
- (gnus-article-delete-invisible-text)))
- (let ((ps-left-header
- (list
- (concat "("
- (gnus-summary-print-truncate-and-quote
- (mail-header-subject gnus-current-headers)
- 66) ")")
- (concat "("
- (gnus-summary-print-truncate-and-quote
- (mail-header-from gnus-current-headers)
- 45) ")")))
- (ps-right-header
- (list
- "/pagenumberstring load"
- (concat "("
- (mail-header-date gnus-current-headers) ")"))))
- (gnus-run-hooks 'gnus-ps-print-hook)
- (save-excursion
- (if ps-print-color-p
- (ps-spool-buffer-with-faces)
- (ps-spool-buffer)))))
- (kill-buffer buffer))))
+ (let ((ps-left-header
+ (list
+ (concat "("
+ (gnus-summary-print-truncate-and-quote
+ (mail-header-subject gnus-current-headers)
+ 66) ")")
+ (concat "("
+ (gnus-summary-print-truncate-and-quote
+ (mail-header-from gnus-current-headers)
+ 45) ")")))
+ (ps-right-header
+ (list
+ "/pagenumberstring load"
+ (concat "("
+ (mail-header-date gnus-current-headers) ")"))))
+ (gnus-run-hooks 'gnus-ps-print-hook)
+ (save-excursion
+ (if ps-print-color-p
+ (ps-spool-buffer-with-faces)
+ (ps-spool-buffer)))))
(defun gnus-summary-show-complete-article ()
"Show a complete version of the current article.
If ARG (the prefix) is a number, show the article with the charset
defined in `gnus-summary-show-article-charset-alist', or the charset
input.
-If ARG (the prefix) is non-nil and not a number, show the raw article
-without any article massaging functions being run. Normally, the key
-strokes are `C-u g'."
+If ARG (the prefix) is non-nil and not a number, show the article,
+but without running any of the article treatment functions
+article. Normally, the keystroke is `C-u g'. When using `C-u
+C-u g', show the raw article."
(interactive "P")
(cond
((numberp arg)
((not arg)
;; Select the article the normal way.
(gnus-summary-select-article nil 'force))
+ ((equal arg '(16))
+ ;; C-u C-u g
+ (let ((gnus-inhibit-article-treatments t))
+ (gnus-summary-select-article nil 'force)))
(t
;; We have to require this here to make sure that the following
;; dynamic binding isn't shadowed by autoloading.
articles)
(while articles
(setq article (pop articles))
+ ;; Set any marks that may have changed in the summary buffer.
+ (when gnus-preserve-marks
+ (gnus-summary-push-marks-to-backend article))
(setq
art-group
(cond
(move-is-internal (gnus-server-equal from-method to-method)))
(gnus-request-move-article
article ; Article to move
- gnus-newsgroup-name ; From newsgroup
+ gnus-newsgroup-name ; From newsgroup
(nth 1 (gnus-find-method-for-group
gnus-newsgroup-name)) ; Server
(list 'gnus-request-accept-article
(not articles) ; Only save nov last time
(and move-is-internal
to-newsgroup ; Not respooling
- (gnus-group-real-name to-newsgroup))))) ; Is this move internal?
+ ; Is this move internal?
+ (gnus-group-real-name to-newsgroup)))))
;; Copy the article.
((eq action 'copy)
(with-current-buffer copy-buf
- (when (gnus-request-article-this-buffer article gnus-newsgroup-name)
+ (when (gnus-request-article-this-buffer article
+ gnus-newsgroup-name)
(save-restriction
(nnheader-narrow-to-headers)
(dolist (hdr gnus-copy-article-ignored-headers)
;; Crosspost the article.
((eq action 'crosspost)
(let ((xref (message-tokenize-header
- (mail-header-xref (gnus-summary-article-header article))
+ (mail-header-xref (gnus-summary-article-header
+ article))
" ")))
(setq new-xref (concat (gnus-group-real-name gnus-newsgroup-name)
":" (number-to-string article)))
(gnus-request-article-this-buffer article gnus-newsgroup-name)
(when (consp (setq art-group
(gnus-request-accept-article
- to-newsgroup select-method (not articles) t)))
+ to-newsgroup select-method (not articles)
+ t)))
(setq new-xref (concat new-xref " " (car art-group)
":"
(number-to-string (cdr art-group))))
(unless (member to-group to-groups)
(push to-group to-groups))
- (unless (memq article gnus-newsgroup-unreads)
+ (when (and (not (memq article gnus-newsgroup-unreads))
+ (cdr art-group))
(push 'read to-marks)
(gnus-info-set-read
info (gnus-add-to-range (gnus-info-read info)
(marks (if expirable
gnus-article-mark-lists
(delete '(expirable . expire)
- (copy-sequence gnus-article-mark-lists))))
+ (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.
- (when gnus-use-cache
+ (when (and to-article
+ gnus-use-cache)
(gnus-cache-possibly-enter-article
to-group to-article
(memq article gnus-newsgroup-marked)
(memq article gnus-newsgroup-dormant)
(memq article gnus-newsgroup-unreads)))
- (when gnus-preserve-marks
+ (when (and gnus-preserve-marks
+ to-article)
;; Copy any marks over to the new group.
(when (and (equal to-group gnus-newsgroup-name)
(not (memq article gnus-newsgroup-unreads)))
;; Mark this article as read in this group.
- (push (cons to-article gnus-read-mark) gnus-newsgroup-reads)
+ (push (cons to-article gnus-read-mark)
+ gnus-newsgroup-reads)
;; Increase the active status of this group.
(setcdr (gnus-active to-group) to-article)
- (setcdr gnus-newsgroup-active to-article))
+ (setcdr gnus-newsgroup-active to-article))
(while marks
(when (eq (gnus-article-mark-to-type (cdar marks)) 'list)
;; If the other group is the same as this group,
;; then we have to add the mark to the list.
(when (equal to-group gnus-newsgroup-name)
- (set (intern (format "gnus-newsgroup-%s" (caar marks)))
+ (set (intern (format "gnus-newsgroup-%s"
+ (caar marks)))
(cons to-article
(symbol-value
(intern (format "gnus-newsgroup-%s"
to-newsgroup
select-method))
- ;;;!!!Why is this necessary?
+ ;;;!!!Why is this necessary?
(set-buffer gnus-summary-buffer)
(when (eq action 'move)
(gnus-summary-position-point)
(gnus-set-mode-line 'summary)))
+(defun gnus-summary-push-marks-to-backend (article)
+ (let ((set nil)
+ (marks gnus-article-mark-lists))
+ (unless (memq article gnus-newsgroup-unreads)
+ (push 'read set))
+ (while marks
+ (when (and (eq (gnus-article-mark-to-type (cdar marks)) 'list)
+ (memq article (symbol-value
+ (intern (format "gnus-newsgroup-%s"
+ (caar marks))))))
+ (push (cdar marks) set))
+ (pop marks))
+ (gnus-request-set-mark gnus-newsgroup-name `(((,article) set ,set)))))
+
(defun gnus-summary-copy-article (&optional n to-newsgroup select-method)
"Copy the current article to some other group.
If TO-NEWSGROUP is string, do not prompt for a newsgroup to copy to.
latter case, they will be copied into the relevant groups."
(interactive
(list current-prefix-arg
- (let* ((methods (gnus-methods-using 'respool))
+ (let* ((methods (mapcar #'car (gnus-methods-using 'respool)))
(methname
(symbol-name (or gnus-summary-respool-default-method
(car (gnus-find-method-for-group
;; 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))
+ (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)))
"Make edits to the current article permanent."
(interactive)
(save-excursion
- ;; The buffer restriction contains the entire article if it exists.
+ ;; The buffer restriction contains the entire article if it exists.
(when (article-goto-body)
(let ((lines (count-lines (point) (point-max)))
(length (- (point-max) (point)))
(delete-region (match-beginning 1) (match-end 1))
(insert (number-to-string lines))))))
;; Replace the article.
- (let ((buf (current-buffer)))
+ (let ((buf (current-buffer))
+ (article (cdr gnus-article-current))
+ replace-result)
(with-temp-buffer
(insert-buffer-substring buf)
-
(if (and (not read-only)
- (not (gnus-request-replace-article
- (cdr gnus-article-current) (car gnus-article-current)
- (current-buffer) t)))
+ (not (setq replace-result
+ (gnus-request-replace-article
+ article (car gnus-article-current)
+ (current-buffer) t))))
(error "Couldn't replace article")
+ ;; If we got a number back, then that's the new article number
+ ;; for this article. Otherwise, the article number didn't change.
+ (when (numberp replace-result)
+ (with-current-buffer gnus-summary-buffer
+ (setq gnus-newsgroup-limit (delq article gnus-newsgroup-limit))
+ (gnus-summary-limit gnus-newsgroup-limit)
+ (setq article replace-result)
+ (gnus-summary-goto-subject article t)))
;; Update the summary buffer.
(if (and references
(equal (message-tokenize-header references " ")
(point-min) (point-max)))
header)
(with-temp-buffer
- (insert (format "211 %d Article retrieved.\n"
- (cdr gnus-article-current)))
+ (insert (format "211 %d Article retrieved.\n" article))
(insert head)
(insert ".\n")
(let ((nntp-server-buffer (current-buffer)))
- (setq header (car (gnus-get-newsgroup-headers
- nil t))))
+ (setq header (car (gnus-get-newsgroup-headers nil t))))
(with-current-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)
- (if (gnus-summary-goto-subject
- (cdr gnus-article-current) nil t)
- (gnus-summary-update-secondary-mark
- (cdr gnus-article-current))))))))
+ (gnus-data-set-header (gnus-data-find article) header)
+ (gnus-summary-update-article-line article header)
+ (if (gnus-summary-goto-subject article nil t)
+ (gnus-summary-update-secondary-mark article)))))))
;; Update threads.
(set-buffer (or buffer gnus-summary-buffer))
- (gnus-summary-update-article (cdr gnus-article-current))
- (if (gnus-summary-goto-subject (cdr gnus-article-current) nil t)
- (gnus-summary-update-secondary-mark
- (cdr gnus-article-current))))
+ (gnus-summary-update-article article)
+ (if (gnus-summary-goto-subject article nil t)
+ (gnus-summary-update-secondary-mark article)))
;; Prettify the article buffer again.
(unless no-highlight
(with-current-buffer gnus-article-buffer
- ;;;!!! Fix this -- article should be rehighlighted.
- ;;;(gnus-run-hooks 'gnus-article-display-hook)
+ ;;!!! Fix this -- article should be rehighlighted.
+ ;;(gnus-run-hooks 'gnus-article-display-hook)
(set-buffer gnus-original-article-buffer)
(gnus-request-article
- (cdr gnus-article-current)
- (car gnus-article-current) (current-buffer))))
+ article (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))))))
(not (equal gnus-newsgroup-name (car gnus-article-current))))
(error "No current article selected"))
;; Remove old bookmark, if one exists.
- (gnus-pull article gnus-newsgroup-bookmarks)
+ (gnus-alist-pull article gnus-newsgroup-bookmarks)
;; Set the new bookmark, which is on the form
;; (article-number . line-number-in-body).
(push
;; Remove old bookmark, if one exists.
(if (not (assq article gnus-newsgroup-bookmarks))
(gnus-message 6 "No bookmark in current article.")
- (gnus-pull article gnus-newsgroup-bookmarks)
+ (gnus-alist-pull article gnus-newsgroup-bookmarks)
(gnus-message 6 "Removed bookmark.")))
;; Suggested by Daniel Quinlan <quinlan@best.com>.
(setq gnus-newsgroup-unreads
(gnus-add-to-sorted-list gnus-newsgroup-unreads
article))))
- (gnus-pull article gnus-newsgroup-reads)
+ (gnus-alist-pull article gnus-newsgroup-reads)
;; See whether the article is to be put in the cache.
(and gnus-use-cache
(t
(setq gnus-newsgroup-unreads
(gnus-add-to-sorted-list gnus-newsgroup-unreads article))))
- (gnus-pull article gnus-newsgroup-reads)
+ (gnus-alist-pull article gnus-newsgroup-reads)
t)))
-(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 "Emacs 20.4")
(defun gnus-summary-tick-article-forward (n)
"Tick N articles forwards.
If N is negative, tick backwards instead.
(interactive "p")
(gnus-summary-mark-forward n gnus-ticked-mark))
-(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 "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."
(interactive "p")
(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 "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.
(mail-header-subject (gnus-data-header (car data)))))
(t nil)))
(end-point (save-excursion
+ (goto-char (gnus-data-pos (car data)))
(if (gnus-summary-go-to-next-thread)
(point) (point-max))))
articles)
gnus-summary-save-parts-default-mime)
'gnus-summary-save-parts-type-history)
(setq gnus-summary-save-parts-last-directory
- (read-file-name "Save to directory: "
- gnus-summary-save-parts-last-directory
- nil t))
+ (read-directory-name "Save to directory: "
+ gnus-summary-save-parts-last-directory
+ nil t))
current-prefix-arg))
(gnus-summary-iterate n
(let ((gnus-display-mime-function nil)
(save-excursion
(let (setmarkundo)
;; Propagate the read marks to the backend.
- (when (and gnus-propagate-marks
+ (when (and (or gnus-propagate-marks
+ (gnus-method-option-p
+ (gnus-find-method-for-group group)
+ 'server-marks))
(gnus-check-backend-function 'request-set-mark group))
(let ((del (gnus-remove-from-range (gnus-info-read info) read))
(add (gnus-remove-from-range read (gnus-info-read info))))
projects / gnus / blobdiff