;;; gnus-sum.el --- summary mode commands for Gnus
-;; Copyright (C) 1996,97,98,99 Free Software Foundation, Inc.
+;; Copyright (C) 1996, 1997, 1998, 1999, 2000
+;; Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Keywords: news
:type 'string)
(defcustom gnus-summary-goto-unread t
- "*If t, marking commands will go to the next unread article.
-If `never', commands that usually go to the next unread article, will
-go to the next article, whether it is read or not.
-If nil, only the marking commands will go to the next (un)read article."
+ "*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
+the end of an article.
+
+If nil, the marking commands do NOT go to the next unread article
+(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."
:group 'gnus-summary-marks
:link '(custom-manual "(gnus)Setting Marks")
:type '(choice (const :tag "off" nil)
(cons :value ("" "") regexp (repeat string))
(sexp :value nil))))
-(defcustom gnus-unread-mark ? ;Whitespace
+(defcustom gnus-unread-mark ? ;Whitespace
"*Mark used for unread articles."
:group 'gnus-summary-marks
:type 'character)
:group 'gnus-summary-marks
:type 'character)
-(defcustom gnus-empty-thread-mark ? ;Whitespace
+(defcustom gnus-empty-thread-mark ? ;Whitespace
"*There is no thread under the article."
:group 'gnus-summary-marks
:type 'character)
:type 'hook)
(defcustom gnus-exit-group-hook nil
- "*A hook called when exiting (not quitting) summary mode."
+ "*A hook called when exiting summary mode.
+This hook is not called from the non-updating exit commands like `Q'."
:group 'gnus-various
:type 'hook)
'(("^hk\\>\\|^tw\\>\\|\\<big5\\>" cn-big5)
("^cn\\>\\|\\<chinese\\>" cn-gb-2312)
("^fj\\>\\|^japan\\>" iso-2022-jp-2)
+ ("^tnn\\>\\|^pin\\>\\|^sci.lang.japan" iso-2022-7bit)
("^relcom\\>" koi8-r)
("^fido7\\>" koi8-r)
("^\\(cz\\|hun\\|pl\\|sk\\|hr\\)\\>" iso-8859-2)
("^israel\\>" iso-8859-1)
("^han\\>" euc-kr)
+ ("^alt.chinese.text.big5\\>" chinese-big5)
+ ("^soc.culture.vietnamese\\>" vietnamese-viqr)
("^\\(comp\\|rec\\|alt\\|sci\\|soc\\|news\\|gnu\\|bofh\\)\\>" iso-8859-1)
(".*" iso-8859-1))
"Alist of regexps (to match group names) and default charsets to be used when reading."
gnus-emphasis-highlight-words)))))
:group 'gnus-summary-visual)
+(defcustom gnus-summary-show-article-charset-alist
+ nil
+ "Alist of number and charset.
+The article will be shown with the charset corresponding to the
+numbered argument.
+For example: ((1 . cn-gb-2312) (2 . big5))."
+ :type '(repeat (cons (number :tag "Argument" 1)
+ (symbol :tag "Charset")))
+ :group 'gnus-charset)
+
+(defcustom gnus-preserve-marks t
+ "Whether marks are preserved when moving, copying and respooling messages."
+ :type 'boolean
+ :group 'gnus-summary-marks)
+
+(defcustom gnus-alter-articles-to-read-function nil
+ "Function to be called to alter the list of articles to be selected."
+ :type 'function
+ :group 'gnus-summary)
+
;;; Internal variables
(defvar gnus-article-mime-handles nil)
(defvar gnus-thread-indent-array nil)
(defvar gnus-thread-indent-array-level gnus-thread-indent-level)
(defvar gnus-sort-gathered-threads-function 'gnus-thread-sort-by-number
- "Function called to sort the articles within a thread after it has
-been gathered together.")
+ "Function called to sort the articles within a thread after it has been gathered together.")
;; Avoid highlighting in kill files.
(defvar gnus-summary-inhibit-highlight nil)
'(mail-decode-encoded-word-string)
"List of methods used to decode encoded words.
-This variable is a list of FUNCTION or (REGEXP . FUNCTION). If item is
-FUNCTION, FUNCTION will be apply to all newsgroups. If item is a
+This variable is a list of FUNCTION or (REGEXP . FUNCTION). If item is
+FUNCTION, FUNCTION will be apply to all newsgroups. If item is a
(REGEXP . FUNCTION), FUNCTION will be only apply to thes newsgroups
whose names match REGEXP.
(eq gnus-newsgroup-name
(car gnus-decode-encoded-word-methods-cache)))
(setq gnus-decode-encoded-word-methods-cache (list gnus-newsgroup-name))
- (mapc '(lambda (x)
- (if (symbolp x)
- (nconc gnus-decode-encoded-word-methods-cache (list x))
- (if (and gnus-newsgroup-name
- (string-match (car x) gnus-newsgroup-name))
- (nconc gnus-decode-encoded-word-methods-cache
- (list (cdr x))))))
+ (mapcar (lambda (x)
+ (if (symbolp x)
+ (nconc gnus-decode-encoded-word-methods-cache (list x))
+ (if (and gnus-newsgroup-name
+ (string-match (car x) gnus-newsgroup-name))
+ (nconc gnus-decode-encoded-word-methods-cache
+ (list (cdr x))))))
gnus-decode-encoded-word-methods))
(let ((xlist gnus-decode-encoded-word-methods-cache))
(pop xlist)
(defsubst gnus-simplify-buffer-fuzzy-step (regexp &optional newtext)
(goto-char (point-min))
(while (re-search-forward regexp nil t)
- (replace-match (or newtext ""))))
+ (replace-match (or newtext ""))))
(defun gnus-simplify-buffer-fuzzy ()
"Simplify string in the buffer fuzzily.
"\M-\C-h" gnus-summary-hide-thread
"\M-\C-f" gnus-summary-next-thread
"\M-\C-b" gnus-summary-prev-thread
+ [(meta down)] gnus-summary-next-thread
+ [(meta up)] gnus-summary-prev-thread
"\M-\C-u" gnus-summary-up-thread
"\M-\C-d" gnus-summary-down-thread
"&" gnus-summary-execute-command
"\C-d" gnus-summary-enter-digest-group
"\M-\C-d" gnus-summary-read-document
"\M-\C-e" gnus-summary-edit-parameters
- "\M-\C-g" gnus-summary-customize-parameters
+ "\M-\C-a" gnus-summary-customize-parameters
"\C-c\C-b" gnus-bug
"*" gnus-cache-enter-article
"\M-*" gnus-cache-remove-article
"c" gnus-article-copy-part
"e" gnus-article-externalize-part
"i" gnus-article-inline-part
- "|" gnus-article-pipe-part)
- )
+ "|" gnus-article-pipe-part))
(defun gnus-summary-make-menu-bar ()
(gnus-turn-off-edit-menu 'summary)
["Add buttons to head" gnus-article-add-buttons-to-head t]
["Stop page breaking" gnus-summary-stop-page-breaking t]
["Verbose header" gnus-summary-verbose-headers t]
- ["Toggle header" gnus-summary-toggle-header t])
+ ["Toggle header" gnus-summary-toggle-header t]
+ ["HZ" gnus-article-decode-HZ t])
("Output"
["Save in default format" gnus-summary-save-article t]
["Save in file" gnus-summary-save-article-file t]
["Mark thread as read" gnus-summary-kill-thread t]
["Lower thread score" gnus-summary-lower-thread t]
["Raise thread score" gnus-summary-raise-thread t]
- ["Rethread current" gnus-summary-rethread-current t]
- ))
+ ["Rethread current" gnus-summary-rethread-current t]))
(easy-menu-define
gnus-summary-post-menu gnus-summary-mode-map ""
(list 'gnus-summary-header
(nth 1 header)))
(list 'quote (nth 1 (car ts)))
- (list 'gnus-score-default nil)
+ (list 'gnus-score-delta-default
+ nil)
(nth 1 (car ps))
t)
t)
(if (or (null gnus-summary-default-score)
(<= (abs (- gnus-tmp-score gnus-summary-default-score))
gnus-summary-zcore-fuzz))
- ? ;Whitespace
+ ? ;Whitespace
(if (< gnus-tmp-score gnus-summary-default-score)
gnus-score-below-mark gnus-score-over-mark)))
(gnus-tmp-replied
(if (or (null gnus-summary-default-score)
(<= (abs (- score gnus-summary-default-score))
gnus-summary-zcore-fuzz))
- ? ;Whitespace
+ ? ;Whitespace
(if (< score gnus-summary-default-score)
gnus-score-below-mark gnus-score-over-mark))
'score))
(let ((gnus-newsgroup-dormant nil))
(gnus-summary-initial-limit show-all))
(gnus-summary-initial-limit show-all))
+ ;; When untreaded, all articles are always shown.
(setq gnus-newsgroup-limit
(mapcar
(lambda (header) (mail-header-number header))
(defun gnus-build-sparse-threads ()
(let ((headers gnus-newsgroup-headers)
+ (mail-parse-charset gnus-newsgroup-charset)
(gnus-summary-ignore-duplicates t)
header references generation relations
subject child end new-child date)
;; fetch the headers for the articles that aren't there. This will
;; build complete threads - if the roots haven't been expired by the
;; server, that is.
- (let (id heads)
+ (let ((mail-parse-charset gnus-newsgroup-charset)
+ id heads)
(mapatoms
(lambda (refs)
(when (not (car (symbol-value refs)))
(setq header
(make-full-mail-header
- number ; number
+ number ; number
(funcall gnus-decode-encoded-word-function
(nnheader-nov-field)) ; subject
(funcall gnus-decode-encoded-word-function
(nnheader-nov-field)) ; from
- (nnheader-nov-field) ; date
+ (nnheader-nov-field) ; date
(nnheader-nov-read-message-id) ; id
- (nnheader-nov-field) ; refs
- (nnheader-nov-read-integer) ; chars
- (nnheader-nov-read-integer) ; lines
+ (nnheader-nov-field) ; refs
+ (nnheader-nov-read-integer) ; chars
+ (nnheader-nov-read-integer) ; lines
(unless (eobp)
- (nnheader-nov-field)) ; misc
- (nnheader-nov-parse-extra)))) ; extra
+ (nnheader-nov-field)) ; misc
+ (nnheader-nov-parse-extra)))) ; extra
(widen))
(defun gnus-build-all-threads ()
"Read all the headers."
(let ((gnus-summary-ignore-duplicates t)
+ (mail-parse-charset gnus-newsgroup-charset)
(dependencies gnus-newsgroup-dependencies)
header article)
(save-excursion
(while (not (eobp))
(ignore-errors
(setq article (read (current-buffer))
- header (gnus-nov-parse-line
- article dependencies)))
+ header (gnus-nov-parse-line article dependencies)))
(when header
(save-excursion
(set-buffer gnus-summary-buffer)
(memq article gnus-newsgroup-expirable)
;; Only insert the Subject string when it's different
;; from the previous Subject string.
- (if (gnus-subject-equal
- (condition-case ()
- (mail-header-subject
- (gnus-data-header
- (cadr
- (gnus-data-find-list
- article
- (gnus-data-list t)))))
- ;; Error on the side of excessive subjects.
- (error ""))
- (mail-header-subject header))
+ (if (and
+ gnus-show-threads
+ (gnus-subject-equal
+ (condition-case ()
+ (mail-header-subject
+ (gnus-data-header
+ (cadr
+ (gnus-data-find-list
+ article
+ (gnus-data-list t)))))
+ ;; Error on the side of excessive subjects.
+ (error ""))
+ (mail-header-subject header)))
""
(mail-header-subject header))
nil (cdr (assq article gnus-newsgroup-scored))
(while thread
(gnus-remove-thread-1 (car thread))
(setq thread (cdr thread))))
- (gnus-summary-show-all-threads)
(gnus-remove-thread-1 thread))))))))
(defun gnus-remove-thread-1 (thread)
(gnus-remove-thread-1 (pop thread)))
(when (setq d (gnus-data-find number))
(goto-char (gnus-data-pos d))
+ (gnus-summary-show-thread)
(gnus-data-remove
number
(- (gnus-point-at-bol)
;; using some other form will lead to serious barfage.
(or (symbolp thread) (signal 'wrong-type-argument '(symbolp thread)))
;; (8% speedup to gnus-summary-prepare, just for fun :-)
- (list 'byte-code "\10\211:\203\17\0\211@;\203\16\0A@@\207" ;
+ (list 'byte-code "\10\211:\203\17\0\211@;\203\16\0A@@\207"
(vector thread) 2))
(defsubst gnus-article-sort-by-number (h1 h2)
(if (or (null gnus-summary-default-score)
(<= (abs (- gnus-tmp-score gnus-summary-default-score))
gnus-summary-zcore-fuzz))
- ? ;Whitespace
+ ? ;Whitespace
(if (< gnus-tmp-score gnus-summary-default-score)
gnus-score-below-mark gnus-score-over-mark))
gnus-tmp-replied
(memq number gnus-newsgroup-processable))))))
(defun gnus-summary-remove-list-identifiers ()
- "Remove list identifiers in `gnus-list-identifiers' from articles in
-the current group."
+ "Remove list identifiers in `gnus-list-identifiers' from articles in the current group."
(let ((regexp (if (stringp gnus-list-identifiers)
gnus-list-identifiers
(mapconcat 'identity gnus-list-identifiers " *\\|"))))
- (when regexp
- (dolist (header gnus-newsgroup-headers)
- (when (string-match (concat "\\(Re: +\\)?\\(" regexp " *\\)")
- (mail-header-subject header))
- (mail-header-set-subject
- header (concat (substring (mail-header-subject header)
- 0 (match-beginning 2))
- (substring (mail-header-subject header)
- (match-end 2)))))))))
+ (dolist (header gnus-newsgroup-headers)
+ (when (string-match (concat "\\(Re: +\\)?\\(" regexp " *\\)")
+ (mail-header-subject header))
+ (mail-header-set-subject
+ header (concat (substring (mail-header-subject header)
+ 0 (match-beginning 2))
+ (substring (mail-header-subject header)
+ (match-end 2))))))))
(defun gnus-select-newsgroup (group &optional read-all select-articles)
"Select newsgroup GROUP.
(gnus-sorted-intersection
gnus-newsgroup-unreads
(gnus-sorted-complement gnus-newsgroup-unreads articles)))
+ (when gnus-alter-articles-to-read-function
+ (setq gnus-newsgroup-unreads
+ (sort
+ (funcall gnus-alter-articles-to-read-function
+ gnus-newsgroup-name gnus-newsgroup-unreads)
+ '<)))
articles)))
(defun gnus-killed-articles (killed articles)
;; Add all marks lists to the list of marks lists.
(while (setq type (pop types))
(setq list (symbol-value
- (setq symbol
- (intern (format "gnus-newsgroup-%s"
- (car type))))))
+ (setq symbol
+ (intern (format "gnus-newsgroup-%s"
+ (car type))))))
(when list
;; Get rid of the entries of the articles that have the
(setq arts (cdr arts)))
(setq list (cdr all)))))
- (or (memq (cdr type) uncompressed)
- (setq list (gnus-compress-sequence (set symbol (sort list '<)) t)))
+ (unless (memq (cdr type) uncompressed)
+ (setq list (gnus-compress-sequence (set symbol (sort list '<)) t)))
- (when (gnus-check-backend-function 'request-set-mark
- gnus-newsgroup-name)
- ;; uncompressed:s are not proper flags (they are cons cells)
- ;; cache is a internal gnus flag
- (unless (memq (cdr type) (cons 'cache uncompressed))
- (let* ((old (cdr (assq (cdr type) (gnus-info-marks info))))
- (del (gnus-remove-from-range (gnus-copy-sequence old) list))
- (add (gnus-remove-from-range (gnus-copy-sequence list) old)))
- (if add
- (push (list add 'add (list (cdr type))) delta-marks))
- (if del
- (push (list del 'del (list (cdr type))) delta-marks)))))
+ (when (gnus-check-backend-function
+ 'request-set-mark gnus-newsgroup-name)
+ ;; uncompressed:s are not proper flags (they are cons cells)
+ ;; cache is a internal gnus flag
+ (unless (memq (cdr type) (cons 'cache uncompressed))
+ (let* ((old (cdr (assq (cdr type) (gnus-info-marks info))))
+ (del (gnus-remove-from-range (gnus-copy-sequence old) list))
+ (add (gnus-remove-from-range
+ (gnus-copy-sequence list) old)))
+ (when add
+ (push (list add 'add (list (cdr type))) delta-marks))
+ (when del
+ (push (list del 'del (list (cdr type))) delta-marks)))))
(when list
- (push (cons (cdr type) list) newmarked)))
+ (push (cons (cdr type) list) newmarked)))
(when delta-marks
(unless (gnus-check-group gnus-newsgroup-name)
headers id end ref
(mail-parse-charset gnus-newsgroup-charset)
(mail-parse-ignored-charsets
- (save-excursion (condition-case nil
- (set-buffer gnus-summary-buffer)
- (error))
- gnus-newsgroup-ignored-charsets)))
+ (save-excursion (condition-case nil
+ (set-buffer gnus-summary-buffer)
+ (error))
+ gnus-newsgroup-ignored-charsets)))
(save-excursion
(set-buffer nntp-server-buffer)
;; Translate all TAB characters into SPACE characters.
(save-restriction
(nnheader-narrow-to-headers)
(goto-char (point-min))
- (when (or (and (eq (downcase (char-after)) ?x)
+ (when (or (and (not (eobp))
+ (eq (downcase (char-after)) ?x)
(looking-at "Xref:"))
(search-forward "\nXref:" nil t))
(goto-char (1+ (match-end 0)))
"Center point in window and redisplay frame.
Also do horizontal recentering."
(interactive "P")
- (when (and gnus-auto-center-summary
+ (when (and nil
+ gnus-auto-center-summary
(not (eq gnus-auto-center-summary 'vertical)))
(gnus-horizontal-recenter))
(recenter n))
displayed, no centering will be performed."
;; Suggested by earle@mahendo.JPL.NASA.GOV (Greg Earle).
;; Recenter only when requested. Suggested by popovich@park.cs.columbia.edu.
+ (interactive)
(let* ((top (cond ((< (window-height) 4) 0)
((< (window-height) 7) 1)
(t (if (numberp gnus-auto-center-summary)
;; whichever is the least.
(set-window-start
window (min bottom (save-excursion
- (forward-line (- top)) (point)))))
+ (forward-line (- top)) (point)))
+ t))
;; Do horizontal recentering while we're at it.
(when (and (get-buffer-window (current-buffer) t)
(not (eq gnus-auto-center-summary 'vertical)))
;; 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 (not (listp (cdr read)))
+ (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))
(key-binding
(read-key-sequence
(substitute-command-keys
- "\\<gnus-summary-mode-map>\\[gnus-summary-universal-argument]"
- ))))
+ "\\<gnus-summary-mode-map>\\[gnus-summary-universal-argument]"))))
'undefined)
(gnus-error 1 "Undefined key")
(save-excursion
(defun gnus-summary-exit (&optional temporary)
"Exit reading current newsgroup, and then return to group selection mode.
-gnus-exit-group-hook is called with no arguments if that value is non-nil."
+`gnus-exit-group-hook' is called with no arguments if that value is non-nil."
(interactive)
(gnus-set-global-variables)
(when (gnus-buffer-live-p gnus-article-buffer)
(gnus-dup-enter-articles))
(when gnus-use-trees
(gnus-tree-close group))
+ (when gnus-use-cache
+ (gnus-cache-write-active))
;; Remove entries for this group.
(nnmail-purge-split-history (gnus-group-real-name group))
;; Make all changes in this group permanent.
(gnus-async-halt-prefetch)
(mapcar 'funcall
(delq 'gnus-summary-expire-articles
- (copy-list gnus-summary-prepare-exit-hook)))
+ (copy-sequence gnus-summary-prepare-exit-hook)))
(when (gnus-buffer-live-p gnus-article-buffer)
(save-excursion
(set-buffer gnus-article-buffer)
(rename-buffer
(concat (substring name 0 (match-beginning 0)) "Dead "
(substring name (match-beginning 0)))
- t))))
+ t)
+ (bury-buffer))))
(defun gnus-kill-or-deaden-summary (buffer)
"Kill or deaden the summary BUFFER."
(if backward
(gnus-summary-find-prev unread)
(gnus-summary-find-next unread)))
- (gnus-summary-show-thread)
- (setq n (1- n)))
+ (unless (zerop (setq n (1- n)))
+ (gnus-summary-show-thread)))
(when (/= 0 n)
(gnus-message 7 "No more%s articles"
(if unread " unread" "")))
(set-buffer gnus-summary-buffer))
(let ((article (or article (gnus-summary-article-number)))
(all-headers (not (not all-headers))) ;Must be T or NIL.
- gnus-summary-display-article-function
- did)
+ gnus-summary-display-article-function)
(and (not pseudo)
(gnus-summary-article-pseudo-p article)
(error "This is a pseudo-article"))
- (prog1
- (save-excursion
- (set-buffer gnus-summary-buffer)
- (if (or (and gnus-single-article-buffer
- (or (null gnus-current-article)
- (null gnus-article-current)
- (null (get-buffer gnus-article-buffer))
- (not (eq article (cdr gnus-article-current)))
- (not (equal (car gnus-article-current)
- gnus-newsgroup-name))))
- (and (not gnus-single-article-buffer)
- (or (null gnus-current-article)
- (not (eq gnus-current-article article))))
- force)
- ;; The requested article is different from the current article.
- (prog1
- (gnus-summary-display-article article all-headers)
- (setq did article)
- (when (or all-headers gnus-show-all-headers)
- (gnus-article-show-all-headers)))
+ (save-excursion
+ (set-buffer gnus-summary-buffer)
+ (if (or (and gnus-single-article-buffer
+ (or (null gnus-current-article)
+ (null gnus-article-current)
+ (null (get-buffer gnus-article-buffer))
+ (not (eq article (cdr gnus-article-current)))
+ (not (equal (car gnus-article-current)
+ gnus-newsgroup-name))))
+ (and (not gnus-single-article-buffer)
+ (or (null gnus-current-article)
+ (not (eq gnus-current-article article))))
+ force)
+ ;; The requested article is different from the current article.
+ (progn
+ (gnus-summary-display-article article all-headers)
(when (or all-headers gnus-show-all-headers)
(gnus-article-show-all-headers))
- 'old))
- (when did
- (gnus-article-set-window-start
- (cdr (assq article gnus-newsgroup-bookmarks)))))))
+ (gnus-article-set-window-start
+ (cdr (assq article gnus-newsgroup-bookmarks)))
+ article)
+ (when (or all-headers gnus-show-all-headers)
+ (gnus-article-show-all-headers))
+ 'old))))
(defun gnus-summary-set-current-mark (&optional current-mark)
"Obsolete function."
(when (and (vectorp (gnus-data-header d))
(setq date (mail-header-date (gnus-data-header d))))
(setq is-younger (time-less-p
- (time-since (date-to-time date))
+ (time-since (condition-case ()
+ (date-to-time date)
+ (error '(0 0))))
cutoff))
(when (if younger-p
is-younger
"Go forwards in the thread until we find an article that we want to display."
(when (or (eq gnus-fetch-old-headers 'some)
(eq gnus-fetch-old-headers 'invisible)
+ (numberp gnus-fetch-old-headers)
(eq gnus-build-sparse-threads 'some)
(eq gnus-build-sparse-threads 'more))
;; Deal with old-fetched headers and sparse threads.
"Cut off all uninteresting articles from the beginning of threads."
(when (or (eq gnus-fetch-old-headers 'some)
(eq gnus-fetch-old-headers 'invisible)
+ (numberp gnus-fetch-old-headers)
(eq gnus-build-sparse-threads 'some)
(eq gnus-build-sparse-threads 'more))
(let ((th threads))
(if (or gnus-inhibit-limiting
(and (null gnus-newsgroup-dormant)
(not (eq gnus-fetch-old-headers 'some))
+ (not (numberp gnus-fetch-old-headers))
(not (eq gnus-fetch-old-headers 'invisible))
(null gnus-summary-expunge-below)
(not (eq gnus-build-sparse-threads 'some))
(zerop children))
;; If this is "fetch-old-headered" and there is no
;; visible children, then we don't want this article.
- (and (eq gnus-fetch-old-headers 'some)
+ (and (or (eq gnus-fetch-old-headers 'some)
+ (numberp gnus-fetch-old-headers))
(gnus-summary-article-ancient-p number)
(zerop children))
;; If this is "fetch-old-headered" and `invisible', then
(gnus-message 5 "Fetching headers for %s...done" gnus-newsgroup-name))
(gnus-summary-limit-include-thread id)))
-(defun gnus-summary-refer-article (message-id &optional arg)
- "Fetch an article specified by MESSAGE-ID.
-If ARG (the prefix), fetch the article using `gnus-refer-article-method'
-or `gnus-select-method', no matter what backend the article comes from."
- (interactive "sMessage-ID: \nP")
+(defun gnus-summary-refer-article (message-id)
+ "Fetch an article specified by MESSAGE-ID."
+ (interactive "sMessage-ID: ")
(when (and (stringp message-id)
(not (zerop (length message-id))))
;; Construct the correct Message-ID if necessary.
(gnus-summary-article-sparse-p
(mail-header-number header))
(memq (mail-header-number header)
- gnus-newsgroup-limit))))
+ gnus-newsgroup-limit)))
+ number)
(cond
;; If the article is present in the buffer we just go to it.
((and header
(when sparse
(gnus-summary-update-article (mail-header-number header)))))
(t
- ;; We fetch the article
- (let ((gnus-override-method
- (cond ((gnus-news-group-p gnus-newsgroup-name)
- gnus-refer-article-method)
- (arg
- (or gnus-refer-article-method gnus-select-method))
- (t nil)))
- number)
- ;; Start the special refer-article method, if necessary.
- (when (and gnus-refer-article-method
- (gnus-news-group-p gnus-newsgroup-name))
- (gnus-check-server gnus-refer-article-method))
- ;; Fetch the header, and display the article.
- (if (setq number (gnus-summary-insert-subject message-id))
+ ;; We fetch the article.
+ (catch 'found
+ (dolist (gnus-override-method (gnus-refer-article-methods))
+ (gnus-check-server gnus-override-method)
+ ;; Fetch the header, and display the article.
+ (when (setq number (gnus-summary-insert-subject message-id))
(gnus-summary-select-article nil nil nil number)
- (gnus-message 3 "Couldn't fetch article %s" message-id))))))))
+ (throw 'found t)))
+ (gnus-message 3 "Couldn't fetch article %s" message-id)))))))
+
+(defun gnus-refer-article-methods ()
+ "Return a list of referrable methods."
+ (cond
+ ;; No method, so we default to current and native.
+ ((null gnus-refer-article-method)
+ (list gnus-current-select-method gnus-select-method))
+ ;; Current.
+ ((eq 'current gnus-refer-article-method)
+ (list gnus-current-select-method))
+ ;; List of select methods.
+ ((not (stringp (cadr gnus-refer-article-method)))
+ (let (out)
+ (dolist (method gnus-refer-article-method)
+ (push (if (eq 'current method)
+ gnus-current-select-method
+ method)
+ out))
+ (nreverse out)))
+ ;; One single select method.
+ (t
+ (list gnus-refer-article-method))))
(defun gnus-summary-edit-parameters ()
"Edit the group parameters of the current group."
(list (cons 'save-article-group ogroup))))
(case-fold-search t)
(buf (current-buffer))
- dig)
+ dig to-address)
(save-excursion
+ (set-buffer gnus-original-article-buffer)
+ ;; Have the digest group inherit the main mail address of
+ ;; the parent article.
+ (when (setq to-address (or (message-fetch-field "reply-to")
+ (message-fetch-field "from")))
+ (setq params (append (list (cons 'to-address to-address)))))
(setq dig (nnheader-set-temp-buffer " *gnus digest buffer*"))
(insert-buffer-substring gnus-original-article-buffer)
;; Remove lines that may lead nndoc to misinterpret the
(require 'gnus-async)
(require 'gnus-art)
(let ((gnus-select-article-hook nil) ;Disable hook.
+ (gnus-article-prepare-hook nil)
(gnus-mark-article-hook nil) ;Inhibit marking as read.
(gnus-use-article-prefetch nil)
(gnus-xmas-force-redisplay nil) ;Inhibit XEmacs redisplay.
(gnus-save-hidden-threads
(gnus-summary-select-article)
(set-buffer gnus-article-buffer)
+ (goto-char (window-point (get-buffer-window (current-buffer))))
(when backward
(forward-line -1))
(while (not found)
(get-buffer-window (current-buffer))
(point))
(forward-line 1)
+ (set-window-point
+ (get-buffer-window (current-buffer))
+ (point))
(set-buffer sum)
(setq point (point)))
;; We didn't find it, so we go to the next article.
(defun gnus-summary-show-article (&optional arg)
"Force re-fetching of the current article.
-If ARG (the prefix) is non-nil, show the raw article without any
-article massaging functions being run."
+If ARG (the prefix) is a number, show the article with the charset
+defined in `gnus-summary-show-article-charset-alist', or the charset
+inputed.
+If ARG (the prefix) is non-nil and not a number, show the raw article
+without any article massaging functions being run."
(interactive "P")
- (if (not arg)
- ;; Select the article the normal way.
- (gnus-summary-select-article nil 'force)
+ (cond
+ ((numberp arg)
+ (let ((gnus-newsgroup-charset
+ (or (cdr (assq arg gnus-summary-show-article-charset-alist))
+ (read-coding-system "Charset: ")))
+ (gnus-newsgroup-ignored-charsets 'gnus-all))
+ (gnus-summary-select-article nil 'force)))
+ ((not arg)
+ ;; Select the article the normal way.
+ (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.
(require 'gnus-async)
gnus-article-prepare-hook
gnus-article-decode-hook
gnus-display-mime-function
- gnus-break-pages
- gnus-visual)
+ gnus-break-pages)
;; Destroy any MIME parts.
(when (gnus-buffer-live-p gnus-article-buffer)
(save-excursion
(set-buffer gnus-article-buffer)
(mm-destroy-parts gnus-article-mime-handles)))
- (gnus-summary-select-article nil 'force)))
+ (gnus-summary-select-article nil 'force))))
(gnus-summary-goto-subject gnus-current-article)
(gnus-summary-position-point))
(let* ((buffer-read-only nil)
(inhibit-point-motion-hooks t)
hidden e)
- (save-restriction
- (article-narrow-to-head)
- (setq hidden (gnus-article-hidden-text-p 'headers)))
+ (setq hidden
+ (if (numberp arg)
+ (>= arg 0)
+ (save-restriction
+ (article-narrow-to-head)
+ (gnus-article-hidden-text-p 'headers))))
(goto-char (point-min))
(when (search-forward "\n\n" nil t)
(delete-region (point-min) (1- (point))))
(save-restriction
(narrow-to-region (point-min) (point))
(article-decode-encoded-words)
- (if (or hidden
- (and (numberp arg) (< arg 0)))
+ (if hidden
(let ((gnus-treat-hide-headers nil)
(gnus-treat-hide-boring-headers nil))
+ (setq gnus-article-wash-types
+ (delq 'headers gnus-article-wash-types))
(gnus-treat-article 'head))
- (gnus-treat-article 'head)))))))
+ (gnus-treat-article 'head)))
+ (gnus-set-mode-line 'article)))))
(defun gnus-summary-show-all-headers ()
"Make all header lines visible."
For this function to work, both the current newsgroup and the
newsgroup that you want to move to have to support the `request-move'
-and `request-accept' functions."
+and `request-accept' functions.
+
+ACTION can be either `move' (the default), `crosspost' or `copy'."
(interactive "P")
(unless action
(setq action 'move))
'request-replace-article gnus-newsgroup-name)))
(error "The current group does not support article editing")))
(let ((articles (gnus-summary-work-articles n))
- (prefix (gnus-group-real-prefix gnus-newsgroup-name))
+ (prefix (if (gnus-check-backend-function
+ 'request-move-article gnus-newsgroup-name)
+ (gnus-group-real-prefix gnus-newsgroup-name)
+ ""))
(names '((move "Move" "Moving")
(copy "Copy" "Copying")
(crosspost "Crosspost" "Crossposting")))
articles prefix))
(set (intern (format "gnus-current-%s-group" action)) to-newsgroup))
(setq to-method (or select-method
- (gnus-group-name-to-method to-newsgroup)))
+ (gnus-server-to-method
+ (gnus-group-method to-newsgroup))))
;; Check the method we are to move this article to...
(unless (gnus-check-backend-function
'request-accept-article (car to-method))
gnus-newsgroup-name)) ; Server
(list 'gnus-request-accept-article
to-newsgroup (list 'quote select-method)
- (not articles) t) ; Accept form
+ (not articles) t) ; Accept form
(not articles))) ; Only save nov last time
;; Copy the article.
((eq action 'copy)
art-group))))))
(cond
((not art-group)
- (gnus-message 1 "Couldn't %s article %s: %s"
- (cadr (assq action names)) article
- (nnheader-get-report (car to-method))))
- ((and (eq art-group 'junk)
- (eq action 'move))
- (gnus-summary-mark-article article gnus-canceled-mark)
- (gnus-message 4 "Deleted article %s" article))
+ (gnus-message 1 "Couldn't %s article %s: %s"
+ (cadr (assq action names)) article
+ (nnheader-get-report (car to-method))))
+ ((eq art-group 'junk)
+ (when (eq action 'move)
+ (gnus-summary-mark-article article gnus-canceled-mark)
+ (gnus-message 4 "Deleted article %s" article)))
(t
(let* ((pto-group (gnus-group-prefixed-name
(car art-group) to-method))
info (gnus-add-to-range (gnus-info-read info)
(list (cdr art-group)))))
- ;; Copy any marks over to the new group.
+ ;; See whether the article is to be put in the cache.
(let ((marks gnus-article-mark-lists)
(to-article (cdr art-group)))
- ;; See whether the article is to be put in the cache.
+ ;; Enter the article into the cache in the new group,
+ ;; if that is required.
(when gnus-use-cache
(gnus-cache-possibly-enter-article
to-group to-article
(memq article gnus-newsgroup-dormant)
(memq article gnus-newsgroup-unreads)))
- (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)
- (setcdr (gnus-active to-group) to-article)
- (setcdr gnus-newsgroup-active to-article))
-
- (while marks
- (when (memq article (symbol-value
- (intern (format "gnus-newsgroup-%s"
- (caar marks)))))
- (push (cdar marks) to-marks)
- ;; 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)))
- (cons to-article
- (symbol-value
- (intern (format "gnus-newsgroup-%s"
- (caar marks)))))))
- ;; Copy the marks to other group.
- (gnus-add-marked-articles
- to-group (cdar marks) (list to-article) info))
- (setq marks (cdr marks)))
-
- (gnus-request-set-mark to-group (list (list (list to-article)
- 'set
- to-marks)))
+ (when gnus-preserve-marks
+ ;; 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)
+ (setcdr (gnus-active to-group) to-article)
+ (setcdr gnus-newsgroup-active to-article))
+
+ (while marks
+ (when (memq article (symbol-value
+ (intern (format "gnus-newsgroup-%s"
+ (caar marks)))))
+ (push (cdar marks) to-marks)
+ ;; 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)))
+ (cons to-article
+ (symbol-value
+ (intern (format "gnus-newsgroup-%s"
+ (caar marks)))))))
+ ;; Copy the marks to other group.
+ (gnus-add-marked-articles
+ to-group (cdar marks) (list to-article) info))
+ (setq marks (cdr marks)))
+
+ (gnus-request-set-mark to-group (list (list (list to-article)
+ 'set
+ to-marks))))
(gnus-dribble-enter
(concat "(gnus-group-set-info '"
(kill-buffer (current-buffer)))))
(defun gnus-summary-article-posted-p ()
- "Say whether the current (mail) article is available from `gnus-select-method' as well.
+ "Say whether the current (mail) article is available from news as well.
This will be the case if the article has both been mailed and posted."
(interactive)
(let ((id (mail-header-references (gnus-summary-article-header)))
- (gnus-override-method
- (or gnus-refer-article-method gnus-select-method)))
+ (gnus-override-method (car (gnus-refer-article-methods))))
(if (gnus-request-head id "")
(gnus-message 2 "The current message was found on %s"
gnus-override-method)
"Mark N articles as read forwards.
If N is negative, mark backwards instead. Mark with MARK, ?r by default.
The difference between N and the actual number of articles marked is
-returned."
+returned.
+Iff NO-EXPIRE, auto-expiry will be inhibited."
(interactive "p")
(gnus-summary-show-thread)
(let ((backward (< n 0))
`??' (dormant) and `?E' (expirable).
If MARK is nil, then the default character `?r' is used.
If ARTICLE is nil, then the article on the current line will be
-marked."
+marked.
+Iff NO-EXPIRE, auto-expiry will be inhibited."
;; The mark might be a string.
(when (stringp mark)
(setq mark (aref mark 0)))
(interactive "P")
(gnus-summary-catchup-and-exit t quietly))
-;; Suggested by "Arne Eofsson" <arne@hodgkin.mbi.ucla.edu>.
(defun gnus-summary-catchup-and-goto-next-group (&optional all)
"Mark all articles in this group as read and select the next group.
If given a prefix, mark all articles, unread as well as ticked, as
(interactive "P")
(save-excursion
(gnus-summary-catchup all))
- (gnus-summary-next-group t nil nil))
+ (gnus-summary-next-group))
;; Thread-based commands.
(subst-char-in-region start (point) ?\n ?\^M)
(gnus-summary-goto-subject article))
(goto-char start)
- nil)
- ;;(gnus-summary-position-point)
- ))))
+ nil)))))
(defun gnus-summary-go-to-next-thread (&optional previous)
"Go to the same level (or less) next thread.
(mapcar (lambda (el) (list el))
(nreverse split-name))
nil nil nil
- 'gnus-group-history)))))
+ 'gnus-group-history))))
+ (to-method (gnus-server-to-method (gnus-group-method to-newsgroup))))
(when to-newsgroup
(if (or (string= to-newsgroup "")
(string= to-newsgroup prefix))
(unless to-newsgroup
(error "No group name entered"))
(or (gnus-active to-newsgroup)
- (gnus-activate-group to-newsgroup)
+ (gnus-activate-group to-newsgroup nil nil to-method)
(if (gnus-y-or-n-p (format "No such group: %s. Create it? "
to-newsgroup))
- (or (and (gnus-request-create-group
- to-newsgroup (gnus-group-name-to-method to-newsgroup))
- (gnus-activate-group to-newsgroup nil nil
- (gnus-group-name-to-method
- to-newsgroup)))
+ (or (and (gnus-request-create-group to-newsgroup to-method)
+ (gnus-activate-group
+ to-newsgroup nil nil to-method)
+ (gnus-subscribe-group to-newsgroup))
(error "Couldn't create group %s" to-newsgroup)))
(error "No such group: %s" to-newsgroup)))
to-newsgroup))
-(defun gnus-summary-save-parts (type dir n reverse)
+(defun gnus-summary-save-parts (type dir n &optional reverse)
"Save parts matching TYPE to DIR.
If REVERSE, save parts that do not match TYPE."
(interactive
(list (read-string "Save parts of type: " "image/.*")
- (read-file-name "Save to directory: " t nil t)
+ (read-file-name "Save to directory: " nil nil t)
current-prefix-arg))
(gnus-summary-iterate n
(let ((gnus-display-mime-function nil)
"Read the headers of article ID and enter them into the Gnus system."
(let ((group gnus-newsgroup-name)
(gnus-override-method
- (and (gnus-news-group-p gnus-newsgroup-name)
- gnus-refer-article-method))
+ (or
+ gnus-override-method
+ (and (gnus-news-group-p gnus-newsgroup-name)
+ (car (gnus-refer-article-methods)))))
where)
;; First we check to see whether the header in question is already
;; fetched.
(gnus-info-set-read ',info ',(gnus-info-read info))
(gnus-get-unread-articles-in-group ',info (gnus-active ,group))
(gnus-group-update-group ,group t))))
- ;; Propagate the read marks to the backend.
- (if (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))))
- (when (or add del)
- (unless (gnus-check-group group)
- (error "Can't open server for %s" group))
- (gnus-request-set-mark
- group (delq nil (list (if add (list add 'add '(read)))
- (if del (list del 'del '(read)))))))))
+ ;; Propagate the read marks to the backend.
+ (if (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))))
+ (when (or add del)
+ (unless (gnus-check-group group)
+ (error "Can't open server for %s" group))
+ (gnus-request-set-mark
+ group (delq nil (list (if add (list add 'add '(read)))
+ (if del (list del 'del '(read)))))))))
;; Enter this list into the group info.
(gnus-info-set-read info read)
;; Set the number of unread articles in gnus-newsrc-hashtb.
"Setup newsgroup default charset."
(if (equal gnus-newsgroup-name "nndraft:drafts")
(setq gnus-newsgroup-charset nil)
- (let* ((name (and gnus-newsgroup-name
- (gnus-group-real-name gnus-newsgroup-name)))
- (ignored-charsets
- (or gnus-newsgroup-ephemeral-ignored-charsets
- (append
- (and gnus-newsgroup-name
- (or (gnus-group-find-parameter gnus-newsgroup-name
- 'ignored-charsets t)
- (let ((alist gnus-group-ignored-charsets-alist)
- elem (charsets nil))
- (while (setq elem (pop alist))
- (when (and name
- (string-match (car elem) name))
- (setq alist nil
- charsets (cdr elem))))
- charsets))))
- gnus-newsgroup-ignored-charsets)))
- (setq gnus-newsgroup-charset
- (or gnus-newsgroup-ephemeral-charset
- (and gnus-newsgroup-name
- (or (gnus-group-find-parameter gnus-newsgroup-name
- 'charset)
- (let ((alist gnus-group-charset-alist)
- elem (charset nil))
- (while (setq elem (pop alist))
- (when (and name
- (string-match (car elem) name))
- (setq alist nil
- charset (cadr elem))))
- charset)))
- gnus-default-charset))
- (set (make-local-variable 'gnus-newsgroup-ignored-charsets)
- ignored-charsets))))
+ (let* ((name (and gnus-newsgroup-name
+ (gnus-group-real-name gnus-newsgroup-name)))
+ (ignored-charsets
+ (or gnus-newsgroup-ephemeral-ignored-charsets
+ (append
+ (and gnus-newsgroup-name
+ (or (gnus-group-find-parameter gnus-newsgroup-name
+ 'ignored-charsets t)
+ (let ((alist gnus-group-ignored-charsets-alist)
+ elem (charsets nil))
+ (while (setq elem (pop alist))
+ (when (and name
+ (string-match (car elem) name))
+ (setq alist nil
+ charsets (cdr elem))))
+ charsets)))
+ gnus-newsgroup-ignored-charsets))))
+ (setq gnus-newsgroup-charset
+ (or gnus-newsgroup-ephemeral-charset
+ (and gnus-newsgroup-name
+ (or (gnus-group-find-parameter gnus-newsgroup-name 'charset)
+ (let ((alist gnus-group-charset-alist)
+ elem charset)
+ (while (setq elem (pop alist))
+ (when (and name
+ (string-match (car elem) name))
+ (setq alist nil
+ charset (cadr elem))))
+ charset)))
+ gnus-default-charset))
+ (set (make-local-variable 'gnus-newsgroup-ignored-charsets)
+ ignored-charsets))))
;;;
;;; Mime Commands
projects / gnus / blobdiff