If Emacs should crash without saving the .newsrc files, complete
information can be restored from the dribble file.")
+(defvar gnus-dribble-directory nil
+ "*The directory where dribble files will be saved.
+If this variable is nil, the directory where the .newsrc files are
+saved will be used.")
+
(defvar gnus-asynchronous nil
"*If non-nil, Gnus will supply backends with data needed for async article fetching.")
* gnus-summary-save-in-file (article format).
* gnus-summary-save-in-vm (use VM's folder format).")
+(defvar gnus-prompt-before-saving 'always
+ "*This variable says how much prompting is to be done when saving articles.
+If it is nil, no prompting will be done, and the articles will be
+saved to the default files. If this variable is `always', each and
+every article that is saved will be preceded by a prompt, even when
+saving large batches of articles. If this variable is neither nil not
+`always', there the user will be prompted once for a file name for
+each invocation of the saving commands.")
+
(defvar gnus-rmail-save-name (function gnus-plain-save-name)
"*A function generating a file name to save articles in Rmail format.
The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE.")
If nil, which is the default, articles that have different subjects
from their parents will start separate threads.")
+(defvar gnus-thread-operation-ignore-subject t
+ "*If non-nil, subjects will be ignored when doing thread commands.
+This affects commands like `gnus-summary-kill-thread' and
+`gnus-summary-lower-thread'.
+
+If this variable is nil, articles in the same thread with different
+subjects will not be included in the operation in question. If this
+variable is `fuzzy', only articles that have subjects that are fuzzily
+equal will be included.")
+
(defvar gnus-thread-indent-level 4
"*Number that says how much each sub-thread should be indented.")
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 confirmations.")
+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.")
(defvar gnus-auto-select-same nil
"*If non-nil, select the next article with the same subject.")
This function will be called with group info entries as the arguments
for the groups to be sorted. Pre-made functions include
`gnus-group-sort-by-alphabet', `gnus-group-sort-by-unread' and
-`gnus-group-sort-by-level'")
+`gnus-group-sort-by-level'.
+
+This variable can also be a list of sorting functions. In that case,
+the most significant sort function should be the last function in the
+list.")
;; Mark variables suggested by Thomas Michanek
;; <Thomas.Michanek@telelogic.se>.
Some functions you can use are `+', `max', or `min'.")
+(defvar gnus-auto-subscribed-groups
+ "^nnml\\|^nnfolder\\|^nnmbox\\|^nnmh\\|^nnbabyl"
+ "*All new groups that match this regexp will be subscribed automatically.
+Note that this variable only deals with new groups. It has no effect
+whatsoever on old groups.")
+
(defvar gnus-options-subscribe nil
"*All new groups matching this regexp will be subscribed unconditionally.
Note that this variable deals only with new newsgroups. This variable
the third is non-nil, it is a number. No groups with a level lower
than this number should be displayed.
-The only current function implemented is `gnus-group-prepare-flat'.")
+The only current function implemented are `gnus-group-prepare-flat'
+(which does the normal boring group display) and
+`gnus-group-prepare-topics' (which does a folding display accoring to
+topics).")
(defvar gnus-group-prepare-hook nil
"*A hook called after the group buffer has been generated.
"*A hook called when exiting Gnus.")
(defvar gnus-save-newsrc-hook nil
- "*A hook called when saving the newsrc file.")
+ "*A hook called before saving any of the newsrc files.")
+
+(defvar gnus-save-quick-newsrc-hook nil
+ "*A hook called just before saving the quick newsrc file.
+Can be used to turn version control on or off.")
+
+(defvar gnus-save-standard-newsrc-hook nil
+ "*A hook called just before saving the standard newsrc file.
+Can be used to turn version control on or off.")
(defvar gnus-summary-update-hook
(list 'gnus-summary-highlight-line)
(list ?S 'subject ?s)
(list ?e 'unselected ?d)
(list ?u 'user-defined ?s)
+ (list ?d '(length gnus-newsgroup-dormant) ?d)
+ (list ?t '(length gnus-newsgroup-marked) ?d)
+ (list ?r '(length gnus-newsgroup-reads) ?d)
+ (list ?E 'gnus-newsgroup-expunged-tally ?d)
(list ?s '(gnus-current-score-file-nondirectory) ?s)))
(defconst gnus-group-mode-line-format-alist
"gnus-bug@ifi.uio.no (The Gnus Bugfixing Girls + Boys)"
"The mail address of the Gnus maintainers.")
-(defconst gnus-version "September Gnus v0.02"
+(defconst gnus-version "September Gnus v0.5"
"Version number for this version of Gnus.")
(defvar gnus-info-nodes
(defvar gnus-work-buffer " *gnus work*")
(defvar gnus-original-article-buffer " *Original Article*")
+(defvar gnus-original-article nil)
(defvar gnus-buffer-list nil
"Gnus buffers that should be killed on exit.")
(defvar gnus-newsgroup-reads nil
"Alist of read articles and article marks in the current newsgroup.")
+(defvar gnus-newsgroup-expunged-tally nil)
+
(defvar gnus-newsgroup-marked nil
"List of ticked articles in the current newsgroup (a subset of unread art).")
gnus-summary-mark-below gnus-newsgroup-active gnus-scores-exclude-files
gnus-newsgroup-history gnus-newsgroup-ancient
(gnus-newsgroup-adaptive . gnus-use-adaptive-scoring)
+ (gnus-newsgroup-expunged-tally . 0)
gnus-cache-removeable-articles
gnus-newsgroup-data gnus-newsgroup-data-reverse
gnus-newsgroup-limit gnus-newsgroup-limits)
(autoload 'nnsoup-pack-replies "nnsoup" nil t)
;; gnus-mh
- (autoload 'gnus-mail-reply-using-mhe "gnus-mh")
- (autoload 'gnus-mail-forward-using-mhe "gnus-mh")
- (autoload 'gnus-mail-other-window-using-mhe "gnus-mh")
+ (autoload 'gnus-mh-mail-setup "gnus-mh")
(autoload 'gnus-summary-save-in-folder "gnus-mh")
(autoload 'gnus-summary-save-article-folder "gnus-mh")
(autoload 'gnus-Folder-save-name "gnus-mh")
(autoload 'gnus-article-highlight-headers "gnus-vis" nil t)
(autoload 'gnus-article-highlight-signature "gnus-vis" nil t)
(autoload 'gnus-article-add-buttons "gnus-vis" nil t)
+ (autoload 'gnus-article-add-buttons-to-head "gnus-vis" nil t)
(autoload 'gnus-article-next-button "gnus-vis" nil t)
(autoload 'gnus-article-add-button "gnus-vis")
;; gnus-edit
(autoload 'gnus-score-customize "gnus-edit" nil t)
+ ;; gnus-topic
+ (autoload 'gnus-topic-fold "gnus-topic")
+
;; gnus-uu
(autoload 'gnus-uu-extract-map "gnus-uu" nil nil 'keymap)
(autoload 'gnus-uu-mark-map "gnus-uu" nil nil 'keymap)
(autoload 'gnus-summary-reply-with-original "gnus-msg" nil t)
(autoload 'gnus-summary-mail-forward "gnus-msg" nil t)
(autoload 'gnus-summary-mail-other-window "gnus-msg" nil t)
- (autoload 'gnus-mail-reply-using-mail "gnus-msg")
(autoload 'gnus-mail-yank-original "gnus-msg")
(autoload 'gnus-mail-send-and-exit "gnus-msg")
- (autoload 'gnus-mail-forward-using-mail "gnus-msg")
- (autoload 'gnus-mail-other-window-using-mail "gnus-msg")
+ (autoload 'gnus-sendmail-setup-mail "gnus-msg")
(autoload 'gnus-article-mail "gnus-msg")
(autoload 'gnus-bug "gnus-msg" nil t)
(autoload 'gnus-inews-message-id "gnus-msg")
(define-key gnus-group-group-map "V" 'gnus-group-make-empty-virtual)
(define-key gnus-group-group-map "D" 'gnus-group-enter-directory)
(define-key gnus-group-group-map "f" 'gnus-group-make-doc-group)
+ (define-key gnus-group-group-map "r" 'gnus-group-rename-group)
+ (define-key gnus-group-group-map "\177" 'gnus-group-delete-group)
(define-key gnus-group-group-map "sb" 'gnus-group-brew-soup)
(define-key gnus-group-group-map "sw" 'gnus-soup-save-areas)
(define-key gnus-group-group-map "ss" 'gnus-soup-send-replies)
(or level gnus-group-default-list-level gnus-level-subscribed))))
+(defvar gnus-tmp-prev-perm nil)
+
;;;###autoload
(defun gnus-no-server (&optional arg)
"Read network news.
prompt the user for the name of an NNTP server to use.
As opposed to `gnus', this command will not connect to the local server."
(interactive "P")
- (setq gnus-group-use-permanent-levels t)
- (gnus (or arg (1- gnus-level-default-subscribed)) t))
+ (let ((perm
+ (cons gnus-group-use-permanent-levels gnus-group-default-list-level)))
+ (setq gnus-tmp-prev-perm nil)
+ (setq gnus-group-use-permanent-levels t)
+ (gnus (or arg (1- gnus-level-default-subscribed)) t)
+ (setq gnus-tmp-prev-perm perm)))
;;;###autoload
(defun gnus-slave (&optional arg)
(gnus-clear-system)
(nnheader-init-server-buffer)
+ ;; We do this if `gnus-no-server' has been run.
+ (if gnus-tmp-prev-perm
+ (setq gnus-group-use-permanent-levels (car gnus-tmp-prev-perm)
+ gnus-group-default-list-level (cdr gnus-tmp-prev-perm)
+ gnus-tmp-prev-perm nil))
(gnus-read-init-file)
(setq gnus-slave slave)
(unload-feature feature 'force))
(setq history (cdr history)))))
+(defun gnus-indent-rigidly (start end arg)
+ (save-excursion
+ (save-restriction
+ (narrow-to-region start end)
+ (indent-rigidly start end arg)
+ (goto-char (point-min))
+ (while (search-forward "\t" nil t)
+ (replace-match " " t t)))))
+
(defun gnus-group-startup-message (&optional x y)
"Insert startup message in current buffer."
;; Insert the message.
(erase-buffer)
(insert
- (format "
+ (format " %s
_ ___ _ _
_ ___ __ ___ __ _ ___
__ _ ___ __ ___
_
__
-
- Gnus * A newsreader for Emacsen
- A Praxis release * larsi@ifi.uio.no
"
gnus-version))
;; And then hack it.
- ;; 18 is the longest line.
- (indent-rigidly (point-min) (point-max)
- (/ (max (- (window-width) (or x 46)) 0) 2))
+ (gnus-indent-rigidly (point-min) (point-max)
+ (/ (max (- (window-width) (or x 46)) 0) 2))
(goto-char (point-min))
+ (forward-line 1)
(let* ((pheight (count-lines (point-min) (point-max)))
(wheight (window-height))
(rest (- wheight pheight)))
(insert (make-string (max 0 (* 2 (/ rest 3))) ?\n)))
-
-
-
;; Fontify some.
(goto-char (point-min))
- (search-forward "Praxis")
- (put-text-property (match-beginning 0) (match-end 0) 'face 'bold)
+ (and (search-forward "Praxis" nil t)
+ (put-text-property (match-beginning 0) (match-end 0) 'face 'bold))
(goto-char (point-min)))
(defun gnus-group-startup-message-old (&optional x y)
"Return nil if GROUP is native, non-nil if it is foreign."
(string-match ":" group))
+(defun gnus-group-topic-p ()
+ "Return non-nil if the current line is a topic."
+ (get-text-property (gnus-point-at-bol) 'gnus-topic))
+
+(defun gnus-group-add-parameter (group param)
+ "Add parameter PARAM to GROUP."
+ (let ((info (nth 2 (gnus-gethash group gnus-newsrc-hashtb))))
+ (if (not info)
+ () ; This is a dead group. We just ignore it.
+ ;; Cons the new param to the old one and update.
+ (gnus-group-set-info (cons param (nth 5 info)) group 'params))))
+
(defun gnus-group-set-info (info &optional method-only-group part)
(let* ((entry (gnus-gethash
(or method-only-group (car info)) gnus-newsrc-hashtb))
readable. If the optional argument NO-ARTICLE is non-nil, no article
will be auto-selected upon group entry."
(interactive "P")
- (let ((group (or group (gnus-group-group-name)))
- number active marked entry)
- (or group (error "No group on current line"))
- (setq marked
- (nth 3 (nth 2 (setq entry (gnus-gethash group gnus-newsrc-hashtb)))))
- ;; This group might be a dead group. In that case we have to get
- ;; the number of unread articles from `gnus-active-hashtb'.
- (if entry
- (setq number (car entry))
- (if (setq active (gnus-gethash group gnus-active-hashtb))
- (setq number (- (1+ (cdr active)) (car active)))))
- (gnus-summary-read-group
- group (or all (and (numberp number)
- (zerop (+ number (length (cdr (assq 'tick marked)))
- (length (cdr (assq 'dormant marked)))))))
- no-article)))
+ (if (gnus-group-topic-p)
+ (gnus-topic-fold) ; This is a topic line.
+ ;; And this is a real group.
+ (let ((group (or group (gnus-group-group-name)))
+ number active marked entry)
+ (or group (error "No group on current line"))
+ (setq marked
+ (nth 3 (nth 2 (setq entry (gnus-gethash
+ group gnus-newsrc-hashtb)))))
+ ;; This group might be a dead group. In that case we have to get
+ ;; the number of unread articles from `gnus-active-hashtb'.
+ (if entry
+ (setq number (car entry))
+ (if (setq active (gnus-gethash group gnus-active-hashtb))
+ (setq number (- (1+ (cdr active)) (car active)))))
+ (gnus-summary-read-group
+ group (or all (and (numberp number)
+ (zerop (+ number (length (cdr (assq 'tick marked)))
+ (length (cdr (assq 'dormant marked)))))))
+ no-article))))
(defun gnus-group-select-group (&optional all)
"Select this newsgroup.
(defun gnus-group-quick-select-group (&optional all)
"Select the current group \"quickly\".
-This means that no highlights or scoring will be performed."
+This means that no highlighting or scoring will be performed."
(interactive "P")
(let (gnus-visual
gnus-score-find-score-files-function
gnus-summary-expunge-below)
(gnus-group-read-group all t)))
+;;;###autoload
+(defun gnus-fetch-group (group)
+ "Start Gnus if necessary and enter GROUP.
+Returns whether the fetching was successful or not."
+ (interactive "sGroup name: ")
+ (or (get-buffer gnus-group-buffer)
+ (gnus))
+ (gnus-group-select-group))
+
(defun gnus-group-select-group-all ()
"Select the current group and display all articles in it."
(interactive)
(and (gnus-check-backend-function 'request-create-group nname)
(gnus-request-create-group nname)))))
+(defun gnus-group-delete-group (group &optional force)
+ "Delete the current group.
+If FORCE (the prefix) is non-nil, all the articles in the group will
+be deleted. This is \"deleted\" as in \"removed forever from the face
+of the Earth\". There is no undo."
+ (interactive
+ (list (gnus-group-group-name)
+ current-prefix-arg))
+ (or group (error "No group to rename"))
+ (or (gnus-check-backend-function 'request-delete-group group)
+ (error "This backend does not support group deletion"))
+ (prog1
+ (if (not (gnus-yes-or-no-p
+ (format
+ "Do you really want to delete %s%s? "
+ group (if force " and all its contents" ""))))
+ () ; Whew!
+ (gnus-message 6 "Deleting group %s..." group)
+ (if (not (gnus-request-delete-group group force))
+ (progn
+ (gnus-message 3 "Couldn't delete group %s" group)
+ (ding))
+ (gnus-message 6 "Deleting group %s...done" group)
+ (gnus-group-goto-group group)
+ (gnus-group-kill-group 1 t)
+ t))
+ (gnus-group-position-point)))
+
+(defun gnus-group-rename-group (group new-name)
+ (interactive
+ (list
+ (gnus-group-group-name)
+ (progn
+ (or (gnus-check-backend-function
+ 'request-rename-group (gnus-group-group-name))
+ (error "This backend does not support renaming groups"))
+ (read-string "New group name: "))))
+
+ (or (gnus-check-backend-function 'request-rename-group group)
+ (error "This backend does not support renaming groups"))
+
+ (or group (error "No group to rename"))
+ (and (string-match "^[ \t]*$" new-name)
+ (error "Not a valid group name"))
+
+ ;; We find the proper prefixed name.
+ (setq new-name
+ (gnus-group-prefixed-name
+ (gnus-group-real-name new-name)
+ (nth 4 (nth 2 (gnus-gethash group gnus-newsrc-hashtb)))))
+
+ (gnus-message 6 "Renaming group %s to %s..." group new-name)
+ (prog1
+ (if (not (gnus-request-rename-group group new-name))
+ (progn
+ (gnus-message 3 "Couldn't rename group %s to %s" group new-name)
+ (ding))
+ ;; We rename the group internally by killing it...
+ (gnus-group-goto-group group)
+ (gnus-group-kill-group)
+ ;; ... changing its name ...
+ (setcar (cdr (car gnus-list-of-killed-groups))
+ new-name)
+ ;; ... and then yanking it. Magic!
+ (gnus-group-yank-group)
+ (gnus-message 6 "Renaming group %s to %s...done" group new-name)
+ new-name)
+ (gnus-group-position-point)))
+
+
(defun gnus-group-edit-group (group &optional part)
"Edit the group on the current line."
(interactive (list (gnus-group-group-name)))
(list 'nndoc name
(list 'nndoc-address
(concat (file-name-as-directory (car path)) "doc.txt"))
- (list 'nndoc-article-type 'mbox))))
+ (list 'nndoc-article-type 'mbox)))
+ (forward-line -1))
(gnus-group-position-point))
(defun gnus-group-make-doc-group (file type)
(gnus-group-real-name name)
(list 'nndoc name
(list 'nndoc-address file)
- (list 'nndoc-article-type type)))))
+ (list 'nndoc-article-type type)))
+ (forward-line -1)
+ (gnus-group-position-point)))
(defun gnus-group-make-archive-group (&optional all)
"Create the (ding) Gnus archive group of the most recent articles.
(error "Archive group already exists"))
(gnus-group-make-group
(gnus-group-real-name group)
- "nndir"
- (if all gnus-group-archive-directory
- gnus-group-recent-archive-directory)))
+ (list 'nndir (if all "hpc" "edu")
+ (list 'nndir-directory
+ (if all gnus-group-archive-directory
+ gnus-group-recent-archive-directory)))))
+ (forward-line -1)
(gnus-group-position-point))
(defun gnus-group-make-directory-group (dir)
(or (file-exists-p dir) (error "No such directory"))
(or (file-directory-p dir) (error "Not a directory"))
(gnus-group-make-group dir "nndir" dir)
+ (forward-line -1)
(gnus-group-position-point))
(defun gnus-group-make-kiboze-group (group address scores)
(read-string "Source groups (regexp): ")
(let ((headers (mapcar (lambda (group) (list group))
'("subject" "from" "number" "date" "message-id"
- "references" "chars" "lines" "xref")))
+ "references" "chars" "lines" "xref"
+ "followup" "all" "body" "head")))
scores header regexp regexps)
(while (not (equal "" (setq header (completing-read
"Match on header: " headers nil t))))
(let (emacs-lisp-mode-hook)
(pp scores (current-buffer)))
(write-region (point-min) (point-max)
- (concat (or gnus-kill-files-directory "~/News")
- "nnkiboze:" group "." gnus-score-file-suffix)))
+ (gnus-score-file-name (concat "nnkiboze:" group))))
+ (forward-line -1)
(gnus-group-position-point))
(defun gnus-group-add-to-virtual (n vgroup)
;; Suggested by Joe Hildebrand <hildjj@idaho.fuentez.com>.
(defun gnus-group-sort-groups ()
- "Sort the group buffer using `gnus-group-sort-function'."
+ "Sort the group buffer according to `gnus-group-sort-function'."
(interactive)
- (setq gnus-newsrc-alist
- (sort (cdr gnus-newsrc-alist) gnus-group-sort-function))
+ (let ((funcs (if (listp gnus-group-sort-function) gnus-group-sort-function
+ (list gnus-group-sort-function))))
+ ;; We peel off the dummy group off the alist.
+ (and (equal (car (car gnus-newsrc-alist)) "dummy.group")
+ (setq gnus-newsrc-alist (cdr gnus-newsrc-alist)))
+ ;; Do the sorting.
+ (while funcs
+ (setq gnus-newsrc-alist
+ (sort (cdr gnus-newsrc-alist) (car funcs)))
+ (setq funcs (cdr funcs))))
(gnus-make-hashtable-from-newsrc-alist)
(gnus-group-list-groups))
(defun gnus-group-sort-by-level (info1 info2)
(< (nth 1 info1) (nth 1 info2)))
+(defun gnus-group-sort-by-method (info1 info2)
+ (string< (symbol-name (car (gnus-find-method-for-group (car info1))))
+ (symbol-name (car (gnus-find-method-for-group (car info2))))))
+
;; Group catching up.
(defun gnus-group-catchup-current (&optional n all)
(beginning-of-line) ;Important when LINES < 1
(gnus-group-kill-group lines)))
-(defun gnus-group-kill-group (&optional n)
+(defun gnus-group-kill-group (&optional n discard)
"The the next N groups.
The killed newsgroups can be yanked by using \\[gnus-group-yank-group].
However, only groups that were alive can be yanked; already killed
(gnus-group-remove-mark group)
(setq level (gnus-group-group-level))
(gnus-delete-line)
- (if (setq entry (gnus-gethash group gnus-newsrc-hashtb))
+ (if (and (not discard)
+ (setq entry (gnus-gethash group gnus-newsrc-hashtb)))
(setq gnus-list-of-killed-groups
(cons (cons (car entry) (nth 2 entry))
gnus-list-of-killed-groups)))
"Faq dir: " (and (listp gnus-group-faq-directory)
gnus-group-faq-directory))))))
(or faq-dir
- (if (listp gnus-group-faq-directory)
- (car gnus-group-faq-directory)
- gnus-group-faq-directory))
+ (setq faq-dir (if (listp gnus-group-faq-directory)
+ (car gnus-group-faq-directory)
+ gnus-group-faq-directory)))
(or group (error "No group name given"))
(let ((file (concat (file-name-as-directory faq-dir)
(gnus-group-real-name group))))
(define-key gnus-summary-wash-hide-map "h" 'gnus-article-hide-headers)
(define-key gnus-summary-wash-hide-map "s" 'gnus-article-hide-signature)
(define-key gnus-summary-wash-hide-map "c" 'gnus-article-hide-citation)
+ (define-key gnus-summary-wash-hide-map "p" 'gnus-article-hide-pgp)
(define-key gnus-summary-wash-hide-map
"\C-c" 'gnus-article-hide-citation-maybe)
(define-key gnus-summary-wash-time-map "o" 'gnus-article-date-original)
(define-key gnus-summary-wash-map "b" 'gnus-article-add-buttons)
+ (define-key gnus-summary-wash-map "B" 'gnus-article-add-buttons-to-head)
(define-key gnus-summary-wash-map "o" 'gnus-article-treat-overstrike)
(define-key gnus-summary-wash-map "w" 'gnus-article-word-wrap)
(define-key gnus-summary-wash-map "c" 'gnus-article-remove-cr)
(define-key gnus-summary-save-map "m" 'gnus-summary-save-article-mail)
(define-key gnus-summary-save-map "r" 'gnus-summary-save-article-rmail)
(define-key gnus-summary-save-map "f" 'gnus-summary-save-article-file)
+ (define-key gnus-summary-save-map "b" 'gnus-summary-save-article-body-file)
(define-key gnus-summary-save-map "h" 'gnus-summary-save-article-folder)
(define-key gnus-summary-save-map "v" 'gnus-summary-save-article-vm)
(define-key gnus-summary-save-map "p" 'gnus-summary-pipe-output)
(setq gnus-newsgroup-data data)
(setq gnus-current-score-file score-file))))))
+(defun gnus-summary-last-article-p (&optional article)
+ "Return whether ARTICLE is the last article in the buffer."
+ (if (not (setq article (or article (gnus-summary-article-number))))
+ t ; All non-existant numbers are the last article. :-)
+ (cdr (gnus-data-find-list article))))
+
(defun gnus-summary-insert-dummy-line (sformat subject number)
(if (not sformat)
(setq sformat gnus-summary-dummy-line-format-spec))
(defun gnus-summary-insert-line
(sformat header level current unread replied expirable subject-or-nil
- &optional dummy score)
+ &optional dummy score process)
(or sformat (setq sformat gnus-summary-line-format-spec))
(let* ((indentation (aref gnus-thread-indent-array level))
(lines (mail-header-lines header))
gnus-summary-zcore-fuzz)) ?
(if (< score gnus-summary-default-score)
gnus-score-below-mark gnus-score-over-mark)))
- (replied (if replied gnus-replied-mark ? ))
+ (replied (cond (process gnus-process-mark)
+ (replied gnus-replied-mark)
+ (t gnus-unread-mark)))
(from (mail-header-from header))
(name (cond
((string-match "(.+)" from)
(setq gnus-newsgroup-reads
(cons (cons number gnus-low-score-mark)
gnus-newsgroup-reads))
+ (setq gnus-newsgroup-expunged-tally
+ (1+ gnus-newsgroup-expunged-tally))
t)))))
nil
(list (cons head tail)))))
(while (or threads stack new-adopts new-roots)
(if (and (= level 0)
+ (or (not stack)
+ (= (car (car stack)) 0))
(not gnus-tmp-false-parent)
(or new-adopts new-roots))
(progn
(cond
((eq gnus-summary-make-false-root 'adopt)
;; We let the first article adopt the rest.
- (let ((th (car (cdr (car thread)))))
- (while (cdr th)
- (setq th (cdr th)))
- ;(setcdr th (cdr (cdr (car thread))))
- (setq new-adopts (nconc new-adopts
- (cdr (cdr (car thread)))))
- (setq gnus-tmp-gathered
- (nconc (mapcar
- (lambda (h) (mail-header-number (car h)))
- (cdr (cdr (car thread))))
- gnus-tmp-gathered))
- (setcdr (cdr (car thread)) nil))
+ (setq new-adopts (nconc new-adopts
+ (cdr (cdr (car thread)))))
+ (setq gnus-tmp-gathered
+ (nconc (mapcar
+ (lambda (h) (mail-header-number (car h)))
+ (cdr (cdr (car thread))))
+ gnus-tmp-gathered))
+ (setcdr (cdr (car thread)) nil)
(setq level -1
gnus-tmp-false-parent t))
((eq gnus-summary-make-false-root 'empty)
(not (zerop level))
gnus-tmp-prev-subject
(not (gnus-subject-equal gnus-tmp-prev-subject subject)))
- (setq new-roots (if (cdr (car thread))
- (nconc new-roots (list (car thread)))
- new-roots)
+ (setq new-roots (nconc new-roots (list (car thread)))
thread-end t
header nil))
((and gnus-newsgroup-limit
gnus-summary-default-score 0)
gnus-summary-expunge-below))
(setq header nil
+ gnus-newsgroup-expunged-tally
+ (1+ gnus-newsgroup-expunged-tally)
gnus-newsgroup-unreads
(delq number gnus-newsgroup-unreads)
gnus-newsgroup-reads
(and (eq gnus-summary-make-false-root 'adopt)
(= level 1)
(memq number gnus-tmp-gathered))
- (cdr (assq number gnus-newsgroup-scored))))
+ (cdr (assq number gnus-newsgroup-scored))
+ (memq number gnus-newsgroup-processable)))
(setq gnus-newsgroup-data
(cons (gnus-data-make number mark (- (point) 4)
;; We may have to root out some bad articles...
(cond
- ((memq (setq number (mail-header-number header))
- gnus-newsgroup-dormant))
((and gnus-summary-expunge-below
(< (or (cdr (assq number gnus-newsgroup-scored))
gnus-summary-default-score 0)
(delq number gnus-newsgroup-unreads))
(setq gnus-newsgroup-reads
(cons (cons number gnus-low-score-mark)
- gnus-newsgroup-reads)))
+ gnus-newsgroup-reads))
+ (setq gnus-newsgroup-expunged-tally
+ (1+ gnus-newsgroup-expunged-tally)))
((and gnus-newsgroup-limit
(not (memq number gnus-newsgroup-limit)))
;; Don't print this article - it's not in the limit.
nil header 0 nil mark (memq number gnus-newsgroup-replied)
(memq number gnus-newsgroup-expirable)
(mail-header-subject header) nil
- (cdr (assq number gnus-newsgroup-scored))))))))
+ (cdr (assq number gnus-newsgroup-scored))
+ (memq number gnus-newsgroup-processable)))))))
(defun gnus-select-newsgroup (group &optional read-all)
"Select newsgroup GROUP.
(setq mode-line-buffer-identification mode-string)
(set-buffer-modified-p t))))
-(defun gnus-create-xref-hashtb (from-newsgroup headers unreads)
+(defun gnus-create-xref-hashtb (from-newsgroup headers unreads ticked dormant)
"Go through the HEADERS list and add all Xrefs to a hash table.
The resulting hash table is returned, or nil if no Xrefs were found."
(let* ((from-method (gnus-find-method-for-group from-newsgroup))
(while headers
(setq header (car headers))
(if (and (setq xrefs (mail-header-xref header))
- (not (memq (mail-header-number header) unreads)))
+ (not (memq (setq number (mail-header-number header)) unreads))
+ (not (memq number ticked))
+ (not (memq number dormant)))
(progn
(setq start 0)
(while (string-match "\\([^ ]+\\)[:/]\\([0-9]+\\)" xrefs start)
(setq headers (cdr headers)))
(if start xref-hashtb nil)))
-(defun gnus-mark-xrefs-as-read (from-newsgroup headers unreads expirable)
+(defun gnus-mark-xrefs-as-read (from-newsgroup headers unreads expirable
+ ticked dormant)
"Look through all the headers and mark the Xrefs as read."
(let ((virtual (memq 'virtual
(assoc (symbol-name (car (gnus-find-method-for-group
(save-excursion
(set-buffer gnus-group-buffer)
(if (setq xref-hashtb
- (gnus-create-xref-hashtb from-newsgroup headers unreads))
+ (gnus-create-xref-hashtb
+ from-newsgroup headers unreads ticked dormant))
(mapatoms
(lambda (group)
(if (string= from-newsgroup (setq name (symbol-name group)))
(and gnus-save-score gnus-newsgroup-scored))
(and gnus-use-cross-reference
(gnus-mark-xrefs-as-read
- group headers gnus-newsgroup-unreads gnus-newsgroup-expirable))
+ group headers gnus-newsgroup-unreads gnus-newsgroup-expirable
+ gnus-newsgroup-marked gnus-newsgroup-dormant))
;; Do adaptive scoring, and possibly save score files.
(and gnus-newsgroup-adaptive
(gnus-score-adaptive))
(setq current-group target-group
target-group nil)))))))
-(defun gnus-summary-next-group-old (&optional no-article 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 BACKWARD, go to previous group instead."
- (interactive "P")
- (gnus-set-global-variables)
- (let ((ingroup gnus-newsgroup-name)
- (sumbuf (current-buffer))
- num)
- (set-buffer gnus-group-buffer)
- (if (and group
- (or (and (numberp (setq num (car (gnus-gethash
- group gnus-newsrc-hashtb))))
- (< num 1))
- (null num)))
- (progn
- (gnus-group-jump-to-group group)
- (setq group nil))
- (gnus-group-jump-to-group ingroup))
- (gnus-summary-search-group backward)
- (let ((group (or group (gnus-summary-search-group backward))))
- (set-buffer sumbuf)
- (gnus-summary-exit t) ;Update all information.
- (if (null group)
- (gnus-summary-exit-no-update t)
- (gnus-group-jump-to-group ingroup)
- (setq group (gnus-summary-search-group backward))
- (gnus-message 5 "Selecting %s..." group)
- (set-buffer gnus-group-buffer)
- ;; We are now in group mode buffer.
- ;; Make sure group mode buffer point is on GROUP.
- (gnus-group-jump-to-group group)
- (if (not (eq gnus-auto-select-next 'quietly))
- (progn
- (gnus-summary-read-group group nil no-article sumbuf)
- (and (string= gnus-newsgroup-name ingroup)
- (bufferp sumbuf) (buffer-name sumbuf)
- (progn
- (set-buffer (setq gnus-summary-buffer sumbuf))
- (gnus-summary-exit-no-update t))))
- (let ((prevgroup group))
- (gnus-group-jump-to-group ingroup)
- (setq group (gnus-summary-search-group backward))
- (gnus-summary-read-group group nil no-article sumbuf)
- (while (and (string= gnus-newsgroup-name ingroup)
- (bufferp sumbuf)
- (buffer-name sumbuf)
- (not (string= prevgroup (gnus-group-group-name))))
- (set-buffer gnus-group-buffer)
- (gnus-summary-read-group
- (setq prevgroup (gnus-group-group-name))
- nil no-article sumbuf))
- (and (string= prevgroup (gnus-group-group-name))
- ;; We have reached the final group in the group
- ;; buffer.
- (progn
- (if (buffer-name sumbuf)
- (progn
- (set-buffer sumbuf)
- (gnus-summary-exit)))))))))))
-
(defun gnus-summary-prev-group (&optional no-article)
"Exit current newsgroup and then select previous unread newsgroup.
If prefix argument NO-ARTICLE is non-nil, no article is selected initially."
(if (not data)
(message "Can't find article %d" article)
(goto-char (gnus-data-pos data))
- (gnus-summary-show-thread)
;; Skip dummy articles.
(if (eq (gnus-summary-article-mark) gnus-dummy-mark)
(gnus-summary-find-next))
(cond
((not gnus-auto-select-next)
(gnus-message 7 "No more%s articles" (if unread " unread" "")))
- ((eq gnus-auto-select-next 'quietly)
+ ((or (eq gnus-auto-select-next 'quietly)
+ (and (eq gnus-auto-select-next 'almost-quietly)
+ (gnus-summary-last-article-p)))
;; Select quietly.
(if (assoc 'quit-config (gnus-find-method-for-group
gnus-newsgroup-name))
(single-key-description cmd)
gnus-newsgroup-name)))
;; Confirm auto selection.
- (let* ((event (read-char)))
+ (let* ((event (read-char-exclusive)))
(setq key (if (listp event) (car event) event))
(if (memq key keystrokes)
(let ((obuf (current-buffer)))
(marks (append marks nil)) ; Transform to list.
articles)
(while data
- (or (if reverse (not (memq (gnus-data-mark (car data)) marks))
- (memq (gnus-data-mark (car data)) marks))
- (setq articles (cons (gnus-data-number (car data)) articles)))
+ (and (if reverse (not (memq (gnus-data-mark (car data)) marks))
+ (memq (gnus-data-mark (car data)) marks))
+ (setq articles (cons (gnus-data-number (car data)) articles)))
(setq data (cdr data)))
(gnus-summary-limit articles)))
(gnus-summary-position-point)))
(let ((ref (mail-header-references (gnus-summary-article-header))))
(if (and ref (not (equal ref ""))
(string-match "<[^<>]*>[ \t]*$" ref))
- (gnus-summary-refer-article
- (substring ref (match-beginning 0) (match-end 0)))
+ (or (gnus-summary-refer-article
+ (substring ref (match-beginning 0) (match-end 0)))
+ (gnus-message 1 "Couldn't find parent"))
(gnus-message 1 "No references in article %d"
(gnus-summary-article-number))
nil)))
(if (not (gnus-check-backend-function
'request-expire-articles gnus-newsgroup-name))
()
- (let* ((info (nth 2 (gnus-gethash gnus-newsgroup-name
- gnus-newsrc-hashtb)))
- (total (gnus-group-total-expirable-p gnus-newsgroup-name))
+ (let* ((total (gnus-group-total-expirable-p gnus-newsgroup-name))
(expirable (if total
(gnus-list-of-read-articles gnus-newsgroup-name)
(setq gnus-newsgroup-expirable
(setq score (gnus-score-default score))
(let (e)
(save-excursion
- (let ((level (gnus-summary-thread-level)))
- (gnus-summary-raise-score score)
- (while (and (zerop (gnus-summary-next-subject 1 nil t))
- (> (gnus-summary-thread-level) level))
- (gnus-summary-raise-score score))
- (setq e (point))))
+ (let ((articles (gnus-summary-articles-in-thread)))
+ (while articles
+ (gnus-summary-goto-subject (car articles))
+ (gnus-summary-raise-score score)
+ (setq articles (cdr articles))))
+ (setq e (point)))
(let ((gnus-summary-check-current t))
(or (zerop (gnus-summary-next-subject 1 t))
(goto-char e))))
;; Thread-based commands.
+(defun gnus-summary-articles-in-thread (&optional article)
+ "Return a list of all articles in the current thread.
+If ARTICLE is non-nil, return all articles in the thread that starts
+with that article."
+ (let* ((article (or article (gnus-summary-article-number)))
+ (data (gnus-data-find-list article))
+ (top-level (gnus-data-level (car data)))
+ (top-subject
+ (cond ((null gnus-thread-operation-ignore-subject)
+ (gnus-simplify-subject-re
+ (mail-header-subject (gnus-data-header (car data)))))
+ ((eq gnus-thread-operation-ignore-subject 'fuzzy)
+ (gnus-simplify-subject-fuzzy
+ (mail-header-subject (gnus-data-header (car data)))))
+ (t nil)))
+ articles)
+ (if (not data)
+ () ; This article doesn't exist.
+ (while data
+ (and (or (not top-subject)
+ (string= top-subject
+ (if (eq gnus-thread-operation-ignore-subject 'fuzzy)
+ (gnus-simplify-subject-fuzzy
+ (mail-header-subject
+ (gnus-data-header (car data))))
+ (gnus-simplify-subject-re
+ (mail-header-subject
+ (gnus-data-header (car data)))))))
+ (setq articles (cons (gnus-data-number (car data)) articles)))
+ (if (and (setq data (cdr data))
+ (> (gnus-data-level (car data)) top-level))
+ ()
+ (setq data nil)))
+ ;; Return the list of articles.
+ (nreverse articles))))
+
(defun gnus-summary-toggle-threads (&optional arg)
"Toggle showing conversation threads.
If ARG is positive number, turn showing conversation threads on."
(gnus-set-global-variables)
(let ((buffer-read-only nil)
(start (point))
- (level (gnus-summary-thread-level))
(article (gnus-summary-article-number))
(end (point)))
;; Go forward until either the buffer ends or the subthread
;; ends.
(if (eobp)
()
- (while (and (gnus-summary-find-next)
- (> (gnus-summary-thread-level) level))
- (setq end (point)))
- (prog1
- (save-excursion
- (goto-char end)
- (search-backward "\n" start t))
- (subst-char-in-region start end ?\n ?\^M)
- (gnus-summary-goto-subject article)
- (gnus-summary-position-point)))))
+ (if (not (zerop (gnus-summary-next-thread 1)))
+ ()
+ (gnus-summary-find-prev)
+ (prog1
+ (save-excursion
+ (search-backward "\n" start t))
+ (subst-char-in-region start (point) ?\n ?\^M)
+ (gnus-summary-goto-subject article)
+ (gnus-summary-position-point))))))
(defun gnus-summary-go-to-next-thread (&optional previous)
"Go to the same level (or less) next thread.
If PREVIOUS is non-nil, go to previous thread instead.
Return the article number moved to, or nil if moving was impossible."
- (let ((level (gnus-summary-thread-level))
- (article (gnus-summary-article-number)))
- (if previous
- (while (and (gnus-summary-find-prev)
- (> (gnus-summary-thread-level) level)))
- (while (and (gnus-summary-find-next)
- (> (gnus-summary-thread-level) level))))
- (gnus-summary-recenter)
- (gnus-summary-position-point)
- (let ((oart (gnus-summary-article-number)))
- (and (/= oart article) oart))))
+ (let* ((level (gnus-summary-thread-level))
+ (article (gnus-summary-article-number))
+ (data (cdr (gnus-data-find-list article (gnus-data-list previous))))
+ oart)
+ (while data
+ (if (<= (gnus-data-level (car data)) level)
+ (setq oart (gnus-data-number (car data))
+ data nil)
+ (setq data (cdr data))))
+ (and oart
+ (gnus-summary-goto-subject oart))))
(defun gnus-summary-next-thread (n)
"Go to the same level next N'th thread.
(gnus-set-global-variables)
(if unmark
(setq unmark (prefix-numeric-value unmark)))
- (let ((killing t)
- (level (gnus-summary-thread-level)))
+ (let ((articles (gnus-summary-articles-in-thread)))
(save-excursion
;; Expand the thread.
(gnus-summary-show-thread)
- (while killing
- ;; Mark the article...
- (cond ((null unmark) (gnus-summary-mark-article-as-read
- gnus-killed-mark))
- ((> unmark 0) (gnus-summary-mark-article-as-unread
- gnus-unread-mark))
- (t (gnus-summary-mark-article-as-unread gnus-ticked-mark)))
- ;; ...and go forward until either the buffer ends or the subtree
- ;; ends.
- (if (not (and (gnus-summary-find-next)
- (> (gnus-summary-thread-level) level)))
- (setq killing nil))))
+ ;; Mark all the articles.
+ (while articles
+ (gnus-summary-goto-subject (car articles))
+ (cond ((null unmark)
+ (gnus-summary-mark-article-as-read gnus-killed-mark))
+ ((> unmark 0)
+ (gnus-summary-mark-article-as-unread gnus-unread-mark))
+ (t
+ (gnus-summary-mark-article-as-unread gnus-ticked-mark)))
+ (setq articles (cdr articles))))
;; Hide killed subtrees.
(and (null unmark)
gnus-thread-hide-killed
The variable `gnus-default-article-saver' specifies the saver function."
(interactive "P")
(gnus-set-global-variables)
- (let ((articles (gnus-summary-work-articles n)))
+ (let ((articles (gnus-summary-work-articles n))
+ file)
(while articles
(let ((header (gnus-summary-article-header (car articles))))
(if (vectorp header)
(widen))))
(save-window-excursion
(if gnus-default-article-saver
- (funcall gnus-default-article-saver)
+ (setq file (funcall
+ gnus-default-article-saver
+ (cond
+ ((not gnus-prompt-before-saving)
+ 'default)
+ ((eq gnus-prompt-before-saving 'always)
+ nil)
+ (t file))))
(error "No default saver is defined."))))
(if (assq 'name header)
(gnus-copy-file (cdr (assq 'name header)))
(let ((gnus-default-article-saver 'gnus-summary-save-in-file))
(gnus-summary-save-article arg)))
+(defun gnus-summary-save-article-body-file (&optional arg)
+ "Append the current article body to a file.
+If N is a positive number, save the N next articles.
+If N is a negative number, save the N previous articles.
+If N is nil and any articles have been marked with the process mark,
+save those articles instead."
+ (interactive "P")
+ (gnus-set-global-variables)
+ (let ((gnus-default-article-saver 'gnus-summary-save-body-in-file))
+ (gnus-summary-save-article arg)))
+
(defun gnus-read-save-file-name (prompt default-name)
(let ((methods gnus-split-methods)
split-name)
(let ((default-name
(funcall gnus-rmail-save-name gnus-newsgroup-name
gnus-current-headers gnus-newsgroup-last-rmail)))
- (or filename
- (setq filename (gnus-read-save-file-name
- "Save in rmail file:" default-name)))
+ (setq filename
+ (cond ((eq filename 'default)
+ default-name)
+ (filename filename)
+ (t (gnus-read-save-file-name
+ "Save in rmail file:" default-name))))
(gnus-make-directory (file-name-directory filename))
(gnus-eval-in-buffer-window
gnus-article-buffer
(let ((default-name
(funcall gnus-mail-save-name gnus-newsgroup-name
gnus-current-headers gnus-newsgroup-last-mail)))
- (or filename
- (setq filename (gnus-read-save-file-name
- "Save in Unix mail file:" default-name)))
+ (setq filename
+ (cond ((eq filename 'default)
+ default-name)
+ (filename filename)
+ (t (gnus-read-save-file-name
+ "Save in Unix mail file:" default-name))))
(setq filename
(expand-file-name filename
(and default-name
(let ((default-name
(funcall gnus-file-save-name gnus-newsgroup-name
gnus-current-headers gnus-newsgroup-last-file)))
- (or filename
- (setq filename (gnus-read-save-file-name
- "Save in file:" default-name)))
+ (setq filename
+ (cond ((eq filename 'default)
+ default-name)
+ (filename filename)
+ (t (gnus-read-save-file-name
+ "Save in file:" default-name))))
(gnus-make-directory (file-name-directory filename))
(gnus-eval-in-buffer-window
gnus-article-buffer
;; Remember the directory name to save articles.
(setq gnus-newsgroup-last-file filename)))
-(defun gnus-summary-save-in-pipe (&optional command)
- "Pipe this article to subprocess."
+(defun gnus-summary-save-body-in-file (&optional filename)
+ "Append this article body to a file.
+Optional argument FILENAME specifies file name.
+The directory to save in defaults to `gnus-article-save-directory' which
+is initialized from the SAVEDIR environment variable."
(interactive)
(gnus-set-global-variables)
- (let ((command (read-string "Shell command on article: "
- gnus-last-shell-command)))
- (if (string-equal command "")
- (setq command gnus-last-shell-command))
+ (let ((default-name
+ (funcall gnus-file-save-name gnus-newsgroup-name
+ gnus-current-headers gnus-newsgroup-last-file)))
+ (setq filename
+ (cond ((eq filename 'default)
+ default-name)
+ (filename filename)
+ (t (gnus-read-save-file-name
+ "Save body in file:" default-name))))
+ (gnus-make-directory (file-name-directory filename))
(gnus-eval-in-buffer-window
gnus-article-buffer
- (save-restriction
- (widen)
- (shell-command-on-region (point-min) (point-max) command nil)))
- (setq gnus-last-shell-command command)))
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (and (search-forward "\n\n" nil t)
+ (narrow-to-region (point) (point-max)))
+ (gnus-output-to-file filename))))
+ ;; Remember the directory name to save articles.
+ (setq gnus-newsgroup-last-file filename)))
+
+(defun gnus-summary-save-in-pipe (&optional command)
+ "Pipe this article to subprocess."
+ (interactive)
+ (gnus-set-global-variables)
+ (setq command
+ (cond ((eq command 'default)
+ gnus-last-shell-command)
+ (command command)
+ (t (read-string "Shell command on article: "
+ gnus-last-shell-command))))
+ (if (string-equal command "")
+ (setq command gnus-last-shell-command))
+ (gnus-eval-in-buffer-window
+ gnus-article-buffer
+ (save-restriction
+ (widen)
+ (shell-command-on-region (point-min) (point-max) command nil)))
+ (setq gnus-last-shell-command command))
;; Summary extract commands
(put 'gnus-article-mode 'mode-class 'special)
-(defvar gnus-boogaboo nil)
-
(if gnus-article-mode-map
nil
(setq gnus-article-mode-map (make-keymap))
;; "Of" "Oh" "Ov" "Op" "Vu" "V\C-s" "V\C-r" "Vr" "V&" "VT" "Ve"
;; "VD" "Vk" "VK" "Vsn" "Vsa" "Vss" "Vsd" "Vsi"
)))
- (while (and gnus-boogaboo commands) ; disabled
+ (while commands
(define-key gnus-article-mode-map (car commands)
'gnus-article-summary-command)
(setq commands (cdr commands))))
(let ((commands (list "q" "Q" "c" "r" "R" "\C-c\C-f" "m" "a" "f" "F"
;; "Zc" "ZC" "ZE" "ZQ" "ZZ" "Zn" "ZR" "ZG" "ZN" "ZP"
"=" "n" "^" "\M-^")))
- (while (and gnus-boogaboo commands) ; disabled
+ (while commands
(define-key gnus-article-mode-map (car commands)
'gnus-article-summary-command-nosave)
(setq commands (cdr commands)))))
(set-buffer (get-buffer gnus-original-article-buffer))
(set-buffer (get-buffer-create gnus-original-article-buffer))
(buffer-disable-undo (current-buffer))
+ (setq major-mode 'gnus-original-article-mode)
(gnus-add-current-to-buffer-list))
- (erase-buffer)
(setq group (or group gnus-newsgroup-name))
(setq article 'nneething)
(gnus-group-enter-directory dir)))))))))
- ;; Check the cache.
- (if (and gnus-use-cache
- (numberp article)
- (gnus-cache-request-article article group))
- 'article
- ;; Get the article and into the article buffer.
- (if (or (stringp article) (numberp article))
- (progn
- (erase-buffer)
- (let ((gnus-override-method
- (and (stringp article) gnus-refer-article-method)))
- (and (gnus-request-article article group (current-buffer))
- 'article)))
- article)))
- (erase-buffer)
- (insert-buffer gnus-original-article-buffer)))
+ (cond
+ ;; We first check `gnus-original-article-buffer'.
+ ((and (equal (car gnus-original-article) group)
+ (eq (cdr gnus-original-article) article))
+ 'article)
+ ;; Check the cache.
+ ((and gnus-use-cache
+ (numberp article)
+ (gnus-cache-request-article article group))
+ 'article)
+ ;; Get the article from the backend.
+ ((or (stringp article) (numberp article))
+ (erase-buffer)
+ (let ((gnus-override-method
+ (and (stringp article) gnus-refer-article-method)))
+ (and (gnus-request-article article group (current-buffer))
+ 'article)))
+ ;; It was a pseudo.
+ (t article)))
+ (setq gnus-original-article (cons group article))
+ (let (buffer-read-only)
+ (erase-buffer)
+ (insert-buffer-substring gnus-original-article-buffer))))
(defun gnus-read-header (id)
"Read the headers of article ID and enter them into the Gnus system."
(interactive)
(save-excursion
(set-buffer gnus-article-buffer)
- (let ((buffer-read-only nil))
+ (let ((buffer-read-only nil)
+ p)
+ (widen)
(goto-char (point-min))
(search-forward "\n\n" nil t)
(end-of-line 1)
(and (process-status "gnus-x-face")
(delete-process "gnus-x-face"))
(let ((inhibit-point-motion-hooks t)
- (case-fold-search nil))
+ (case-fold-search nil)
+ from)
(save-restriction
(goto-char (point-min))
(search-forward "\n\n")
(narrow-to-region (point-min) (point))
(goto-char (point-min))
+ (setq from (mail-fetch-field "from"))
(if (not (and gnus-article-x-face-command
(or force
(not gnus-article-x-face-too-ugly)
- (and gnus-article-x-face-too-ugly
+ (and gnus-article-x-face-too-ugly from
(not (string-match gnus-article-x-face-too-ugly
- (mail-fetch-field "from")))))
+ from))))
(progn
(goto-char (point-min))
(re-search-forward "^X-Face: " nil t))))
(delete-char 1))
((gnus-message 3 "Malformed MIME quoted-printable message"))))))
+(defun gnus-article-hide-pgp ()
+ "Hide any PGP headers and signatures in the current article."
+ (interactive)
+ (save-excursion
+ (set-buffer gnus-article-buffer)
+ (let (buffer-read-only)
+ (goto-char (point-min))
+ ;; Hide the "header".
+ (and (search-forward "\n-----BEGIN PGP SIGNED MESSAGE-----\n" nil t)
+ (add-text-properties (match-beginning 0) (match-end 0)
+ gnus-hidden-properties))
+ ;; Hide the actual signature.
+ (and (search-forward "\n-----BEGIN PGP SIGNATURE-----\n" nil t)
+ (add-text-properties
+ (match-beginning 0)
+ (if (search-forward "\n-----END PGP SIGNATURE-----\n" nil t)
+ (match-end 0)
+ ;; Perhaps we shouldn't hide to the end of the buffer
+ ;; if there is no end to the signature?
+ (point-max))
+ gnus-hidden-properties)))))
+
+
(defvar gnus-article-time-units
(list (cons 'year (* 365.25 24 60 60))
(cons 'week (* 7 24 60 60))
(defvar gnus-dribble-eval-file nil)
(defun gnus-dribble-file-name ()
- (concat gnus-current-startup-file "-dribble"))
+ (concat
+ (if gnus-dribble-directory
+ (concat (file-name-as-directory gnus-dribble-directory)
+ (file-name-nondirectory gnus-current-startup-file))
+ gnus-current-startup-file)
+ "-dribble"))
(defun gnus-dribble-enter (string)
(if (and (not gnus-dribble-ignore)
(funcall (gnus-get-function method 'request-scan)
(and group (gnus-group-real-name group)) (nth 1 method))))
+(defun gnus-request-update-info (info method)
+ (funcall (gnus-get-function method 'request-update-info)
+ (gnus-group-real-name (car info)) info (nth 1 method)))
+
(defun gnus-request-expire-articles (articles group &optional force)
(let ((method (gnus-find-method-for-group group)))
(funcall (gnus-get-function method 'request-expire-articles)
(funcall (gnus-get-function method 'request-create-group)
(gnus-group-real-name group) (nth 1 method))))
+(defun gnus-request-delete-group (group &optional force)
+ (let ((method (gnus-find-method-for-group group)))
+ (funcall (gnus-get-function method 'request-delete-group)
+ (gnus-group-real-name group) force (nth 1 method))))
+
+(defun gnus-request-rename-group (group new-name)
+ (let ((method (gnus-find-method-for-group group)))
+ (funcall (gnus-get-function method 'request-rename-group)
+ (gnus-group-real-name group)
+ (gnus-group-real-name new-name) (nth 1 method))))
+
(defun gnus-member-of-valid (symbol group)
"Find out if GROUP has SYMBOL as part of its \"valid\" spec."
(memq symbol (assoc
gnus-valid-select-methods)))
(defun gnus-secondary-method-p (method)
+ "Return whether METHOD is a secondary select method."
(let ((methods gnus-secondary-select-methods)
(gmethod (gnus-server-get-method nil method)))
(while (and methods
methods))
(defun gnus-find-method-for-group (group &optional info)
+ "Find the select method that GROUP uses."
(or gnus-override-method
(and (not group)
gnus-select-method)
(gnus-server-add-address method))))
(defun gnus-check-backend-function (func group)
+ "Check whether GROUP supports function FUNC."
(let ((method (if (stringp group) (car (gnus-find-method-for-group group))
group)))
(fboundp (intern (format "%s-%s" method func)))))
-(defun gnus-methods-using (method)
+(defun gnus-methods-using (feature)
+ "Find all methods that have FEATURE."
(let ((valids gnus-valid-select-methods)
outs)
(while valids
- (if (memq method (car valids))
+ (if (memq feature (car valids))
(setq outs (cons (car valids) outs)))
(setq valids (cdr valids)))
outs))
((and gnus-options-subscribe
(string-match gnus-options-subscribe group))
'subscribe)
+ ((and gnus-auto-subscribed-groups
+ (string-match gnus-auto-subscribed-groups group))
+ 'subscribe)
((and gnus-options-not-subscribe
(string-match gnus-options-not-subscribe group))
'ignore)
gnus-activate-foreign-newsgroups)
(t 0))
level))
- info group active virtuals method)
+ (update
+ (fboundp (intern (format "%s-request-update-info"
+ (car gnus-select-method)))))
+ info group active virtuals method fmethod)
(gnus-message 5 "Checking new news...")
(while newsrc
;; newsgroup to t. This means that Gnus thinks that there are
;; unread articles, but it has no idea how many.
(if (and (setq method (nth 4 info))
- (not (gnus-server-equal gnus-select-method
- (gnus-server-get-method nil method)))
+ (not (gnus-server-equal
+ gnus-select-method
+ (prog1
+ (setq fmethod (gnus-server-get-method nil method))
+ ;; We do this here because it would be awkward
+ ;; to do it anywhere else. Hell, it's pretty
+ ;; awkward here as well, but at least it's
+ ;; reasonable efficient.
+ (and (fboundp (intern (format "%s-request-update-info"
+ (car fmethod))))
+ (<= (nth 1 info) foreign-level)
+ (gnus-request-update-info info method)))))
(not (gnus-secondary-method-p method)))
;; These groups are foreign. Check the level.
(if (<= (nth 1 info) foreign-level)
- (if (eq (car (if (stringp method)
- (gnus-server-to-method method)
- (nth 4 info))) 'nnvirtual)
- ;; We have to activate the virtual groups after all
- ;; the others, so we just pop them on a list for
- ;; now.
- (setq virtuals (cons info virtuals))
- (and (setq active (gnus-activate-group (car info) 'scan))
- ;; Close the groups as we look at them!
- (gnus-close-group group))))
+ (setq active (gnus-activate-group (car info) 'scan)))
;; These groups are native or secondary.
- (if (and (not gnus-read-active-file)
- (<= (nth 1 info) level))
+ (if (<= (nth 1 info) level)
(progn
- (or gnus-read-active-file (gnus-check-server method))
- (setq active (gnus-activate-group (car info) 'scan)))))
+ (if (and update (not method))
+ (progn
+ ;; Allow updating of native groups as well, even
+ ;; though that's pretty unlikely.
+ (gnus-request-update-info info gnus-select-method)
+ (setq active (gnus-activate-group (car info) 'scan)))
+ (or gnus-read-active-file
+ (setq active (gnus-activate-group (car info) 'scan)))))))
(if active
(gnus-get-unread-articles-in-group info active)
(setq newsrc (cdr newsrc)))
- ;; Activate the virtual groups. This has to be done after all the
- ;; other groups.
- ;; !!! If one virtual group contains another virtual group, even
- ;; doing it this way might cause problems.
- (while virtuals
- (and (setq active (gnus-activate-group (car (car virtuals)) 'scan))
- (gnus-get-unread-articles-in-group (car virtuals) active))
- (setq virtuals (cdr virtuals)))
-
(gnus-message 5 "Checking new news...done")))
;; Create a hash table out of the newsrc alist. The `car's of the
(let (gnus-newsrc-assoc)
(condition-case nil
(load ding-file t t t)
- (error nil))
+ (error
+ (gnus-message 1 "Error in %s" ding-file)
+ (ding)))
(and gnus-newsrc-assoc (setq gnus-newsrc-alist gnus-newsrc-assoc)))
(let ((inhibit-quit t))
(gnus-uncompress-newsrc-alist))
(and (or gnus-newsrc-alist gnus-killed-list)
gnus-current-startup-file
(progn
- (run-hooks 'gnus-save-newsrc-hook)
(save-excursion
(if (and (or gnus-use-dribble-file gnus-slave)
(or (not gnus-dribble-buffer)
(set-buffer gnus-dribble-buffer)
(buffer-size)))))
(gnus-message 4 "(No changes need to be saved)")
+ (run-hooks 'gnus-save-newsrc-hook)
(if gnus-slave
(gnus-slave-save-newsrc)
(if gnus-save-newsrc-file
(erase-buffer)
(gnus-message 5 "Saving %s.eld..." gnus-current-startup-file)
(gnus-gnus-to-quick-newsrc-format)
+ (run-hooks 'gnus-save-quick-newsrc-hook)
(save-buffer)
(kill-buffer (current-buffer))
(gnus-message
(if gnus-modtime-botch
(delete-file gnus-startup-file)
(clear-visited-file-modtime))
+ (run-hooks 'gnus-save-standard-newsrc-hook)
(save-buffer)
(kill-buffer (current-buffer)))))
projects / gnus / blobdiff