;;; gnus-sum.el --- summary mode commands for Gnus
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004
;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
(autoload 'gnus-cache-write-active "gnus-cache")
(autoload 'gnus-mailing-list-insinuate "gnus-ml" nil t)
(autoload 'turn-on-gnus-mailing-list-mode "gnus-ml" nil t)
+(autoload 'gnus-pick-line-number "gnus-salt" nil t)
(autoload 'mm-uu-dissect "mm-uu")
(autoload 'gnus-article-outlook-deuglify-article "deuglify"
"Deuglify broken Outlook (Express) articles and redisplay."
(cons :value ("" "") regexp (repeat string))
(sexp :value nil))))
+(defcustom gnus-move-group-prefix-function 'gnus-group-real-prefix
+ "Function used to compute default prefix for article move/copy/etc prompts.
+The function should take one argument, a group name, and return a
+string with the suggested prefix."
+ :group 'gnus-summary-mail
+ :type 'function)
+
(defcustom gnus-unread-mark ? ;Whitespace
"*Mark used for unread articles."
:group 'gnus-summary-marks
:group 'gnus-score-default
:type 'integer)
+(defun gnus-widget-reversible-match (widget value)
+ "Ignoring WIDGET, convert VALUE to internal form.
+VALUE should have the form `FOO' or `(not FOO)', where FOO is an symbol."
+ ;; (debug value)
+ (or (symbolp value)
+ (and (listp value)
+ (eq (length value) 2)
+ (eq (nth 0 value) 'not)
+ (symbolp (nth 1 value)))))
+
+(defun gnus-widget-reversible-to-internal (widget value)
+ "Ignoring WIDGET, convert VALUE to internal form.
+VALUE should have the form `FOO' or `(not FOO)', where FOO is an atom.
+FOO is converted to (FOO nil) and (not FOO) is converted to (FOO t)."
+ ;; (debug value)
+ (if (atom value)
+ (list value nil)
+ (list (nth 1 value) t)))
+
+(defun gnus-widget-reversible-to-external (widget value)
+ "Ignoring WIDGET, convert VALUE to external form.
+VALUE should have the form `(FOO nil)' or `(FOO t)', where FOO is an atom.
+\(FOO nil) is converted to FOO and (FOO t) is converted to (not FOO)."
+ ;; (debug value)
+ (if (nth 1 value)
+ (list 'not (nth 0 value))
+ (nth 0 value)))
+
+(define-widget 'gnus-widget-reversible 'group
+ "A `group' that convert values."
+ :match 'gnus-widget-reversible-match
+ :value-to-internal 'gnus-widget-reversible-to-internal
+ :value-to-external 'gnus-widget-reversible-to-external)
+
+
(defcustom gnus-article-sort-functions '(gnus-article-sort-by-number)
"*List of functions used for sorting articles in the summary buffer.
very similar. (Sorting by date means sorting by the time the message
was sent, sorting by number means sorting by arrival time.)
+Each item can also be a list `(not F)' where F is a function;
+this reverses the sort order.
+
Ready-made functions include `gnus-article-sort-by-number',
`gnus-article-sort-by-author', `gnus-article-sort-by-subject',
`gnus-article-sort-by-date', `gnus-article-sort-by-random'
When threading is turned on, the variable `gnus-thread-sort-functions'
controls how articles are sorted."
:group 'gnus-summary-sort
- :type '(repeat (choice (function-item gnus-article-sort-by-number)
- (function-item gnus-article-sort-by-author)
- (function-item gnus-article-sort-by-subject)
- (function-item gnus-article-sort-by-date)
- (function-item gnus-article-sort-by-score)
- (function-item gnus-article-sort-by-random)
- (function :tag "other"))))
+ :type '(repeat (gnus-widget-reversible
+ (choice (function-item gnus-article-sort-by-number)
+ (function-item gnus-article-sort-by-author)
+ (function-item gnus-article-sort-by-subject)
+ (function-item gnus-article-sort-by-date)
+ (function-item gnus-article-sort-by-score)
+ (function-item gnus-article-sort-by-random)
+ (function :tag "other"))
+ (boolean :tag "Reverse order"))))
+
(defcustom gnus-thread-sort-functions '(gnus-thread-sort-by-number)
"*List of functions used for sorting threads in the summary buffer.
very similar. (Sorting by date means sorting by the time the message
was sent, sorting by number means sorting by arrival time.)
+Each list item can also be a list `(not F)' where F is a
+function; this specifies reversed sort order.
+
Ready-made functions include `gnus-thread-sort-by-number',
`gnus-thread-sort-by-author', `gnus-thread-sort-by-subject',
`gnus-thread-sort-by-date', `gnus-thread-sort-by-score',
When threading is turned off, the variable
`gnus-article-sort-functions' controls how articles are sorted."
:group 'gnus-summary-sort
- :type '(repeat (choice (function-item gnus-thread-sort-by-number)
- (function-item gnus-thread-sort-by-author)
- (function-item gnus-thread-sort-by-subject)
- (function-item gnus-thread-sort-by-date)
- (function-item gnus-thread-sort-by-score)
- (function-item gnus-thread-sort-by-total-score)
- (function-item gnus-thread-sort-by-random)
- (function :tag "other"))))
+ :type '(repeat
+ (gnus-widget-reversible
+ (choice (function-item gnus-thread-sort-by-number)
+ (function-item gnus-thread-sort-by-author)
+ (function-item gnus-thread-sort-by-subject)
+ (function-item gnus-thread-sort-by-date)
+ (function-item gnus-thread-sort-by-score)
+ (function-item gnus-thread-sort-by-most-recent-number)
+ (function-item gnus-thread-sort-by-most-recent-date)
+ (function-item gnus-thread-sort-by-random)
+ (function-item gnus-thread-sort-by-total-score)
+ (function :tag "other"))
+ (boolean :tag "Reverse order"))))
(defcustom gnus-thread-score-function '+
"*Function used for calculating the total score of a thread.
"Function called to sort the articles within a thread after it has been gathered together.")
(defvar gnus-summary-save-parts-type-history nil)
-(defvar gnus-summary-save-parts-last-directory nil)
+(defvar gnus-summary-save-parts-last-directory mm-default-directory)
;; Avoid highlighting in kill files.
(defvar gnus-summary-inhibit-highlight nil)
(?\< (make-string (max 0 (- 20 gnus-tmp-level)) ? ) ?s)
(?i gnus-tmp-score ?d)
(?z gnus-tmp-score-char ?c)
- (?l (bbb-grouplens-score gnus-tmp-header) ?s)
(?V (gnus-thread-total-score (and (boundp 'thread) (car thread))) ?d)
(?U gnus-tmp-unread ?c)
(?f (gnus-summary-from-or-to-or-newsgroups gnus-tmp-header gnus-tmp-from)
(defvar gnus-newsgroup-variables nil
"A list of variables that have separate values in different newsgroups.
A list of newsgroup (summary buffer) local variables, or cons of
-variables and their default values (when the default values are not
-nil), that should be made global while the summary buffer is active.
+variables and their default expressions to be evalled (when the default
+values are not nil), that should be made global while the summary buffer
+is active.
+
+Note: The default expressions will be evaluated (using function `eval')
+before assignment to the local variable rather than just assigned to it.
+If the default expression is the symbol `global', that symbol will not
+be evaluated but the global value of the local variable will be used
+instead.
+
These variables can be used to set variables in the group parameters
-while still allowing them to affect operations done in other
-buffers. For example:
+while still allowing them to affect operations done in other buffers.
+For example:
\(setq gnus-newsgroup-variables
'(message-use-followup-to
"c" gnus-summary-limit-exclude-childless-dormant
"C" gnus-summary-limit-mark-excluded-as-read
"o" gnus-summary-insert-old-articles
- "N" gnus-summary-insert-new-articles)
+ "N" gnus-summary-insert-new-articles
+ "r" gnus-summary-limit-to-replied)
(gnus-define-keys (gnus-summary-goto-map "G" gnus-summary-mode-map)
"n" gnus-summary-next-unread-article
"q" gnus-article-de-quoted-unreadable
"6" gnus-article-de-base64-unreadable
"Z" gnus-article-decode-HZ
+ "A" gnus-article-treat-ansi-sequences
"h" gnus-article-wash-html
"u" gnus-article-unsplit-urls
"s" gnus-summary-force-verify-and-decrypt
:active (not (gnus-group-read-only-p))
,@(if (featurep 'xemacs) nil
'(:help "Encrypt the message body on disk"))]
- ["Extract all parts" gnus-summary-save-parts t]
+ ["Extract all parts..." gnus-summary-save-parts t]
("Multipart"
["Repair multipart" gnus-summary-repair-multipart t]
- ["Pipe part" gnus-article-pipe-part t]
+ ["Pipe part..." gnus-article-pipe-part t]
["Inline part" gnus-article-inline-part t]
["Encrypt body" gnus-article-encrypt-body
:active (not (gnus-group-read-only-p))
,@(if (featurep 'xemacs) nil
'(:help "Encrypt the message body on disk"))]
["View part externally" gnus-article-view-part-externally t]
- ["View part with charset" gnus-article-view-part-as-charset t]
+ ["View part with charset..." gnus-article-view-part-as-charset t]
["Copy part" gnus-article-copy-part t]
- ["Save part" gnus-article-save-part t]
+ ["Save part..." gnus-article-save-part t]
["View part" gnus-article-view-part t]))
("Date"
["Local" gnus-article-date-local t]
["Word wrap" gnus-article-fill-cited-article t]
["Fill long lines" gnus-article-fill-long-lines t]
["Capitalize sentences" gnus-article-capitalize-sentences t]
- ["CR" gnus-article-remove-cr t]
+ ["Remove CR" gnus-article-remove-cr t]
["Quoted-Printable" gnus-article-de-quoted-unreadable t]
["Base64" gnus-article-de-base64-unreadable t]
["Rot 13" gnus-summary-caesar-message
["Unfold headers" gnus-article-treat-unfold-headers t]
["Fold newsgroups" gnus-article-treat-fold-newsgroups t]
["Html" gnus-article-wash-html t]
- ["URLs" gnus-article-unsplit-urls t]
+ ["Unsplit URLs" gnus-article-unsplit-urls t]
["Verify X-PGP-Sig" gnus-article-verify-x-pgp-sig t]
- ["HZ" gnus-article-decode-HZ t]
+ ["Decode HZ" gnus-article-decode-HZ t]
+ ["ANSI sequences" gnus-article-treat-ansi-sequences t]
("(Outlook) Deuglify"
["Unwrap lines" gnus-article-outlook-unwrap-lines t]
["Repair attribution" gnus-article-outlook-repair-attribution t]
gnus-article-outlook-deuglify-article t])
)
("Output"
- ["Save in default format" gnus-summary-save-article
+ ["Save in default format..." gnus-summary-save-article
,@(if (featurep 'xemacs) '(t)
'(:help "Save article using default method"))]
- ["Save in file" gnus-summary-save-article-file
+ ["Save in file..." gnus-summary-save-article-file
,@(if (featurep 'xemacs) '(t)
'(:help "Save article in file"))]
- ["Save in Unix mail format" gnus-summary-save-article-mail t]
- ["Save in MH folder" gnus-summary-save-article-folder t]
- ["Save in VM folder" gnus-summary-save-article-vm t]
- ["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]
+ ["Save in Unix mail format..." gnus-summary-save-article-mail t]
+ ["Save in MH folder..." gnus-summary-save-article-folder t]
+ ["Save in VM folder..." gnus-summary-save-article-vm t]
+ ["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 with Muttprint..." gnus-summary-muttprint t]
["Print" gnus-summary-print-article t])
("Backend"
["Respool article..." gnus-summary-respool-article t]
["Display Predicate" gnus-summary-limit-to-display-predicate t]
["Unread" gnus-summary-limit-to-unread t]
["Unseen" gnus-summary-limit-to-unseen t]
+ ["Replied" gnus-summary-limit-to-replied t]
["Non-dormant" gnus-summary-limit-exclude-dormant t]
["Next articles" gnus-summary-limit-to-articles t]
["Pop limit" gnus-summary-pop-limit t]
'gnus-summary-save-article "save-art" gnus-summary-mode-map)
(tool-bar-add-item-from-menu
'gnus-uu-post-news "uu-post" gnus-summary-mode-map)
+ (tool-bar-add-item-from-menu
+ 'gnus-uu-post-news "uu-post" gnus-summary-mode-map)
(tool-bar-add-item-from-menu
'gnus-summary-catchup "catchup" gnus-summary-mode-map)
(tool-bar-add-item-from-menu
respectively.
You can also post articles and send mail from this buffer. To
-follow up an article, type `\\[gnus-summary-followup]'. To mail a reply to the author
+follow up an article, type `\\[gnus-summary-followup]'. To mail a reply to the author
of an article, type `\\[gnus-summary-reply]'.
There are approx. one gazillion commands you can execute in this
(make-local-variable 'minor-mode-alist)
(use-local-map gnus-summary-mode-map)
(buffer-disable-undo)
- (setq buffer-read-only t) ;Disable modification
+ (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 `...'
(push (eval (car locals)) vlist))
(setq locals (cdr locals)))
(setq vlist (nreverse vlist)))
- (save-excursion
- (set-buffer gnus-group-buffer)
+ (with-current-buffer gnus-group-buffer
(setq gnus-newsgroup-name name
gnus-newsgroup-marked marked
gnus-newsgroup-spam-marked spam
; Is it really necessary to do this next part for each summary line?
; Luckily, doesn't seem to slow things down much.
(mail-parse-ignored-charsets
- (save-excursion (set-buffer gnus-summary-buffer)
- gnus-newsgroup-ignored-charsets)))
+ (with-current-buffer gnus-summary-buffer
+ gnus-newsgroup-ignored-charsets)))
(or
(and gnus-ignored-from-addresses
(string-match gnus-ignored-from-addresses gnus-tmp-from)
(setq heads nil)))))
gnus-newsgroup-dependencies)))
+(defsubst gnus-remove-odd-characters (string)
+ "Translate STRING into something that doesn't contain weird characters."
+ (mm-subst-char-in-string
+ ?\r ?\-
+ (mm-subst-char-in-string ?\n ?\- string t) t))
+
;; This function has to be called with point after the article number
;; on the beginning of the line.
(defsubst gnus-nov-parse-line (number dependencies &optional force-new)
- (let ((eol (gnus-point-at-eol))
+ (let ((eol (point-at-eol))
(buffer (current-buffer))
header references in-reply-to)
(make-full-mail-header
number ; number
(condition-case () ; subject
- (funcall gnus-decode-encoded-word-function
- (setq x (nnheader-nov-field)))
+ (gnus-remove-odd-characters
+ (funcall gnus-decode-encoded-word-function
+ (setq x (nnheader-nov-field))))
(error x))
(condition-case () ; from
- (funcall gnus-decode-encoded-word-function
- (setq x (nnheader-nov-field)))
+ (gnus-remove-odd-characters
+ (funcall gnus-decode-encoded-word-function
+ (setq x (nnheader-nov-field))))
(error x))
(nnheader-nov-field) ; date
(nnheader-nov-read-message-id) ; id
(setq article (read (current-buffer))
header (gnus-nov-parse-line article dependencies)))
(when header
- (save-excursion
- (set-buffer gnus-summary-buffer)
+ (with-current-buffer gnus-summary-buffer
(push header gnus-newsgroup-headers)
(if (memq (setq article (mail-header-number header))
gnus-newsgroup-unselected)
(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 old-pos (point-at-bol))
(setq current (save-excursion
(and (re-search-backward "[\r\n]" nil t)
(gnus-summary-article-number))))
(gnus-summary-show-thread)
(gnus-data-remove
number
- (- (gnus-point-at-bol)
+ (- (point-at-bol)
(prog1
- (1+ (gnus-point-at-eol))
+ (1+ (point-at-eol))
(gnus-delete-line)))))))
(defun gnus-sort-threads-1 (threads func)
gnus-list-identifiers))
changed subject)
(when regexp
+ (setq regexp (concat "^\\(?:R[Ee]: +\\)*\\(" regexp " *\\)"))
(dolist (header gnus-newsgroup-headers)
(setq subject (mail-header-subject header)
changed nil)
- (while (string-match
- (concat "^\\(R[Ee]: +\\)*\\(" regexp " *\\)")
- subject)
+ (while (string-match regexp subject)
(setq subject
- (concat (substring subject 0 (match-beginning 2))
+ (concat (substring subject 0 (match-beginning 1))
(substring subject (match-end 0)))
changed t))
- (when (and changed
- (string-match
- "^\\(\\(R[Ee]: +\\)+\\)R[Ee]: +" subject))
- (setq subject
- (concat (substring subject 0 (match-beginning 1))
- (substring subject (match-end 1)))))
(when changed
+ (when (string-match "^\\(\\(?:R[Ee]: +\\)+\\)R[Ee]: +" subject)
+ (setq subject
+ (concat (substring subject 0 (match-beginning 1))
+ (substring subject (match-end 1)))))
(mail-header-set-subject header subject))))))
(defun gnus-fetch-headers (articles)
"Select newsgroup GROUP.
If READ-ALL is non-nil, all articles in the group are selected.
If SELECT-ARTICLES, only select those articles from GROUP."
- (let* ((entry (gnus-gethash group gnus-newsrc-hashtb))
+ (let* ((entry (gnus-group-entry group))
;;!!! Dirty hack; should be removed.
(gnus-summary-ignore-duplicates
(if (eq (car (gnus-find-method-for-group group)) 'nnvirtual)
group (gnus-status-message group)))
(when gnus-agent
- ;; The agent may be storing articles that are no longer in the
- ;; server's active range. If that is the case, the active range
- ;; needs to be expanded such that the agent's articles can be
- ;; included in the summary.
- (let* ((gnus-command-method (gnus-find-method-for-group group))
- (alist (gnus-agent-load-alist group))
- (active (gnus-active group)))
- (if (and (car alist)
- (< (caar alist) (car active)))
- (gnus-set-active group (cons (caar alist) (cdr active)))))
-
+ (gnus-agent-possibly-alter-active group (gnus-active group) info)
+
(setq gnus-summary-use-undownloaded-faces
- (not (gnus-agent-find-parameter
- group
- 'agent-disable-undownloaded-faces))))
+ (gnus-agent-find-parameter
+ group
+ 'agent-enable-undownloaded-faces)))
(setq gnus-newsgroup-name group
gnus-newsgroup-unselected nil
(min (car active))
(max (cdr active))
(types gnus-article-mark-lists)
- marks var articles article mark mark-type)
+ marks var articles article mark mark-type
+ bgn end)
(dolist (marks marked-lists)
(setq mark (car marks)
;; We set the variable according to the type of the marks list,
;; and then adjust the marks to a subset of the active articles.
(cond
- ;; Adjust "simple" lists.
+ ;; Adjust "simple" lists - compressed yet unsorted
((eq mark-type 'list)
- (set var (setq articles (gnus-uncompress-range (cdr marks))))
- (when (memq mark '(tick dormant expire reply save))
- (while articles
- (when (or (< (setq article (pop articles)) min) (> article max))
- (set var (delq article (symbol-value var)))))))
+ ;; Simultaneously uncompress and clip to active range
+ ;; See gnus-uncompress-range for a description of possible marks
+ (let (l lh)
+ (if (not (cadr marks))
+ (set var nil)
+ (setq articles (if (numberp (cddr marks))
+ (list (cdr marks))
+ (cdr marks))
+ lh (cons nil nil)
+ l lh)
+
+ (while (setq article (pop articles))
+ (cond ((consp article)
+ (setq bgn (max (car article) min)
+ end (min (cdr article) max))
+ (while (<= bgn end)
+ (setq l (setcdr l (cons bgn nil))
+ bgn (1+ bgn))))
+ ((and (<= min article)
+ (>= max article))
+ (setq l (setcdr l (cons article nil))))))
+ (set var (cdr lh)))))
;; Adjust assocs.
((eq mark-type 'tuple)
(set var (setq articles (cdr marks)))
(defun gnus-mark-xrefs-as-read (from-newsgroup headers unreads)
"Look through all the headers and mark the Xrefs as read."
(let ((virtual (gnus-virtual-group-p from-newsgroup))
- name entry info xref-hashtb idlist method nth4)
+ name info xref-hashtb idlist method nth4)
(save-excursion
(set-buffer gnus-group-buffer)
(when (setq xref-hashtb
(setq idlist (symbol-value group))
;; Dead groups are not updated.
(and (prog1
- (setq entry (gnus-gethash name gnus-newsrc-hashtb)
- info (nth 2 entry))
+ (setq info (gnus-get-info name))
(when (stringp (setq nth4 (gnus-info-method info)))
(setq nth4 (gnus-server-to-method nth4))))
;; Only do the xrefs if the group has the same
xref-hashtb)))))
(defun gnus-compute-read-articles (group articles)
- (let* ((entry (gnus-gethash group gnus-newsrc-hashtb))
+ (let* ((entry (gnus-group-entry group))
(info (nth 2 entry))
(active (gnus-active group))
ninfo)
(defun gnus-group-make-articles-read (group articles)
"Update the info of GROUP to say that ARTICLES are read."
(let* ((num 0)
- (entry (gnus-gethash group gnus-newsrc-hashtb))
+ (entry (gnus-group-entry group))
(info (nth 2 entry))
(active (gnus-active group))
range)
(when entry
(setq range (gnus-compute-read-articles group articles))
- (save-excursion
- (set-buffer gnus-group-buffer)
+ (with-current-buffer gnus-group-buffer
(gnus-undo-register
`(progn
(gnus-info-set-marks ',info ',(gnus-info-marks info) t)
(let ((cur nntp-server-buffer)
(dependencies
(or dependencies
- (save-excursion (set-buffer gnus-summary-buffer)
- gnus-newsgroup-dependencies)))
+ (with-current-buffer gnus-summary-buffer
+ gnus-newsgroup-dependencies)))
headers id end ref
(mail-parse-charset gnus-newsgroup-charset)
(mail-parse-ignored-charsets
(defun gnus-article-get-xrefs ()
"Fill in the Xref value in `gnus-current-headers', if necessary.
This is meant to be called in `gnus-article-internal-prepare-hook'."
- (let ((headers (save-excursion (set-buffer gnus-summary-buffer)
- gnus-current-headers)))
+ (let ((headers (with-current-buffer gnus-summary-buffer
+ gnus-current-headers)))
(or (not gnus-use-cross-reference)
(not headers)
(and (mail-header-xref headers)
(looking-at "Xref:"))
(search-forward "\nXref:" nil t))
(goto-char (1+ (match-end 0)))
- (setq xref (buffer-substring (point) (gnus-point-at-eol)))
+ (setq xref (buffer-substring (point) (point-at-eol)))
(mail-header-set-xref headers xref)))))))
(defun gnus-summary-insert-subject (id &optional old-header use-old-header)
(goto-char (gnus-data-pos d))
(gnus-data-remove
number
- (- (gnus-point-at-bol)
+ (- (point-at-bol)
(prog1
- (1+ (gnus-point-at-eol))
+ (1+ (point-at-eol))
(gnus-delete-line))))))
(when old-header
(mail-header-set-number header (mail-header-number old-header)))
(defun gnus-summary-best-group (&optional exclude-group)
"Find the name of the best unread group.
If EXCLUDE-GROUP, do not go to this group."
- (save-excursion
- (set-buffer gnus-group-buffer)
+ (with-current-buffer gnus-group-buffer
(save-excursion
(gnus-group-best-unread-group exclude-group))))
(while read
(when first
(while (< first nlast)
- (push first unread)
- (setq first (1+ first))))
+ (setq unread (cons first unread)
+ first (1+ first))))
(setq first (1+ (if (atom (car read)) (car read) (cdar read))))
(setq nlast (if (atom (cadr read)) (cadr read) (caadr read)))
(setq read (cdr read)))))
;; And add the last unread articles.
(while (<= first last)
- (push first unread)
- (setq first (1+ first)))
+ (setq unread (cons first unread)
+ first (1+ first)))
;; Return the list of unread articles.
(delq 0 (nreverse unread))))
(cdr (assq 'dormant marked)))
(cdr (assq 'tick marked))))))
+;; This function returns a sequence of article numbers based on the
+;; difference between the ranges of read articles in this group and
+;; the range of active articles.
+(defun gnus-sequence-of-unread-articles (group)
+ (let* ((read (gnus-info-read (gnus-get-info group)))
+ (active (or (gnus-active group) (gnus-activate-group group)))
+ (last (cdr active))
+ first nlast unread)
+ ;; If none are read, then all are unread.
+ (if (not read)
+ (setq first (car active))
+ ;; If the range of read articles is a single range, then the
+ ;; first unread article is the article after the last read
+ ;; article. Sounds logical, doesn't it?
+ (if (and (not (listp (cdr read)))
+ (or (< (car read) (car active))
+ (progn (setq read (list read))
+ nil)))
+ (setq first (max (car active) (1+ (cdr read))))
+ ;; `read' is a list of ranges.
+ (when (/= (setq nlast (or (and (numberp (car read)) (car read))
+ (caar read)))
+ 1)
+ (setq first (car active)))
+ (while read
+ (when first
+ (push (cons first nlast) unread))
+ (setq first (1+ (if (atom (car read)) (car read) (cdar read))))
+ (setq nlast (if (atom (cadr read)) (cadr read) (caadr read)))
+ (setq read (cdr read)))))
+ ;; And add the last unread articles.
+ (cond ((< first last)
+ (push (cons first last) unread))
+ ((= first last)
+ (push first unread)))
+ ;; Return the sequence of unread articles.
+ (delq 0 (nreverse unread))))
+
;; Various summary commands
(defun gnus-summary-select-article-buffer ()
(setq gnus-newsgroup-killed (list gnus-newsgroup-killed)))
(let ((headers gnus-newsgroup-headers))
;; Set the new ranges of read articles.
- (save-excursion
- (set-buffer gnus-group-buffer)
+ (with-current-buffer gnus-group-buffer
(gnus-undo-force-boundary))
(gnus-update-read-articles
group (gnus-sorted-union
(if (null arg) (not gnus-dead-summary-mode)
(> (prefix-numeric-value arg) 0)))
(when gnus-dead-summary-mode
- (gnus-add-minor-mode
+ (add-minor-mode
'gnus-dead-summary-mode " Dead" gnus-dead-summary-mode-map))))
(defun gnus-deaden-summary ()
;; Kill any previous dead summary buffer.
(when (and gnus-dead-summary
(buffer-name gnus-dead-summary))
- (save-excursion
- (set-buffer gnus-dead-summary)
+ (with-current-buffer gnus-dead-summary
(when gnus-dead-summary-mode
(kill-buffer (current-buffer)))))
;; Make this the current dead summary.
(save-excursion
(when (and (buffer-name buffer)
(not gnus-single-article-buffer))
- (save-excursion
- (set-buffer buffer)
+ (with-current-buffer buffer
(gnus-kill-buffer gnus-article-buffer)
(gnus-kill-buffer gnus-original-article-buffer)))
(cond
(when current-prefix-arg
(completing-read
"FAQ dir: " (and (listp gnus-group-faq-directory)
- (mapcar (lambda (file) (list file))
+ (mapcar 'list
gnus-group-faq-directory))))))
(let (gnus-faq-buffer)
(when (setq gnus-faq-buffer
(gnus-summary-jump-to-group gnus-newsgroup-name))
(let ((cmd last-command-char)
(point
- (save-excursion
- (set-buffer gnus-group-buffer)
+ (with-current-buffer gnus-group-buffer
(point)))
(group
(if (eq gnus-keep-same-level 'best)
(not (gnus-ephemeral-group-p gnus-newsgroup-name)))
(format " (Type %s for %s [%s])"
(single-key-description cmd) group
- (car (gnus-gethash group gnus-newsrc-hashtb)))
+ (gnus-group-unread group))
(format " (Type %s to exit %s)"
(single-key-description cmd)
gnus-newsgroup-name))))
t))
(prog1
(if (and (stringp article)
- (string-match "@" article))
+ (string-match "@\\|%40" article))
(gnus-summary-refer-article article)
(when (stringp article)
(setq article (string-to-number article)))
(if (numberp days)
(progn
(setq days-got t)
- (if (< days 0)
- (progn
- (setq younger (not younger))
- (setq days (* days -1)))))
+ (when (< days 0)
+ (setq younger (not younger))
+ (setq days (* days -1))))
(message "Please enter a number.")
(sleep-for 1)))
(list days younger)))
gnus-duplicate-mark gnus-souped-mark)
'reverse)))
+(defun gnus-summary-limit-to-replied (&optional unreplied)
+ "Limit the summary buffer to replied articles.
+If UNREPLIED (the prefix), limit to unreplied articles."
+ (interactive "P")
+ (if unreplied
+ (gnus-summary-limit
+ (gnus-set-difference gnus-newsgroup-articles
+ gnus-newsgroup-replied))
+ (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)
(and gnus-newsgroup-display
(not (funcall gnus-newsgroup-display)))
;; Check NoCeM things.
- (if (and gnus-use-nocem
- (gnus-nocem-unwanted-article-p
- (mail-header-id (car thread))))
- (progn
- (setq gnus-newsgroup-unreads
- (delq number gnus-newsgroup-unreads))
- t))))
+ (when (and gnus-use-nocem
+ (gnus-nocem-unwanted-article-p
+ (mail-header-id (car thread))))
+ (setq gnus-newsgroup-unreads
+ (delq number gnus-newsgroup-unreads))
+ t)))
;; Nope, invisible article.
0
;; Ok, this article is to be visible, so we add it to the limit
(interactive "sMessage-ID: ")
(when (and (stringp message-id)
(not (zerop (length message-id))))
+ (setq message-id (gnus-replace-in-string message-id " " ""))
;; Construct the correct Message-ID if necessary.
;; Suggested by tale@pawl.rpi.edu.
(unless (string-match "^<" message-id)
(setq message-id (concat "<" message-id)))
(unless (string-match ">$" message-id)
(setq message-id (concat message-id ">")))
+ ;; People often post MIDs from URLs, so unhex it:
+ (unless (string-match "@" message-id)
+ (setq message-id (gnus-url-unhex-string message-id)))
(let* ((header (gnus-id-to-header message-id))
(sparse (and header
(gnus-summary-article-sparse-p
(let* ((name (format "%s-%d"
(gnus-group-prefixed-name
gnus-newsgroup-name (list 'nndoc ""))
- (save-excursion
- (set-buffer gnus-summary-buffer)
+ (with-current-buffer gnus-summary-buffer
gnus-current-article)))
(ogroup gnus-newsgroup-name)
(params (append (gnus-info-params (gnus-get-info ogroup))
(list (cons 'to-group ogroup))
+ (list (cons 'parent-group ogroup))
(list (cons 'save-article-group ogroup))))
(case-fold-search t)
(buf (current-buffer))
;; the wrong guess.
(message-narrow-to-head)
(goto-char (point-min))
- (delete-matching-lines "^\\(Path\\):\\|^From ")
+ (delete-matching-lines "^Path:\\|^From ")
(widen)
(if (setq egroup
(gnus-group-read-ephemeral-group
(gnus-eval-in-buffer-window gnus-article-buffer
(widen)
(goto-char (point-min))
- (when gnus-page-broken
+ (when gnus-break-pages
(gnus-narrow-to-page))))
(defun gnus-summary-end-of-article ()
(widen)
(goto-char (point-max))
(recenter -3)
- (when gnus-page-broken
+ (when gnus-break-pages
+ (when (re-search-backward page-delimiter nil t)
+ (narrow-to-region (match-end 0) (point-max)))
(gnus-narrow-to-page))))
(defun gnus-summary-print-truncate-and-quote (string &optional len)
"[()]" "\\\\\\&"))
(defun gnus-summary-print-article (&optional filename n)
- "Generate and print a PostScript image of the N next (mail) articles.
+ "Generate and print a PostScript image of the process-marked (mail) articles.
-If N is negative, print the N previous articles. If N is nil and articles
-have been marked with the process mark, print these instead.
+If used interactively, print the current article if none are
+process-marked. With prefix arg, prompt the user for the name of the
+file to save in.
+
+When used from Lisp, accept two optional args FILENAME and N. N means
+to print the next N articles. If N is negative, print the N previous
+articles. If N is nil and articles have been marked with the process
+mark, print these instead.
If the optional first argument FILENAME is nil, send the image to the
printer. If FILENAME is a string, save the PostScript image in a file with
(widen)
(if window
(set-window-start window (goto-char (point-min))))
- (setq gnus-page-broken
- (when gnus-break-pages
- (gnus-narrow-to-page)
- t))
+ (if gnus-break-pages
+ (gnus-narrow-to-page)
+ (when (gnus-visual-p 'page-marker)
+ (let ((buffer-read-only nil))
+ (gnus-remove-text-with-property 'gnus-prev)
+ (gnus-remove-text-with-property 'gnus-next))))
(gnus-set-mode-line 'article)))))
(defun gnus-summary-show-all-headers ()
(let ((articles (gnus-summary-work-articles n))
(prefix (if (gnus-check-backend-function
'request-move-article gnus-newsgroup-name)
- (gnus-group-real-prefix gnus-newsgroup-name)
+ (funcall gnus-move-group-prefix-function
+ gnus-newsgroup-name)
""))
(names '((move "Move" "Moving")
(copy "Copy" "Copying")
(t
(let* ((pto-group (gnus-group-prefixed-name
(car art-group) to-method))
- (entry
- (gnus-gethash pto-group gnus-newsrc-hashtb))
- (info (nth 2 entry))
+ (info (gnus-get-info pto-group))
(to-group (gnus-info-group info))
to-marks)
;; Update the group that has been moved to.
;; (article-number . line-number-in-body).
(push
(cons article
- (save-excursion
- (set-buffer gnus-article-buffer)
+ (with-current-buffer gnus-article-buffer
(count-lines
(min (point)
(save-excursion
(defun gnus-summary-update-mark (mark type)
(let ((forward (cdr (assq type gnus-summary-mark-positions)))
(buffer-read-only nil))
- (re-search-backward "[\n\r]" (gnus-point-at-bol) 'move-to-limit)
+ (re-search-backward "[\n\r]" (point-at-bol) 'move-to-limit)
(when forward
(when (looking-at "\r")
(incf forward))
(interactive)
(let ((buffer-read-only nil)
(orig (point))
- (end (gnus-point-at-eol))
+ (end (point-at-eol))
;; Leave point at bol
(beg (progn (beginning-of-line) (point))))
(prog1
(t
(gnus-completing-read-with-default
nil prom
- (mapcar (lambda (el) (list el))
- (nreverse split-name))
+ (mapcar 'list (nreverse split-name))
nil nil nil
'gnus-group-history))))
(to-method (gnus-server-to-method (gnus-group-method to-newsgroup))))
(not (string-match type (mm-handle-media-type handle)))
(string-match type (mm-handle-media-type handle)))
(let ((file (expand-file-name
- (file-name-nondirectory
- (or
- (mail-content-type-get
- (mm-handle-disposition handle) 'filename)
- (concat gnus-newsgroup-name
- "." (number-to-string
- (cdr gnus-article-current)))))
+ (gnus-map-function
+ mm-file-name-rewrite-functions
+ (file-name-nondirectory
+ (or
+ (mail-content-type-get
+ (mm-handle-disposition handle) 'filename)
+ (mail-content-type-get
+ (mm-handle-type handle) 'name)
+ (concat gnus-newsgroup-name
+ "." (number-to-string
+ (cdr gnus-article-current))))))
dir)))
(unless (file-exists-p file)
(mm-save-part-to-file handle file))))))
(lambda (f)
(if (equal f " ")
f
- (mm-quote-arg f)))
+ (shell-quote-argument f)))
files " ")))))
(setq ps (cdr ps)))))
(if (and gnus-view-pseudos (not not-view))
(not (gnus-summary-article-sparse-p (mail-header-number header))))
;; We have found the header.
header
- ;; If this is a sparse article, we have to nix out its
- ;; previous entry in the thread hashtb.
- (when (and header
- (gnus-summary-article-sparse-p (mail-header-number header)))
- (let* ((parent (gnus-parent-id (mail-header-references header)))
- (thread (and parent (gnus-id-to-thread parent))))
- (when thread
- (delq (assq header thread) thread))))
;; We have to really fetch the header to this article.
(save-excursion
(set-buffer nntp-server-buffer)
;; Added by Per Abrahamsen <amanda@iesd.auc.dk>.
(when gnus-summary-selected-face
(save-excursion
- (let* ((beg (gnus-point-at-bol))
- (end (gnus-point-at-eol))
+ (let* ((beg (point-at-bol))
+ (end (point-at-eol))
;; Fix by Mike Dugan <dugan@bucrf16.bu.edu>.
(from (if (get-text-property beg gnus-mouse-face-prop)
beg
(defun gnus-summary-highlight-line ()
"Highlight current line according to `gnus-summary-highlight'."
- (let* ((beg (gnus-point-at-bol))
+ (let* ((beg (point-at-bol))
(article (or (gnus-summary-article-number) gnus-current-article))
(score (or (cdr (assq article
gnus-newsgroup-scored))
(default-high gnus-summary-default-high-score)
(default-low gnus-summary-default-low-score)
(uncached (and gnus-summary-use-undownloaded-faces
- (memq article gnus-newsgroup-undownloaded))))
+ (memq article gnus-newsgroup-undownloaded)
+ (not (memq article gnus-newsgroup-cached)))))
(let ((face (funcall (gnus-summary-highlight-line-0))))
(unless (eq face (get-text-property beg 'face))
(gnus-put-text-property-excluding-characters-with-faces
- beg (gnus-point-at-eol) 'face
+ beg (point-at-eol) 'face
(setq face (if (boundp face) (symbol-value face) face)))
(when gnus-summary-highlight-line-function
(funcall gnus-summary-highlight-line-function article face))))))
(defun gnus-update-read-articles (group unread &optional compute)
"Update the list of read articles in GROUP.
UNREAD is a sorted list."
- (let* ((active (or gnus-newsgroup-active (gnus-active group)))
- (entry (gnus-gethash group gnus-newsrc-hashtb))
- (info (nth 2 entry))
- (prev 1)
- read)
+ (let ((active (or gnus-newsgroup-active (gnus-active group)))
+ (info (gnus-get-info group))
+ (prev 1)
+ read)
(if (or (not info) (not active))
;; There is no info on this group if it was, in fact,
;; killed. Gnus stores no information on killed groups, so
(dolist (buffer (buffer-list))
(when (and (setq buffer (buffer-name buffer))
(string-match "Summary" buffer)
- (save-excursion
- (set-buffer buffer)
+ (with-current-buffer buffer
;; We check that this is, indeed, a summary buffer.
(and (eq major-mode 'gnus-summary-mode)
;; Also make sure this isn't bogus.
(insert "Mime-Version: 1.0\n")
(widen)
(when (search-forward "\n--" nil t)
- (let ((separator (buffer-substring (point) (gnus-point-at-eol))))
+ (let ((separator (buffer-substring (point) (point-at-eol))))
(message-narrow-to-head)
(message-remove-header "Content-Type")
(goto-char (point-max))
(push i new)
(decf i))
(if (not new)
- (message "No gnus is bad news.")
+ (message "No gnus is bad news")
(gnus-summary-insert-articles new)
(setq gnus-newsgroup-unreads
(gnus-sorted-nunion gnus-newsgroup-unreads new))
;; coding: iso-8859-1
;; End:
+;;; arch-tag: 17c6748f-6d00-4d36-bf01-835c42f31235
;;; gnus-sum.el ends here
projects / gnus / blobdiff