;;; Code:
-(eval-when-compile (require 'cl))
-(eval-when-compile (require 'gnus-clfns))
+(eval-when-compile
+ (require 'cl)
+ (require 'gnus-clfns)
+ (defvar tool-bar-map))
(require 'gnus)
(require 'gnus-group)
(defcustom gnus-auto-select-next t
"*If non-nil, offer to go to the next group from the end of the previous.
If the value is t and the next newsgroup is empty, Gnus will exit
-summary mode and go back to group mode. If the value is neither nil
-nor t, Gnus will select the following unread newsgroup. In
+summary mode and go back to group mode. If the value is neither nil
+nor t, Gnus will select the following unread newsgroup. In
particular, if the value is the symbol `quietly', the next unread
newsgroup will be selected without any confirmation, and if it is
`almost-quietly', the next group will be selected without any
confirmation if you are located on the last article in the group.
-Finally, if this variable is `slightly-quietly', the `Z n' command
+Finally, if this variable is `slightly-quietly', the `\\<gnus-summary-mode-map>\\[gnus-summary-catchup-and-goto-next-group]' command
will go to the next group without confirmation."
:group 'gnus-summary-maneuvering
:type '(choice (const :tag "off" nil)
:group 'gnus-summary-maneuvering
:type 'boolean)
+(defcustom gnus-auto-goto-ignores 'unfetched
+ "*Says how to handle unfetched articles when maneuvering.
+
+This variable can either be the symbols `nil' (maneuver to any
+article), `undownloaded' (maneuvering while unplugged ignores articles
+that have not been fetched), `always-undownloaded' (maneuvering always
+ignores articles that have not been fetched), `unfetched' (maneuvering
+ignores articles whose headers have not been fetched).
+
+NOTE: The list of unfetched articles will always be nil when plugged
+and, when unplugged, a subset of the undownloaded article list."
+ :group 'gnus-summary-maneuvering
+ :type '(choice (const :tag "None" nil)
+ (const :tag "Undownloaded when unplugged" undownloaded)
+ (const :tag "Undownloaded" always-undownloaded)
+ (const :tag "Unfetched" unfetched)))
+
(defcustom gnus-summary-check-current nil
"*If non-nil, consider the current article when moving.
The \"unread\" movement commands will stay on the same line if the
(integer :tag "height")
(sexp :menu-tag "both" t)))
+(defvar gnus-auto-center-group t
+ "*If non-nil, always center the group buffer.")
+
(defcustom gnus-show-all-headers nil
"*If non-nil, don't hide any headers."
:group 'gnus-article-hiding
integer))
(defcustom gnus-summary-save-parts-default-mime "image/.*"
- "*A regexp to match MIME parts when saving multiple parts of a message
-with gnus-summary-save-parts (X m). This regexp will be used by default
-when prompting the user for which type of files to save."
+ "*A regexp to match MIME parts when saving multiple parts of a
+message with `gnus-summary-save-parts' (\\<gnus-summary-mode-map>\\[gnus-summary-save-parts]).
+This regexp will be used by default when prompting the user for which
+type of files to save."
:group 'gnus-summary
:type 'regexp)
the MIME-Version header is missed."
:version "21.3"
:type 'boolean
- :group 'gnus-article)
+ :group 'gnus-article-mime)
(defcustom gnus-article-emulate-mime t
"If non-nil, use MIME emulation for uuencode and the like.
like uuencoded bits, yEncoded bits, and so on, and present that using
the normal Gnus MIME machinery."
:type 'boolean
- :group 'gnus-article)
+ :group 'gnus-article-mime)
;;; Internal variables
"Sorted list of articles in the current newsgroup that can be processed.")
(defvar gnus-newsgroup-unfetched nil
- "Sorted list of articles in the current newsgroup whose headers have not been fetched into the agent.")
+ "Sorted list of articles in the current newsgroup whose headers have
+not been fetched into the agent.
+
+This list will always be a subset of gnus-newsgroup-undownloaded.")
(defvar gnus-newsgroup-undownloaded nil
- "List of articles in the current newsgroup that haven't been downloaded..")
+ "List of articles in the current newsgroup that haven't been downloaded.")
(defvar gnus-newsgroup-unsendable nil
"List of articles in the current newsgroup that won't be sent.")
")
;; Byte-compiler warning.
-;(eval-when-compile (defvar gnus-article-mode-map))
(eval-when-compile
+ ;; Bind features so that require will believe that gnus-sum has
+ ;; already been loaded (avoids infinite recursion)
(let ((features (cons 'gnus-sum features)))
+ ;; Several of the declarations in gnus-sum are needed to load the
+ ;; following files. Right now, these definitions have been
+ ;; compiled but not defined (evaluated). We could either do a
+ ;; eval-and-compile about all of the declarations or evaluate the
+ ;; source file.
+ (if (boundp 'gnus-newsgroup-variables)
+ nil
+ (load "gnus-sum.el" t t t))
(require 'gnus)
(require 'gnus-agent)
(require 'gnus-art)))
(buffer-string))))
(defsubst gnus-simplify-subject-fully (subject)
- "Simplify a subject string according to gnus-summary-gather-subject-limit."
+ "Simplify a subject string according to `gnus-summary-gather-subject-limit'."
(cond
(gnus-simplify-subject-functions
(gnus-map-function gnus-simplify-subject-functions subject))
(defsubst gnus-subject-equal (s1 s2 &optional simple-first)
"Check whether two subjects are equal.
-If optional argument simple-first is t, first argument is already
+If optional argument SIMPLE-FIRST is t, first argument is already
simplified."
(cond
((null simple-first)
["Crosspost article..." gnus-summary-crosspost-article
(gnus-check-backend-function
'request-replace-article gnus-newsgroup-name)]
- ["Import file..." gnus-summary-import-article t]
- ["Create article..." gnus-summary-create-article t]
+ ["Import file..." gnus-summary-import-article
+ (gnus-check-backend-function
+ 'request-accept-article gnus-newsgroup-name)]
+ ["Create article..." gnus-summary-create-article
+ (gnus-check-backend-function
+ 'request-accept-article gnus-newsgroup-name)]
["Check if posted" gnus-summary-article-posted-p t]
["Edit article" gnus-summary-edit-article
(not (gnus-group-read-only-p))]
(point)
(current-buffer))))))
-(defun gnus-summary-buffer-name (group)
- "Return the summary buffer name of GROUP."
- (concat "*Summary " (gnus-group-decoded-name group) "*"))
-
(defun gnus-summary-setup-buffer (group)
"Initialize summary buffer."
(let ((buffer (gnus-summary-buffer-name group))
(defsubst gnus-summary-line-message-size (head)
"Return pretty-printed version of message size.
This function is intended to be used in
-`gnus-summary-line-format-alist', which see."
+`gnus-summary-line-format-alist'."
(let ((c (or (mail-header-chars head) -1)))
(cond ((< c 0) "n/a") ; chars not available
((< c (* 1000 10)) (format "%1.1fk" (/ c 1024.0)))
(gnus-summary-position-point)
(gnus-configure-windows 'summary 'force)
(gnus-set-mode-line 'summary))
- (when (get-buffer-window gnus-group-buffer t)
+ (when (and gnus-auto-center-group
+ (get-buffer-window gnus-group-buffer t))
;; Gotta use windows, because recenter does weird stuff if
;; the current buffer ain't the displayed window.
(let ((owin (selected-window)))
(substring gnus-tmp-from
(1+ (match-beginning 0)) (1- (match-end 0))))
(t gnus-tmp-from))
+
+ ;; Do the %B string
gnus-tmp-thread-tree-header-string
(cond
((not gnus-show-threads) "")
(error "Couldn't request group %s: %s"
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))))))
+
(setq gnus-newsgroup-name group
gnus-newsgroup-unselected nil
gnus-newsgroup-unreads (gnus-list-of-unread-articles group))
(looking-at "Xref:"))
(search-forward "\nXref:" nil t))
(goto-char (1+ (match-end 0)))
- (setq xref (buffer-substring (point)
- (progn (end-of-line) (point))))
+ (setq xref (buffer-substring (point) (gnus-point-at-eol)))
(mail-header-set-xref headers xref)))))))
(defun gnus-summary-insert-subject (id &optional old-header use-old-header)
(gnus-group-best-unread-group exclude-group))))
(defun gnus-summary-find-next (&optional unread article backward)
- (if backward (gnus-summary-find-prev)
+ (if backward (gnus-summary-find-prev unread article)
(let* ((dummy (gnus-summary-article-intangible-p))
(article (or article (gnus-summary-article-number)))
(data (gnus-data-find-list article))
(progn
(while data
(unless (memq (gnus-data-number (car data))
- gnus-newsgroup-unfetched)
+ (cond ((eq gnus-auto-goto-ignores 'always-undownloaded)
+ gnus-newsgroup-undownloaded)
+ (gnus-plugged
+ nil)
+ ((eq gnus-auto-goto-ignores 'unfetched)
+ gnus-newsgroup-unfetched)
+ ((eq gnus-auto-goto-ignores 'undownloaded)
+ gnus-newsgroup-undownloaded)))
(when (gnus-data-unread-p (car data))
(setq result (car data)
data nil)))
(if unread
(progn
(while data
- (unless (memq (gnus-data-number (car data)) gnus-newsgroup-unfetched)
+ (unless (memq (gnus-data-number (car data))
+ (cond ((eq gnus-auto-goto-ignores 'always-undownloaded)
+ gnus-newsgroup-undownloaded)
+ (gnus-plugged
+ nil)
+ ((eq gnus-auto-goto-ignores 'unfetched)
+ gnus-newsgroup-unfetched)
+ ((eq gnus-auto-goto-ignores 'undownloaded)
+ gnus-newsgroup-undownloaded)))
(when (gnus-data-unread-p (car data))
(setq result (car data)
data nil)))
(> (prefix-numeric-value arg) 0)))
(redraw-display))
-(defun gnus-summary-find-uncancelled ()
- "Return the number of an uncancelled article.
+(defun gnus-summary-find-for-reselect ()
+ "Return the number of an article to stay on across a reselect.
The current article is considered, then following articles, then previous
-articles. If all articles are cancelled then return a dummy 0."
+articles. An article is sought which is not cancelled and isn't a temporary
+insertion from another group. If there's no such then return a dummy 0."
(let (found)
(dolist (rev '(nil t))
(unless found ; don't demand the reverse list if we don't need it
(let ((data (gnus-data-find-list
(gnus-summary-article-number) (gnus-data-list rev))))
(while (and data (not found))
- (if (not (eq gnus-canceled-mark (gnus-data-mark (car data))))
+ (if (and (< 0 (gnus-data-number (car data)))
+ (not (eq gnus-canceled-mark (gnus-data-mark (car data)))))
(setq found (gnus-data-number (car data))))
(setq data (cdr data))))))
(or found 0)))
(interactive "P")
(when (gnus-ephemeral-group-p gnus-newsgroup-name)
(error "Ephemeral groups can't be reselected"))
- (let ((current-subject (gnus-summary-find-uncancelled))
+ (let ((current-subject (gnus-summary-find-for-reselect))
(group gnus-newsgroup-name))
(setq gnus-newsgroup-begin nil)
(gnus-summary-exit)
(interactive)
(let* ((group gnus-newsgroup-name)
(gnus-group-is-exiting-p t)
+ (gnus-group-is-exiting-without-update-p t)
(quit-config (gnus-group-quit-config group)))
(when (or no-questions
gnus-expert-user
(gnus-y-or-n-p "Discard changes to this group and exit? "))
(gnus-async-halt-prefetch)
- (mapcar 'funcall
- (delq 'gnus-summary-expire-articles
- (copy-sequence gnus-summary-prepare-exit-hook)))
+ (run-hooks 'gnus-summary-prepare-exit-hook)
;; If we have several article buffers, we kill them at exit.
(unless gnus-single-article-buffer
(gnus-kill-buffer gnus-article-buffer)
(gnus-summary-clear-local-variables)
(let ((gnus-summary-local-variables gnus-newsgroup-variables))
(gnus-summary-clear-local-variables))
- (when (get-buffer gnus-summary-buffer)
- (kill-buffer gnus-summary-buffer)))
+ (gnus-kill-buffer gnus-summary-buffer))
(unless gnus-single-article-buffer
(setq gnus-article-current nil))
(when gnus-use-trees
(defun gnus-summary-next-group (&optional no-article target-group backward)
"Exit current newsgroup and then select next unread newsgroup.
If prefix argument NO-ARTICLE is non-nil, no article is selected
-initially. If NEXT-GROUP, go to this group. If BACKWARD, go to
+initially. If TARGET-GROUP, go to this group. If BACKWARD, go to
previous group instead."
(interactive "P")
;; Stop pre-fetching.
(let ((current-group gnus-newsgroup-name)
(current-buffer (current-buffer))
entered)
+ ;; First we semi-exit this group to update Xrefs and all variables.
+ ;; We can't do a real exit, because the window conf must remain
+ ;; the same in case the user is prompted for info, and we don't
+ ;; want the window conf to change before that...
(gnus-summary-exit t)
(while (not entered)
;; Then we find what group we are supposed to enter.
(let ((unreads (gnus-group-group-unread)))
(if (and (or (eq t unreads)
(and unreads (not (zerop unreads))))
- (progn
- ;; Now we semi-exit this group to update Xrefs
- ;; and all variables. We can't do a real exit,
- ;; because the window conf must remain the same
- ;; in case the user is prompted for info, and we
- ;; don't want the window conf to change before
- ;; that...
- (when (gnus-buffer-live-p current-buffer)
- (set-buffer current-buffer)
- (gnus-summary-exit t))
- (gnus-summary-read-group
- target-group nil no-article
- (and (buffer-name current-buffer) current-buffer)
- nil backward)))
+ (gnus-summary-read-group
+ target-group nil no-article
+ (and (buffer-name current-buffer) current-buffer)
+ nil backward))
(setq entered t)
(setq current-group target-group
target-group nil)))))))
(gnus-summary-display-article article)
(when article-window
(gnus-eval-in-buffer-window gnus-article-buffer
- (setq endp (gnus-article-next-page lines)))
+ (setq endp (or (gnus-article-next-page lines)
+ (gnus-article-only-boring-p))))
(when endp
(cond (stop
(gnus-message 3 "End of message"))
(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 (gnus-retrieve-headers
- (list (min
- (+ (mail-header-number
- (gnus-summary-article-header))
- limit)
- gnus-newsgroup-end))
- gnus-newsgroup-name (* limit 2))
+ (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 backends that don't support NOV"))
;; 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))
+ (when (and (gnus-check-server gnus-override-method)
+ ;; Fetch the header,
+ (setq number (gnus-summary-insert-subject message-id)))
+ ;; and display the article.
(gnus-summary-select-article nil nil nil number)
(throw 'found t)))
(gnus-message 3 "Couldn't fetch article %s" message-id)))))))
(1- (point))
(point-max))))
(insert-buffer-substring gnus-original-article-buffer s e)
- (article-decode-encoded-words)
+ (run-hooks 'gnus-article-decode-hook)
(if hidden
(let ((gnus-treat-hide-headers nil)
(gnus-treat-hide-boring-headers nil))
(nnheader-get-report (car to-method))))
((eq art-group 'junk)
(when (eq action 'move)
- (let ((id (mail-header-id (gnus-data-header
- (assoc article (gnus-data-list nil))))))
- (gnus-summary-mark-article article gnus-canceled-mark)
- (gnus-message 4 "Deleted article %s" article)
- ;; run the move/copy/crosspost/respool hook
- (run-hook-with-args 'gnus-summary-article-delete-hook
- action id gnus-newsgroup-name nil
- select-method))))
+ (gnus-summary-mark-article article gnus-canceled-mark)
+ (gnus-message 4 "Deleted article %s" article)
+ ;; run the delete hook
+ (run-hook-with-args 'gnus-summary-article-delete-hook
+ action
+ (gnus-data-header
+ (assoc article (gnus-data-list nil)))
+ gnus-newsgroup-name nil
+ select-method)))
(t
(let* ((pto-group (gnus-group-prefixed-name
(car art-group) to-method))
article gnus-newsgroup-name (current-buffer))))
;; run the move/copy/crosspost/respool hook
- (let ((id (mail-header-id (gnus-data-header
- (assoc article (gnus-data-list nil))))))
(run-hook-with-args 'gnus-summary-article-move-hook
- action id gnus-newsgroup-name to-newsgroup
- select-method)))
+ action
+ (gnus-data-header
+ (assoc article (gnus-data-list nil)))
+ gnus-newsgroup-name
+ to-newsgroup
+ select-method))
;;;!!!Why is this necessary?
(set-buffer gnus-summary-buffer)
-
+
(gnus-summary-goto-subject article)
(when (eq action 'move)
(gnus-summary-mark-article article gnus-canceled-mark))))
(defun gnus-summary-expire-articles (&optional now)
"Expire all articles that are marked as expirable in the current group."
(interactive)
- (when (gnus-check-backend-function
- 'request-expire-articles gnus-newsgroup-name)
+ (when (and (not gnus-group-is-exiting-without-update-p)
+ (gnus-check-backend-function
+ 'request-expire-articles gnus-newsgroup-name))
;; This backend supports expiry.
(let* ((total (gnus-group-total-expirable-p gnus-newsgroup-name))
(expirable (if total
(when (and (not (memq article es))
(gnus-data-find article))
(gnus-summary-mark-article article gnus-canceled-mark)
- (let ((id (mail-header-id (gnus-data-header
- (assoc article
- (gnus-data-list nil))))))
- (run-hook-with-args 'gnus-summary-article-expire-hook
- 'delete id gnus-newsgroup-name nil
- nil)))))))
+ (run-hook-with-args 'gnus-summary-article-expire-hook
+ 'delete
+ (gnus-data-header
+ (assoc article (gnus-data-list nil)))
+ gnus-newsgroup-name
+ nil
+ nil))))))
(gnus-message 6 "Expiring articles...done")))))
(defun gnus-summary-expire-articles-now ()
t)
(defun gnus-summary-update-download-mark (article)
- "Update the secondary (read, process, cache) mark."
+ "Update the download mark."
(gnus-summary-update-mark
(cond ((memq article gnus-newsgroup-undownloaded)
gnus-undownloaded-mark)
(interactive)
(let ((buffer-read-only nil)
(orig (point))
- ;; first goto end then to beg, to have point at beg after let
- (end (progn (end-of-line) (point)))
+ (end (gnus-point-at-eol))
+ ;; Leave point at bol
(beg (progn (beginning-of-line) (point))))
(prog1
;; Any hidden lines here?
;; Added by Per Abrahamsen <amanda@iesd.auc.dk>.
(when gnus-summary-selected-face
(save-excursion
- (let* ((beg (progn (beginning-of-line) (point)))
- (end (progn (end-of-line) (point)))
+ (let* ((beg (gnus-point-at-bol))
+ (end (gnus-point-at-eol))
;; Fix by Mike Dugan <dugan@bucrf16.bu.edu>.
(from (if (get-text-property beg gnus-mouse-face-prop)
beg
(c cond)
(list gnus-summary-highlight))
(while list
- (setcdr c (cons (list (caar list) (list 'quote (cdar list))) nil))
+ (setcdr c (cons (list (caar list) (list 'quote (cdar list)))
+ nil))
(setq c (cdr c)
list (cdr list)))
(gnus-byte-compile (list 'lambda nil cond))))))
projects / elisp / gnus.git- / blobdiff