(require 'gnus-spec)
(require 'gnus-range)
(require 'gnus-int)
+(require 'gnus-undo)
(require 'gnus)
-
(defvar gnus-kill-summary-on-exit t
"*If non-nil, kill the summary buffer when you exit from it.
If nil, the summary will become a \"*Dead Summary*\" buffer, and
always include `gnus-thread-sort-by-number' in the list of sorting
functions -- preferably first.
-Ready-mady functions include `gnus-thread-sort-by-number',
+Ready-made functions include `gnus-thread-sort-by-number',
`gnus-thread-sort-by-author', `gnus-thread-sort-by-subject',
`gnus-thread-sort-by-date', `gnus-thread-sort-by-score' and
`gnus-thread-sort-by-total-score' (see `gnus-thread-score-function').")
"*A hook for Gnus summary mode.
This hook is run before any variables are set in the summary buffer.")
+(defvar gnus-summary-menu-hook nil
+ "*Hook run after the creation of the summary mode menu.")
+
(defvar gnus-summary-exit-hook nil
"*A hook called on exit from the summary buffer.")
The hook is intended to mark an article as read (or unread)
automatically when it is selected.")
+(defvar gnus-group-no-more-groups-hook nil
+ "*A hook run when returning to group mode having no more (unread) groups.")
+
+(defvar gnus-summary-selected-face 'underline
+ "Face used for highlighting the current article in the summary buffer.")
+
+(defvar gnus-summary-highlight
+ (cond
+ ((not (eq gnus-display-type 'color))
+ '(((> score default) . bold)
+ ((< score default) . italic)))
+ ((eq gnus-background-mode 'dark)
+ (list
+ (cons
+ '(= mark gnus-canceled-mark)
+ (custom-face-lookup "yellow" "black" nil
+ nil nil nil))
+ (cons '(and (> score default)
+ (or (= mark gnus-dormant-mark)
+ (= mark gnus-ticked-mark)))
+ (custom-face-lookup
+ "pink" nil nil t nil nil))
+ (cons '(and (< score default)
+ (or (= mark gnus-dormant-mark)
+ (= mark gnus-ticked-mark)))
+ (custom-face-lookup "pink" nil nil
+ nil t nil))
+ (cons '(or (= mark gnus-dormant-mark)
+ (= mark gnus-ticked-mark))
+ (custom-face-lookup
+ "pink" nil nil nil nil nil))
+
+ (cons
+ '(and (> score default) (= mark gnus-ancient-mark))
+ (custom-face-lookup "medium blue" nil nil t
+ nil nil))
+ (cons
+ '(and (< score default) (= mark gnus-ancient-mark))
+ (custom-face-lookup "SkyBlue" nil nil
+ nil t nil))
+ (cons
+ '(= mark gnus-ancient-mark)
+ (custom-face-lookup "SkyBlue" nil nil
+ nil nil nil))
+ (cons '(and (> score default) (= mark gnus-unread-mark))
+ (custom-face-lookup "white" nil nil t
+ nil nil))
+ (cons '(and (< score default) (= mark gnus-unread-mark))
+ (custom-face-lookup "white" nil nil
+ nil t nil))
+ (cons '(= mark gnus-unread-mark)
+ (custom-face-lookup
+ "white" nil nil nil nil nil))
+
+ (cons '(> score default) 'bold)
+ (cons '(< score default) 'italic)))
+ (t
+ (list
+ (cons
+ '(= mark gnus-canceled-mark)
+ (custom-face-lookup
+ "yellow" "black" nil nil nil nil))
+ (cons '(and (> score default)
+ (or (= mark gnus-dormant-mark)
+ (= mark gnus-ticked-mark)))
+ (custom-face-lookup "firebrick" nil nil
+ t nil nil))
+ (cons '(and (< score default)
+ (or (= mark gnus-dormant-mark)
+ (= mark gnus-ticked-mark)))
+ (custom-face-lookup "firebrick" nil nil
+ nil t nil))
+ (cons
+ '(or (= mark gnus-dormant-mark)
+ (= mark gnus-ticked-mark))
+ (custom-face-lookup
+ "firebrick" nil nil nil nil nil))
+
+ (cons '(and (> score default) (= mark gnus-ancient-mark))
+ (custom-face-lookup "RoyalBlue" nil nil
+ t nil nil))
+ (cons '(and (< score default) (= mark gnus-ancient-mark))
+ (custom-face-lookup "RoyalBlue" nil nil
+ nil t nil))
+ (cons
+ '(= mark gnus-ancient-mark)
+ (custom-face-lookup
+ "RoyalBlue" nil nil nil nil nil))
+
+ (cons '(and (> score default) (/= mark gnus-unread-mark))
+ (custom-face-lookup "DarkGreen" nil nil
+ t nil nil))
+ (cons '(and (< score default) (/= mark gnus-unread-mark))
+ (custom-face-lookup "DarkGreen" nil nil
+ nil t nil))
+ (cons
+ '(/= mark gnus-unread-mark)
+ (custom-face-lookup "DarkGreen" nil nil
+ nil nil nil))
+
+ (cons '(> score default) 'bold)
+ (cons '(< score default) 'italic))))
+ "Controls the highlighting of summary buffer lines.
+
+Below is a list of `Form'/`Face' pairs. When deciding how a a
+particular summary line should be displayed, each form is
+evaluated. The content of the face field after the first true form is
+used. You can change how those summary lines are displayed, by
+editing the face field.
+
+It is also possible to change and add form fields, but currently that
+requires an understanding of Lisp expressions. Hopefully this will
+change in a future release. For now, you can use the following
+variables in the Lisp expression:
+
+score: The article's score
+default: The default article score.
+below: The score below which articles are automatically marked as read.
+mark: The article's mark.")
+
+;;; Internal variables
+
+(defvar gnus-scores-exclude-files nil)
+
(defvar gnus-summary-display-table
;; Change the display table. Odd characters have a tendency to mess
;; up nicely formatted displays - we make all possible glyphs
(i 32))
(while (>= (setq i (1- i)) 0)
(aset table i [??]))
- ;; ... but not newline and cr, of course. (cr is necessary for the
+ ;; ... but not newline and cr, of course. (cr is necessary for the
;; selective display).
(aset table ?\n nil)
(aset table ?\r nil)
table)
"Display table used in summary mode buffers.")
-;;; Internal variables
-
-(defvar gnus-original-article-buffer " *Original Article*")
(defvar gnus-original-article nil)
(defvar gnus-article-internal-prepare-hook nil)
+(defvar gnus-newsgroup-process-stack nil)
(defvar gnus-thread-indent-array nil)
(defvar gnus-thread-indent-array-level gnus-thread-indent-level)
(?x ,(macroexpand '(mail-header-xref gnus-tmp-header)) ?s)
(?D ,(macroexpand '(mail-header-date gnus-tmp-header)) ?s)
(?d (gnus-dd-mmm (mail-header-date gnus-tmp-header)) ?s)
+ (?o (gnus-date-iso8601 gnus-tmp-header) ?s)
(?M ,(macroexpand '(mail-header-id gnus-tmp-header)) ?s)
(?r ,(macroexpand '(mail-header-references gnus-tmp-header)) ?s)
(?c (or (mail-header-chars gnus-tmp-header) 0) ?d)
(gnus-summary-mark-below . global)
gnus-newsgroup-active gnus-scores-exclude-files
gnus-newsgroup-history gnus-newsgroup-ancient
- gnus-newsgroup-sparse
+ gnus-newsgroup-sparse gnus-newsgroup-process-stack
(gnus-newsgroup-adaptive . gnus-use-adaptive-scoring)
gnus-newsgroup-adaptive-score-file (gnus-reffed-article-number . -1)
(gnus-newsgroup-expunged-tally . 0)
(replace-match "" t t))))))
(defun gnus-simplify-subject-fuzzy (subject)
- "Siplify a subject string fuzzily."
+ "Simplify a subject string fuzzily."
(save-excursion
(gnus-set-work-buffer)
(let ((case-fold-search t))
"|" gnus-summary-pipe-output
"\M-k" gnus-summary-edit-local-kill
"\M-K" gnus-summary-edit-global-kill
- "V" gnus-version
+ ;; "V" gnus-version
"\C-c\C-d" gnus-summary-describe-group
"q" gnus-summary-exit
"Q" gnus-summary-exit-no-update
"l" gnus-summary-goto-last-article
"\C-c\C-v\C-v" gnus-uu-decode-uu-view
"\C-d" gnus-summary-enter-digest-group
+ "\M-\C-d" gnus-summary-read-document
"\C-c\C-b" gnus-bug
"*" gnus-cache-enter-article
"\M-*" gnus-cache-remove-article
"K" gnus-summary-kill-same-subject
"P" gnus-uu-mark-map)
- (gnus-define-keys (gnus-summary-mscore-map "V" gnus-summary-mode-map)
+ (gnus-define-keys (gnus-summary-mscore-map "V" gnus-summary-mark-map)
"c" gnus-summary-clear-above
"u" gnus-summary-tick-above
"m" gnus-summary-mark-above
"#" gnus-uu-mark-thread
"\M-#" gnus-uu-unmark-thread)
+ (gnus-define-keys (gnus-summary-buffer-map "Y" gnus-summary-mode-map)
+ "g" gnus-summary-prepare
+ "c" gnus-summary-insert-cached-articles)
+
(gnus-define-keys (gnus-summary-exit-map "Z" gnus-summary-mode-map)
"c" gnus-summary-catchup-and-exit
"C" gnus-summary-catchup-all-and-exit
"e" gnus-article-emphasize
"w" gnus-article-fill-cited-article
"c" gnus-article-remove-cr
- "L" gnus-article-remove-trailing-blank-lines
"q" gnus-article-de-quoted-unreadable
"f" gnus-article-display-x-face
"l" gnus-summary-stop-page-breaking
"e" gnus-article-date-lapsed
"o" gnus-article-date-original)
+ (gnus-define-keys (gnus-summary-wash-empty-map "E" gnus-summary-wash-map)
+ "t" gnus-article-remove-trailing-blank-lines
+ "l" gnus-article-strip-leading-blank-lines
+ "m" gnus-article-strip-multiple-blank-lines
+ "a" gnus-article-strip-blank-lines)
+
(gnus-define-keys (gnus-summary-help-map "H" gnus-summary-mode-map)
"v" gnus-version
"f" gnus-summary-fetch-faq
"c" gnus-summary-copy-article
"B" gnus-summary-crosspost-article
"q" gnus-summary-respool-query
- "i" gnus-summary-import-article)
+ "i" gnus-summary-import-article
+ "p" gnus-summary-article-posted-p)
(gnus-define-keys (gnus-summary-save-map "O" gnus-summary-mode-map)
"o" gnus-summary-save-article
"h" gnus-summary-save-article-folder
"v" gnus-summary-save-article-vm
"p" gnus-summary-pipe-output
- "s" gnus-soup-add-article)
- )
+ "s" gnus-soup-add-article))
+
+(defun gnus-summary-make-menu-bar ()
+ (gnus-turn-off-edit-menu 'summary)
+
+ (unless (boundp 'gnus-summary-misc-menu)
+
+ (easy-menu-define
+ gnus-summary-kill-menu gnus-summary-mode-map ""
+ (cons
+ "Score"
+ (nconc
+ (list
+ ["Enter score..." gnus-summary-score-entry t])
+ (gnus-make-score-map 'increase)
+ (gnus-make-score-map 'lower)
+ '(("Mark"
+ ["Kill below" gnus-summary-kill-below t]
+ ["Mark above" gnus-summary-mark-above t]
+ ["Tick above" gnus-summary-tick-above t]
+ ["Clear above" gnus-summary-clear-above t])
+ ["Current score" gnus-summary-current-score t]
+ ["Set score" gnus-summary-set-score t]
+ ["Switch current score file..." gnus-score-change-score-file t]
+ ["Set mark below..." gnus-score-set-mark-below t]
+ ["Set expunge below..." gnus-score-set-expunge-below t]
+ ["Edit current score file" gnus-score-edit-current-scores t]
+ ["Edit score file" gnus-score-edit-file t]
+ ["Trace score" gnus-score-find-trace t]
+ ["Find words" gnus-score-find-favourite-words t]
+ ["Rescore buffer" gnus-summary-rescore t]
+ ["Increase score..." gnus-summary-increase-score t]
+ ["Lower score..." gnus-summary-lower-score t]))))
+
+ '(("Default header"
+ ["Ask" (gnus-score-set-default 'gnus-score-default-header nil)
+ :style radio
+ :selected (null gnus-score-default-header)]
+ ["From" (gnus-score-set-default 'gnus-score-default-header 'a)
+ :style radio
+ :selected (eq gnus-score-default-header 'a)]
+ ["Subject" (gnus-score-set-default 'gnus-score-default-header 's)
+ :style radio
+ :selected (eq gnus-score-default-header 's)]
+ ["Article body"
+ (gnus-score-set-default 'gnus-score-default-header 'b)
+ :style radio
+ :selected (eq gnus-score-default-header 'b )]
+ ["All headers"
+ (gnus-score-set-default 'gnus-score-default-header 'h)
+ :style radio
+ :selected (eq gnus-score-default-header 'h )]
+ ["Message-ID" (gnus-score-set-default 'gnus-score-default-header 'i)
+ :style radio
+ :selected (eq gnus-score-default-header 'i )]
+ ["Thread" (gnus-score-set-default 'gnus-score-default-header 't)
+ :style radio
+ :selected (eq gnus-score-default-header 't )]
+ ["Crossposting"
+ (gnus-score-set-default 'gnus-score-default-header 'x)
+ :style radio
+ :selected (eq gnus-score-default-header 'x )]
+ ["Lines" (gnus-score-set-default 'gnus-score-default-header 'l)
+ :style radio
+ :selected (eq gnus-score-default-header 'l )]
+ ["Date" (gnus-score-set-default 'gnus-score-default-header 'd)
+ :style radio
+ :selected (eq gnus-score-default-header 'd )]
+ ["Followups to author"
+ (gnus-score-set-default 'gnus-score-default-header 'f)
+ :style radio
+ :selected (eq gnus-score-default-header 'f )])
+ ("Default type"
+ ["Ask" (gnus-score-set-default 'gnus-score-default-type nil)
+ :style radio
+ :selected (null gnus-score-default-type)]
+ ;; The `:active' key is commented out in the following,
+ ;; because the GNU Emacs hack to support radio buttons use
+ ;; active to indicate which button is selected.
+ ["Substring" (gnus-score-set-default 'gnus-score-default-type 's)
+ :style radio
+ ;; :active (not (memq gnus-score-default-header '(l d)))
+ :selected (eq gnus-score-default-type 's)]
+ ["Regexp" (gnus-score-set-default 'gnus-score-default-type 'r)
+ :style radio
+ ;; :active (not (memq gnus-score-default-header '(l d)))
+ :selected (eq gnus-score-default-type 'r)]
+ ["Exact" (gnus-score-set-default 'gnus-score-default-type 'e)
+ :style radio
+ ;; :active (not (memq gnus-score-default-header '(l d)))
+ :selected (eq gnus-score-default-type 'e)]
+ ["Fuzzy" (gnus-score-set-default 'gnus-score-default-type 'f)
+ :style radio
+ ;; :active (not (memq gnus-score-default-header '(l d)))
+ :selected (eq gnus-score-default-type 'f)]
+ ["Before date" (gnus-score-set-default 'gnus-score-default-type 'b)
+ :style radio
+ ;; :active (eq (gnus-score-default-header 'd))
+ :selected (eq gnus-score-default-type 'b)]
+ ["At date" (gnus-score-set-default 'gnus-score-default-type 'n)
+ :style radio
+ ;; :active (eq (gnus-score-default-header 'd))
+ :selected (eq gnus-score-default-type 'n)]
+ ["After date" (gnus-score-set-default 'gnus-score-default-type 'a)
+ :style radio
+ ;; :active (eq (gnus-score-default-header 'd))
+ :selected (eq gnus-score-default-type 'a)]
+ ["Less than number"
+ (gnus-score-set-default 'gnus-score-default-type '<)
+ :style radio
+ ;; :active (eq (gnus-score-default-header 'l))
+ :selected (eq gnus-score-default-type '<)]
+ ["Equal to number"
+ (gnus-score-set-default 'gnus-score-default-type '=)
+ :style radio
+ ;; :active (eq (gnus-score-default-header 'l))
+ :selected (eq gnus-score-default-type '=)]
+ ["Greater than number"
+ (gnus-score-set-default 'gnus-score-default-type '>)
+ :style radio
+ ;; :active (eq (gnus-score-default-header 'l))
+ :selected (eq gnus-score-default-type '>)])
+ ["Default fold" gnus-score-default-fold-toggle
+ :style toggle
+ :selected gnus-score-default-fold]
+ ("Default duration"
+ ["Ask" (gnus-score-set-default 'gnus-score-default-duration nil)
+ :style radio
+ :selected (null gnus-score-default-duration)]
+ ["Permanent"
+ (gnus-score-set-default 'gnus-score-default-duration 'p)
+ :style radio
+ :selected (eq gnus-score-default-duration 'p)]
+ ["Temporary"
+ (gnus-score-set-default 'gnus-score-default-duration 't)
+ :style radio
+ :selected (eq gnus-score-default-duration 't)]
+ ["Immediate"
+ (gnus-score-set-default 'gnus-score-default-duration 'i)
+ :style radio
+ :selected (eq gnus-score-default-duration 'i)]))
+
+ (easy-menu-define
+ gnus-summary-article-menu gnus-summary-mode-map ""
+ '("Article"
+ ("Hide"
+ ["All" gnus-article-hide t]
+ ["Headers" gnus-article-hide-headers t]
+ ["Signature" gnus-article-hide-signature t]
+ ["Citation" gnus-article-hide-citation t]
+ ["PGP" gnus-article-hide-pgp t]
+ ["Boring headers" gnus-article-hide-boring-headers t])
+ ("Highlight"
+ ["All" gnus-article-highlight t]
+ ["Headers" gnus-article-highlight-headers t]
+ ["Signature" gnus-article-highlight-signature t]
+ ["Citation" gnus-article-highlight-citation t])
+ ("Date"
+ ["Local" gnus-article-date-local t]
+ ["UT" gnus-article-date-ut t]
+ ["Original" gnus-article-date-original t]
+ ["Lapsed" gnus-article-date-lapsed t])
+ ("Filter"
+ ("Remove Blanks"
+ ["Leading" gnus-article-strip-leading-blank-lines t]
+ ["Multiple" gnus-article-strip-multiple-blank-lines t]
+ ["Trailing" gnus-article-remove-trailing-blank-lines t]
+ ["All of the above" gnus-article-strip-blank-lines t])
+ ["Overstrike" gnus-article-treat-overstrike t]
+ ["Emphasis" gnus-article-emphasize t]
+ ["Word wrap" gnus-article-fill-cited-article t]
+ ["CR" gnus-article-remove-cr t]
+ ["Show X-Face" gnus-article-display-x-face t]
+ ["Quoted-Printable" gnus-article-de-quoted-unreadable t]
+ ["Rot 13" gnus-summary-caesar-message t]
+ ["Add buttons" gnus-article-add-buttons t]
+ ["Add buttons to head" gnus-article-add-buttons-to-head t]
+ ["Stop page breaking" gnus-summary-stop-page-breaking t]
+ ["Toggle MIME" gnus-summary-toggle-mime t]
+ ["Verbose header" gnus-summary-verbose-headers t]
+ ["Toggle header" gnus-summary-toggle-header t])
+ ("Output"
+ ["Save in default format" gnus-summary-save-article t]
+ ["Save in file" gnus-summary-save-article-file t]
+ ["Save in Unix mail format" gnus-summary-save-article-mail t]
+ ["Save in MH folder" gnus-summary-save-article-folder t]
+ ["Save in VM folder" gnus-summary-save-article-vm t]
+ ["Save in RMAIL mbox" gnus-summary-save-article-rmail t]
+ ["Save body in file" gnus-summary-save-article-body-file t]
+ ["Pipe through a filter" gnus-summary-pipe-output t]
+ ["Add to SOUP packet" gnus-soup-add-article t])
+ ("Backend"
+ ["Respool article..." gnus-summary-respool-article t]
+ ["Move article..." gnus-summary-move-article
+ (gnus-check-backend-function
+ 'request-move-article gnus-newsgroup-name)]
+ ["Copy article..." gnus-summary-copy-article t]
+ ["Crosspost article..." gnus-summary-crosspost-article
+ (gnus-check-backend-function
+ 'request-replace-article gnus-newsgroup-name)]
+ ["Import file..." gnus-summary-import-article t]
+ ["Check if posted" gnus-summary-article-posted-p t]
+ ["Edit article" gnus-summary-edit-article
+ (not (gnus-group-read-only-p))]
+ ["Delete article" gnus-summary-delete-article
+ (gnus-check-backend-function
+ 'request-expire-articles gnus-newsgroup-name)]
+ ["Query respool" gnus-summary-respool-query t]
+ ["Delete expirable articles" gnus-summary-expire-articles-now
+ (gnus-check-backend-function
+ 'request-expire-articles gnus-newsgroup-name)])
+ ("Extract"
+ ["Uudecode" gnus-uu-decode-uu t]
+ ["Uudecode and save" gnus-uu-decode-uu-and-save t]
+ ["Unshar" gnus-uu-decode-unshar t]
+ ["Unshar and save" gnus-uu-decode-unshar-and-save t]
+ ["Save" gnus-uu-decode-save t]
+ ["Binhex" gnus-uu-decode-binhex t]
+ ["Postscript" gnus-uu-decode-postscript t])
+ ["Enter digest buffer" gnus-summary-enter-digest-group t]
+ ["Isearch article..." gnus-summary-isearch-article t]
+ ["Search articles forward..." gnus-summary-search-article-forward t]
+ ["Search articles backward..." gnus-summary-search-article-backward t]
+ ["Beginning of the article" gnus-summary-beginning-of-article t]
+ ["End of the article" gnus-summary-end-of-article t]
+ ["Fetch parent of article" gnus-summary-refer-parent-article t]
+ ["Fetch referenced articles" gnus-summary-refer-references t]
+ ["Fetch article with id..." gnus-summary-refer-article t]
+ ["Redisplay" gnus-summary-show-article t]))
+
+ (easy-menu-define
+ gnus-summary-thread-menu gnus-summary-mode-map ""
+ '("Threads"
+ ["Toggle threading" gnus-summary-toggle-threads t]
+ ["Hide threads" gnus-summary-hide-all-threads t]
+ ["Show threads" gnus-summary-show-all-threads t]
+ ["Hide thread" gnus-summary-hide-thread t]
+ ["Show thread" gnus-summary-show-thread t]
+ ["Go to next thread" gnus-summary-next-thread t]
+ ["Go to previous thread" gnus-summary-prev-thread t]
+ ["Go down thread" gnus-summary-down-thread t]
+ ["Go up thread" gnus-summary-up-thread t]
+ ["Top of thread" gnus-summary-top-thread 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]
+ ))
+
+ (easy-menu-define
+ gnus-summary-post-menu gnus-summary-mode-map ""
+ '("Post"
+ ["Post an article" gnus-summary-post-news t]
+ ["Followup" gnus-summary-followup t]
+ ["Followup and yank" gnus-summary-followup-with-original t]
+ ["Supersede article" gnus-summary-supersede-article t]
+ ["Cancel article" gnus-summary-cancel-article t]
+ ["Reply" gnus-summary-reply t]
+ ["Reply and yank" gnus-summary-reply-with-original t]
+ ["Mail forward" gnus-summary-mail-forward t]
+ ["Post forward" gnus-summary-post-forward t]
+ ["Digest and mail" gnus-uu-digest-mail-forward t]
+ ["Digest and post" gnus-uu-digest-post-forward t]
+ ["Resend message" gnus-summary-resend-message t]
+ ["Send bounced mail" gnus-summary-resend-bounced-mail t]
+ ["Send a mail" gnus-summary-mail-other-window t]
+ ["Uuencode and post" gnus-uu-post-news t]
+ ;;("Draft"
+ ;;["Send" gnus-summary-send-draft t]
+ ;;["Send bounced" gnus-resend-bounced-mail t])
+ ))
+
+ (easy-menu-define
+ gnus-summary-misc-menu gnus-summary-mode-map ""
+ '("Misc"
+ ("Mark"
+ ("Read"
+ ["Mark as read" gnus-summary-mark-as-read-forward t]
+ ["Mark same subject and select"
+ gnus-summary-kill-same-subject-and-select t]
+ ["Mark same subject" gnus-summary-kill-same-subject t]
+ ["Catchup" gnus-summary-catchup t]
+ ["Catchup all" gnus-summary-catchup-all t]
+ ["Catchup to here" gnus-summary-catchup-to-here t]
+ ["Catchup region" gnus-summary-mark-region-as-read t]
+ ["Mark excluded" gnus-summary-limit-mark-excluded-as-read t])
+ ("Various"
+ ["Tick" gnus-summary-tick-article-forward t]
+ ["Mark as dormant" gnus-summary-mark-as-dormant t]
+ ["Remove marks" gnus-summary-clear-mark-forward t]
+ ["Set expirable mark" gnus-summary-mark-as-expirable t]
+ ["Set bookmark" gnus-summary-set-bookmark t]
+ ["Remove bookmark" gnus-summary-remove-bookmark t])
+ ("Limit"
+ ["Marks..." gnus-summary-limit-to-marks t]
+ ["Subject..." gnus-summary-limit-to-subject t]
+ ["Author..." gnus-summary-limit-to-author t]
+ ["Score" gnus-summary-limit-to-score t]
+ ["Unread" gnus-summary-limit-to-unread t]
+ ["Non-dormant" gnus-summary-limit-exclude-dormant t]
+ ["Articles" gnus-summary-limit-to-articles t]
+ ["Pop limit" gnus-summary-pop-limit t]
+ ["Show dormant" gnus-summary-limit-include-dormant t]
+ ["Hide childless dormant"
+ gnus-summary-limit-exclude-childless-dormant t]
+ ;;["Hide thread" gnus-summary-limit-exclude-thread t]
+ ["Show expunged" gnus-summary-show-all-expunged t])
+ ("Process mark"
+ ["Set mark" gnus-summary-mark-as-processable t]
+ ["Remove mark" gnus-summary-unmark-as-processable t]
+ ["Remove all marks" gnus-summary-unmark-all-processable t]
+ ["Mark above" gnus-uu-mark-over t]
+ ["Mark series" gnus-uu-mark-series t]
+ ["Mark region" gnus-uu-mark-region t]
+ ["Mark by regexp..." gnus-uu-mark-by-regexp t]
+ ["Mark all" gnus-uu-mark-all t]
+ ["Mark buffer" gnus-uu-mark-buffer t]
+ ["Mark sparse" gnus-uu-mark-sparse t]
+ ["Mark thread" gnus-uu-mark-thread t]
+ ["Unmark thread" gnus-uu-unmark-thread t]
+ ("Process Mark Sets"
+ ["Kill" gnus-summary-kill-process-mark t]
+ ["Yank" gnus-summary-yank-process-mark
+ gnus-newsgroup-process-stack]
+ ["Save" gnus-summary-save-process-mark t])))
+ ("Scroll article"
+ ["Page forward" gnus-summary-next-page t]
+ ["Page backward" gnus-summary-prev-page t]
+ ["Line forward" gnus-summary-scroll-up t])
+ ("Move"
+ ["Next unread article" gnus-summary-next-unread-article t]
+ ["Previous unread article" gnus-summary-prev-unread-article t]
+ ["Next article" gnus-summary-next-article t]
+ ["Previous article" gnus-summary-prev-article t]
+ ["Next unread subject" gnus-summary-next-unread-subject t]
+ ["Previous unread subject" gnus-summary-prev-unread-subject t]
+ ["Next article same subject" gnus-summary-next-same-subject t]
+ ["Previous article same subject" gnus-summary-prev-same-subject t]
+ ["First unread article" gnus-summary-first-unread-article t]
+ ["Best unread article" gnus-summary-best-unread-article t]
+ ["Go to subject number..." gnus-summary-goto-subject t]
+ ["Go to article number..." gnus-summary-goto-article t]
+ ["Go to the last article" gnus-summary-goto-last-article t]
+ ["Pop article off history" gnus-summary-pop-article t])
+ ("Sort"
+ ["Sort by number" gnus-summary-sort-by-number t]
+ ["Sort by author" gnus-summary-sort-by-author t]
+ ["Sort by subject" gnus-summary-sort-by-subject t]
+ ["Sort by date" gnus-summary-sort-by-date t]
+ ["Sort by score" gnus-summary-sort-by-score t])
+ ("Help"
+ ["Fetch group FAQ" gnus-summary-fetch-faq t]
+ ["Describe group" gnus-summary-describe-group t]
+ ["Read manual" gnus-info-find-node t])
+ ("Cache"
+ ["Enter article" gnus-cache-enter-article t]
+ ["Remove article" gnus-cache-remove-article t])
+ ("Modes"
+ ["Pick and read" gnus-pick-mode t]
+ ["Binary" gnus-binary-mode t])
+ ["Filter articles..." gnus-summary-execute-command t]
+ ["Run command on subjects..." gnus-summary-universal-argument t]
+ ["Toggle line truncation" gnus-summary-toggle-truncation t]
+ ["Expand window" gnus-summary-expand-window t]
+ ["Expire expirable articles" gnus-summary-expire-articles
+ (gnus-check-backend-function
+ 'request-expire-articles gnus-newsgroup-name)]
+ ["Regenerate buffer" gnus-summary-prepare t]
+ ["Edit local kill file" gnus-summary-edit-local-kill t]
+ ["Edit main kill file" gnus-summary-edit-global-kill t]
+ ("Exit"
+ ["Catchup and exit" gnus-summary-catchup-and-exit t]
+ ["Catchup all and exit" gnus-summary-catchup-and-exit t]
+ ["Catchup and goto next" gnus-summary-catchup-and-goto-next-group t]
+ ["Exit group" gnus-summary-exit t]
+ ["Exit group without updating" gnus-summary-exit-no-update t]
+ ["Exit and goto next group" gnus-summary-next-group t]
+ ["Exit and goto prev group" gnus-summary-prev-group t]
+ ["Reselect group" gnus-summary-reselect-current-group t]
+ ["Rescan group" gnus-summary-rescan-group t])))
+
+ (run-hooks 'gnus-summary-menu-hook)))
+
+(defun gnus-score-set-default (var value)
+ "A version of set that updates the GNU Emacs menu-bar."
+ (set var value)
+ ;; It is the message that forces the active status to be updated.
+ (message ""))
+
+(defun gnus-make-score-map (type)
+ "Make a summary score map of type TYPE."
+ (if t
+ nil
+ (let ((headers '(("author" "from" string)
+ ("subject" "subject" string)
+ ("article body" "body" string)
+ ("article head" "head" string)
+ ("xref" "xref" string)
+ ("lines" "lines" number)
+ ("followups to author" "followup" string)))
+ (types '((number ("less than" <)
+ ("greater than" >)
+ ("equal" =))
+ (string ("substring" s)
+ ("exact string" e)
+ ("fuzzy string" f)
+ ("regexp" r))))
+ (perms '(("temporary" (current-time-string))
+ ("permanent" nil)
+ ("immediate" now)))
+ header)
+ (list
+ (apply
+ 'nconc
+ (list
+ (if (eq type 'lower)
+ "Lower score"
+ "Increase score"))
+ (let (outh)
+ (while headers
+ (setq header (car headers))
+ (setq outh
+ (cons
+ (apply
+ 'nconc
+ (list (car header))
+ (let ((ts (cdr (assoc (nth 2 header) types)))
+ outt)
+ (while ts
+ (setq outt
+ (cons
+ (apply
+ 'nconc
+ (list (caar ts))
+ (let ((ps perms)
+ outp)
+ (while ps
+ (setq outp
+ (cons
+ (vector
+ (caar ps)
+ (list
+ 'gnus-summary-score-entry
+ (nth 1 header)
+ (if (or (string= (nth 1 header)
+ "head")
+ (string= (nth 1 header)
+ "body"))
+ ""
+ (list 'gnus-summary-header
+ (nth 1 header)))
+ (list 'quote (nth 1 (car ts)))
+ (list 'gnus-score-default nil)
+ (nth 1 (car ps))
+ t)
+ t)
+ outp))
+ (setq ps (cdr ps)))
+ (list (nreverse outp))))
+ outt))
+ (setq ts (cdr ts)))
+ (list (nreverse outt))))
+ outh))
+ (setq headers (cdr headers)))
+ (list (nreverse outh))))))))
\f
(setq selective-display t)
(setq selective-display-ellipses t) ;Display `...'
(setq buffer-display-table gnus-summary-display-table)
+ (gnus-set-default-directory)
(setq gnus-newsgroup-name group)
(make-local-variable 'gnus-summary-line-format)
(make-local-variable 'gnus-summary-line-format-spec)
(defmacro gnus-summary-skip-intangible ()
"If the current article is intangible, then jump to a different article."
'(let ((to (get-text-property (point) 'gnus-intangible)))
- (and to (gnus-summary-goto-subject to))))
+ (and to (gnus-summary-goto-subject to))))
(defmacro gnus-summary-article-intangible-p ()
"Say whether this article is intangible or not."
'(get-text-property (point) 'gnus-intangible))
+(defun gnus-article-read-p (article)
+ "Say whether ARTICLE is read or not."
+ (not (or (memq article gnus-newsgroup-marked)
+ (memq article gnus-newsgroup-unreads)
+ (memq article gnus-newsgroup-unselected)
+ (memq article gnus-newsgroup-dormant))))
+
;; Some summary mode macros.
(defmacro gnus-summary-article-number ()
(gnus-data-list t)))
(level (gnus-data-level (car data))))
(if (zerop level)
- () ; This is a root.
+ () ; This is a root.
;; We search until we find an article with a level less than
;; this one. That function has to be the parent.
(while (and (setq data (cdr data))
(= mark gnus-dormant-mark)
(= mark gnus-expirable-mark))))
+(defmacro gnus-article-mark (number)
+ `(cond
+ ((memq ,number gnus-newsgroup-unreads) gnus-unread-mark)
+ ((memq ,number gnus-newsgroup-marked) gnus-ticked-mark)
+ ((memq ,number gnus-newsgroup-dormant) gnus-dormant-mark)
+ ((memq ,number gnus-newsgroup-expirable) gnus-expirable-mark)
+ (t (or (cdr (assq ,number gnus-newsgroup-reads))
+ gnus-ancient-mark))))
+
;; Saving hidden threads.
(put 'gnus-save-hidden-threads 'lisp-indent-function 0)
(let ((config (make-symbol "config")))
`(let ((,config (gnus-hidden-threads-configuration)))
(unwind-protect
- (progn
+ (save-excursion
,@forms)
(gnus-restore-hidden-threads-configuration ,config)))))
(setq gnus-article-buffer article-buffer)
(setq gnus-original-article-buffer original)
(setq gnus-reffed-article-number reffed)
- (setq gnus-current-score-file score-file)))))
+ (setq gnus-current-score-file score-file)
+ ;; The article buffer also has local variables.
+ (when (gnus-buffer-live-p gnus-article-buffer)
+ (set-buffer gnus-article-buffer)
+ (setq gnus-summary-buffer summary))))))
(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. :-)
+ t ; All non-existent numbers are the last article. :-)
(not (cdr (gnus-data-find-list article)))))
(defun gnus-make-thread-indent-array ()
(point) (progn (eval gnus-summary-dummy-line-format-spec) (point))
(list 'gnus-number gnus-tmp-number 'gnus-intangible gnus-tmp-number)))
-(defun gnus-summary-insert-line
- (gnus-tmp-header gnus-tmp-level gnus-tmp-current gnus-tmp-unread
- gnus-tmp-replied gnus-tmp-expirable gnus-tmp-subject-or-nil
- &optional gnus-tmp-dummy gnus-tmp-score gnus-tmp-process)
+(defun gnus-summary-insert-line (gnus-tmp-header
+ gnus-tmp-level gnus-tmp-current
+ gnus-tmp-unread gnus-tmp-replied
+ gnus-tmp-expirable gnus-tmp-subject-or-nil
+ &optional gnus-tmp-dummy gnus-tmp-score
+ gnus-tmp-process)
(let* ((gnus-tmp-indentation (aref gnus-thread-indent-array gnus-tmp-level))
(gnus-tmp-lines (mail-header-lines gnus-tmp-header))
(gnus-tmp-score (or gnus-tmp-score gnus-summary-default-score 0))
(defvar gnus-tmp-new-adopts nil)
(defun gnus-summary-number-of-articles-in-thread (thread &optional level char)
- ;; Sum up all elements (and sub-elements) in a list.
+ "Return the number of articles in THREAD.
+This may be 0 in some cases -- if none of the articles in
+the thread are to be displayed."
(let* ((number
;; Fix by Luc Van Eycken <Luc.VanEycken@esat.kuleuven.ac.be>.
(cond
+ ((not (listp thread))
+ 1)
((and (consp thread) (cdr thread))
(apply
'+ 1 (mapcar
number)))
(defun gnus-summary-set-local-parameters (group)
- "Go through the local params of GROUP and set all variable specs in that list."
- (let ((params (gnus-info-params (gnus-get-info group)))
+ "Go through the local params of GROUP and set all variable specs in that list."
+ (let ((params (gnus-group-find-parameter group))
elem)
(while params
(setq elem (car params)
(run-hooks 'gnus-select-group-hook)
;; Set any local variables in the group parameters.
(gnus-summary-set-local-parameters gnus-newsgroup-name)
- (gnus-update-format-specifications)
+ (gnus-update-format-specifications
+ nil 'summary 'summary-mode 'summary-dummy)
;; Do score processing.
(when gnus-use-scoring
(gnus-possibly-score-headers))
(when kill-buffer
(gnus-kill-or-deaden-summary kill-buffer))
(when (get-buffer-window gnus-group-buffer t)
- ;; Gotta use windows, because recenter does wierd stuff if
+ ;; Gotta use windows, because recenter does weird stuff if
;; the current buffer ain't the displayed window.
(let ((owin (selected-window)))
(select-window (get-buffer-window gnus-group-buffer t))
(defun gnus-summary-prepare ()
"Generate the summary buffer."
+ (interactive)
(let ((buffer-read-only nil))
(erase-buffer)
(setq gnus-newsgroup-data nil
(thhashtb (gnus-make-hashtable 1023))
(prev threads)
(result threads)
- ids references id gthread gid entered)
+ ids references id gthread gid entered ref)
(while threads
(when (setq references (mail-header-references (caar threads)))
- (setq id (mail-header-id (caar threads)))
- (setq ids (gnus-split-references references))
- (setq entered nil)
- (while ids
- (if (not (setq gid (gnus-gethash (car ids) idhashtb)))
+ (setq id (mail-header-id (caar threads))
+ ids (gnus-split-references references)
+ entered nil)
+ (while (setq ref (pop ids))
+ (setq ids (delete ref ids))
+ (if (not (setq gid (gnus-gethash ref idhashtb)))
(progn
- (gnus-sethash (car ids) id idhashtb)
+ (gnus-sethash ref id idhashtb)
(gnus-sethash id threads thhashtb))
(setq gthread (gnus-gethash gid thhashtb))
(unless entered
(setq entered t)
;; Remove it from the list of threads.
(setcdr prev (cdr threads))
- (setq threads prev))
- (setq ids (cdr ids))))
+ (setq threads prev))))
(setq prev threads)
(setq threads (cdr threads)))
result))
header references generation relations
cthread subject child end pthread relation)
;; First we create an alist of generations/relations, where
- ;; generations is how much we trust the ralation, and the relation
+ ;; generations is how much we trust the relation, and the relation
;; is parent/child.
(gnus-message 7 "Making sparse threads...")
(save-excursion
(delq number gnus-newsgroup-unselected)))
(push number gnus-newsgroup-ancient)))))))
+(defun gnus-summary-update-article-line (article header)
+ "Update the line for ARTICLE using HEADERS."
+ (let* ((id (mail-header-id header))
+ (thread (gnus-id-to-thread id)))
+ (unless thread
+ (error "Article in no thread"))
+ ;; Update the thread.
+ (setcar thread header)
+ (gnus-summary-goto-subject article)
+ (let* ((datal (gnus-data-find-list article))
+ (data (car datal))
+ (length (when (cdr datal)
+ (- (gnus-data-pos data)
+ (gnus-data-pos (cadr datal)))))
+ (buffer-read-only nil)
+ (level (gnus-summary-thread-level)))
+ (gnus-delete-line)
+ (gnus-summary-insert-line
+ header level nil (gnus-article-mark article)
+ (memq article gnus-newsgroup-replied)
+ (memq article gnus-newsgroup-expirable)
+ (mail-header-subject header)
+ nil (cdr (assq article gnus-newsgroup-scored))
+ (memq article gnus-newsgroup-processable))
+ (when length
+ (gnus-data-update-list
+ (cdr datal) (- length (- (gnus-data-pos data) (point))))))))
+
(defun gnus-summary-update-article (article &optional iheader)
"Update ARTICLE in the summary buffer."
(set-buffer gnus-summary-buffer)
(setq thread (cdr thread))
(while thread
(unless (memq (setq thr (gnus-id-to-thread
- (gnus-root-id
- (mail-header-id (caar thread)))))
+ (gnus-root-id
+ (mail-header-id (caar thread)))))
roots)
(push thr roots))
(setq thread (cdr thread)))
(setq thread (gnus-gethash last-id dep)))
(when thread
(prog1
- thread ; We return this thread.
+ thread ; We return this thread.
(unless dont-remove
(if (stringp (car thread))
(progn
"Sort THREADS."
(if (not gnus-thread-sort-functions)
threads
- (let ((func (if (= 1 (length gnus-thread-sort-functions))
- (car gnus-thread-sort-functions)
- `(lambda (t1 t2)
- ,(gnus-make-sort-function
- (reverse gnus-thread-sort-functions))))))
- (gnus-message 7 "Sorting threads...")
- (prog1
- (sort threads func)
- (gnus-message 7 "Sorting threads...done")))))
+ (gnus-message 7 "Sorting threads...")
+ (prog1
+ (sort threads (gnus-make-sort-function gnus-thread-sort-functions))
+ (gnus-message 7 "Sorting threads...done"))))
(defun gnus-sort-articles (articles)
"Sort ARTICLES."
(when gnus-article-sort-functions
- (let ((func (if (= 1 (length gnus-article-sort-functions))
- (car gnus-article-sort-functions)
- `(lambda (t1 t2)
- ,(gnus-make-sort-function
- (reverse gnus-article-sort-functions))))))
- (gnus-message 7 "Sorting articles...")
- (prog1
- (setq gnus-newsgroup-headers (sort articles func))
- (gnus-message 7 "Sorting articles...done")))))
+ (gnus-message 7 "Sorting articles...")
+ (prog1
+ (setq gnus-newsgroup-headers
+ (sort articles (gnus-make-sort-function
+ gnus-article-sort-functions)))
+ (gnus-message 7 "Sorting articles...done"))))
;; Written by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>.
(defmacro gnus-thread-header (thread)
(mapcar 'gnus-thread-total-score
(cdr (gnus-gethash (mail-header-id root)
gnus-newsgroup-dependencies)))
- (if (> (mail-header-number root) 0)
- (list (or (cdr (assq (mail-header-number root)
- gnus-newsgroup-scored))
- gnus-summary-default-score 0))))
+ (if (> (mail-header-number root) 0)
+ (list (or (cdr (assq (mail-header-number root)
+ gnus-newsgroup-scored))
+ gnus-summary-default-score 0))))
(list gnus-summary-default-score)
'(0))))
(setq gnus-tmp-dummy-line nil))
;; Compute the mark.
- (setq
- gnus-tmp-unread
- (cond
- ((memq number gnus-newsgroup-unreads) gnus-unread-mark)
- ((memq number gnus-newsgroup-marked) gnus-ticked-mark)
- ((memq number gnus-newsgroup-dormant) gnus-dormant-mark)
- ((memq number gnus-newsgroup-expirable) gnus-expirable-mark)
- (t (or (cdr (assq number gnus-newsgroup-reads))
- gnus-ancient-mark))))
+ (setq gnus-tmp-unread (gnus-article-mark number))
(push (gnus-data-make number gnus-tmp-unread (1+ (point))
gnus-tmp-header gnus-tmp-level)
(push (cons number gnus-low-score-mark)
gnus-newsgroup-reads)))
- (setq mark
- (cond
- ((memq number gnus-newsgroup-marked) gnus-ticked-mark)
- ((memq number gnus-newsgroup-dormant) gnus-dormant-mark)
- ((memq number gnus-newsgroup-unreads) gnus-unread-mark)
- ((memq number gnus-newsgroup-expirable) gnus-expirable-mark)
- (t (or (cdr (assq number gnus-newsgroup-reads))
- gnus-ancient-mark))))
+ (setq mark (gnus-article-mark number))
(setq gnus-newsgroup-data
(cons (gnus-data-make number mark (1+ (point)) header 0)
gnus-newsgroup-data))
;; are no unread articles.
(if (or read-all
(and (zerop (length gnus-newsgroup-marked))
- (zerop (length gnus-newsgroup-unreads))))
+ (zerop (length gnus-newsgroup-unreads)))
+ (eq (gnus-group-find-parameter group 'display)
+ 'all))
(gnus-uncompress-range (gnus-active group))
(sort (append gnus-newsgroup-dormant gnus-newsgroup-marked
(copy-sequence gnus-newsgroup-unreads))
xref-hashtb)))))
(defun gnus-group-make-articles-read (group articles)
+ "Update the info of GROUP to say that only ARTICLES are unread."
(let* ((num 0)
(entry (gnus-gethash group gnus-newsrc-hashtb))
(info (nth 2 entry))
(when (or (> id (cdr active))
(< id (car active)))
(setq articles (delq id articles))))))
+ (gnus-undo-register
+ `(progn
+ (gnus-info-set-marks ,info ,(gnus-info-marks info))
+ (gnus-info-set-read ,info ,(gnus-info-read info))
+ (gnus-group-update-group group t)))
;; If the read list is nil, we init it.
(and active
(null (gnus-info-read info))
(gnus-info-read info) (setq articles (sort articles '<)))))
;; Then we have to re-compute how many unread
;; articles there are in this group.
- (if active
- (progn
- (cond
- ((not range)
- (setq num (- (1+ (cdr active)) (car active))))
- ((not (listp (cdr range)))
- (setq num (- (cdr active) (- (1+ (cdr range))
- (car range)))))
- (t
- (while range
- (if (numberp (car range))
- (setq num (1+ num))
- (setq num (+ num (- (1+ (cdar range)) (caar range)))))
- (setq range (cdr range)))
- (setq num (- (cdr active) num))))
- ;; Update the number of unread articles.
- (setcar entry num)
- ;; Update the group buffer.
- (gnus-group-update-group group t)))))
+ (when active
+ (cond
+ ((not range)
+ (setq num (- (1+ (cdr active)) (car active))))
+ ((not (listp (cdr range)))
+ (setq num (- (cdr active) (- (1+ (cdr range))
+ (car range)))))
+ (t
+ (while range
+ (if (numberp (car range))
+ (setq num (1+ num))
+ (setq num (+ num (- (1+ (cdar range)) (caar range)))))
+ (setq range (cdr range)))
+ (setq num (- (cdr active) num))))
+ ;; Update the number of unread articles.
+ (setcar entry num)
+ ;; Update the group buffer.
+ (gnus-group-update-group group t))))
(defun gnus-methods-equal-p (m1 m2)
(let ((m1 (or m1 gnus-select-method))
headers id id-dep ref-dep end ref)
(save-excursion
(set-buffer nntp-server-buffer)
+ ;; Translate all TAB characters into SPACE characters.
+ (subst-char-in-region (point-min) (point-max) ?\t ? t)
(run-hooks 'gnus-parse-headers-hook)
(let ((case-fold-search t)
in-reply-to header p lines)
(goto-char p)
(and (search-forward "\nxref: " nil t)
(gnus-header-value)))))
+ (when (equal id ref)
+ (setq ref nil))
;; We do the threading while we read the headers. The
;; message-id and the last reference are both entered into
;; the same hash table. Some tippy-toeing around has to be
(defmacro gnus-nov-field ()
'(buffer-substring (point) (if (gnus-nov-skip-field) (1- (point)) eol)))
-;; Goes through the xover lines and returns a list of vectors
-(defun gnus-get-newsgroup-headers-xover (sequence &optional
- force-new dependencies)
- "Parse the news overview data in the server buffer, and return a
-list of headers that match SEQUENCE (see `nntp-retrieve-headers')."
- ;; Get the Xref when the users reads the articles since most/some
- ;; NNTP servers do not include Xrefs when using XOVER.
- (setq gnus-article-internal-prepare-hook '(gnus-article-get-xrefs))
- (let ((cur nntp-server-buffer)
- (dependencies (or dependencies gnus-newsgroup-dependencies))
- number headers header)
- (save-excursion
- (set-buffer nntp-server-buffer)
- ;; Allow the user to mangle the headers before parsing them.
- (run-hooks 'gnus-parse-headers-hook)
- (goto-char (point-min))
- (while (and sequence (not (eobp)))
- (setq number (read cur))
- (while (and sequence (< (car sequence) number))
- (setq sequence (cdr sequence)))
- (and sequence
- (eq number (car sequence))
- (progn
- (setq sequence (cdr sequence))
- (if (setq header
- (inline (gnus-nov-parse-line
- number dependencies force-new)))
- (setq headers (cons header headers)))))
- (forward-line 1))
- (setq headers (nreverse headers)))
- headers))
-
;; This function has to be called with point after the article number
;; on the beginning of the line.
(defun gnus-nov-parse-line (number dependencies &optional force-new)
(narrow-to-region (point) eol)
(or (eobp) (forward-char))
- (condition-case nil
- (setq header
- (vector
- number ; number
- (gnus-nov-field) ; subject
- (gnus-nov-field) ; from
- (gnus-nov-field) ; date
- (setq id (or (gnus-nov-field)
- (concat "none+"
- (int-to-string
- (setq none (1+ none)))))) ; id
- (progn
- (save-excursion
- (let ((beg (point)))
- (search-forward "\t" eol)
- (if (search-backward ">" beg t)
- (setq ref
- (buffer-substring
- (1+ (point))
- (search-backward "<" beg t)))
- (setq ref nil))))
- (gnus-nov-field)) ; refs
- (gnus-nov-read-integer) ; chars
- (gnus-nov-read-integer) ; lines
- (if (= (following-char) ?\n)
- nil
- (gnus-nov-field)) ; misc
- ))
- (error (progn
- (gnus-error 4 "Strange nov line")
- (setq header nil)
- (goto-char eol))))
+ (setq header
+ (vector
+ number ; number
+ (gnus-nov-field) ; subject
+ (gnus-nov-field) ; from
+ (gnus-nov-field) ; date
+ (setq id (or (gnus-nov-field)
+ (concat "none+"
+ (int-to-string
+ (setq none (1+ none)))))) ; id
+ (progn
+ (save-excursion
+ (let ((beg (point)))
+ (search-forward "\t" eol)
+ (if (search-backward ">" beg t)
+ (setq ref
+ (buffer-substring
+ (1+ (point))
+ (search-backward "<" beg t)))
+ (setq ref nil))))
+ (gnus-nov-field)) ; refs
+ (gnus-nov-read-integer) ; chars
+ (gnus-nov-read-integer) ; lines
+ (if (= (following-char) ?\n)
+ nil
+ (gnus-nov-field)) ; misc
+ ))
(widen)
;; We build the thread tree.
- (when header
- (if (boundp (setq id-dep (intern id dependencies)))
- (if (and (car (symbol-value id-dep))
- (not force-new))
- ;; An article with this Message-ID has already been seen,
- ;; so we ignore this one, except we add any additional
- ;; Xrefs (in case the two articles came from different
- ;; servers.
- (progn
- (mail-header-set-xref
- (car (symbol-value id-dep))
- (concat (or (mail-header-xref
- (car (symbol-value id-dep))) "")
- (or (mail-header-xref header) "")))
- (setq header nil))
- (setcar (symbol-value id-dep) header))
- (set id-dep (list header))))
- (when header
- (if (boundp (setq ref-dep (intern (or ref "none") dependencies)))
- (setcdr (symbol-value ref-dep)
- (nconc (cdr (symbol-value ref-dep))
- (list (symbol-value id-dep))))
- (set ref-dep (list nil (symbol-value id-dep)))))
+ (when (equal id ref)
+ ;; This article refers back to itself. Naughty, naughty.
+ (setq ref nil))
+ (if (boundp (setq id-dep (intern id dependencies)))
+ (if (and (car (symbol-value id-dep))
+ (not force-new))
+ ;; An article with this Message-ID has already been seen,
+ ;; so we ignore this one, except we add any additional
+ ;; Xrefs (in case the two articles came from different
+ ;; servers.
+ (progn
+ (mail-header-set-xref
+ (car (symbol-value id-dep))
+ (concat (or (mail-header-xref
+ (car (symbol-value id-dep))) "")
+ (or (mail-header-xref header) "")))
+ (setq header nil))
+ (setcar (symbol-value id-dep) header))
+ (set id-dep (list header)))
+ (if (boundp (setq ref-dep (intern (or ref "none") dependencies)))
+ (setcdr (symbol-value ref-dep)
+ (nconc (cdr (symbol-value ref-dep))
+ (list (symbol-value id-dep))))
+ (set ref-dep (list nil (symbol-value id-dep))))
header))
+;; Goes through the xover lines and returns a list of vectors
+(defun gnus-get-newsgroup-headers-xover (sequence &optional
+ force-new dependencies)
+ "Parse the news overview data in the server buffer, and return a
+list of headers that match SEQUENCE (see `nntp-retrieve-headers')."
+ ;; Get the Xref when the users reads the articles since most/some
+ ;; NNTP servers do not include Xrefs when using XOVER.
+ (setq gnus-article-internal-prepare-hook '(gnus-article-get-xrefs))
+ (let ((cur nntp-server-buffer)
+ (dependencies (or dependencies gnus-newsgroup-dependencies))
+ number headers header)
+ (save-excursion
+ (set-buffer nntp-server-buffer)
+ ;; Allow the user to mangle the headers before parsing them.
+ (run-hooks 'gnus-parse-headers-hook)
+ (goto-char (point-min))
+ (while (not (eobp))
+ (condition-case ()
+ (while (and sequence (not (eobp)))
+ (setq number (read cur))
+ (while (and sequence
+ (< (car sequence) number))
+ (setq sequence (cdr sequence)))
+ (and sequence
+ (eq number (car sequence))
+ (progn
+ (setq sequence (cdr sequence))
+ (push (inline (gnus-nov-parse-line
+ number dependencies force-new))
+ headers)))
+ (forward-line 1))
+ (error
+ (progn
+ (gnus-error 4 "Strange nov line")
+ (forward-line 1)))))
+ (nreverse headers))))
+
(defun gnus-article-get-xrefs ()
"Fill in the Xref value in `gnus-current-headers', if necessary.
This is meant to be called in `gnus-article-internal-prepare-hook'."
;; Report back a success?
(and header (mail-header-number header))))
+;;; Process/prefix in the summary buffer
+
(defun gnus-summary-work-articles (n)
"Return a list of articles to be worked upon. The prefix argument,
the list of process marked articles, and the current article will be
(nreverse articles))))
(gnus-newsgroup-processable
;; There are process-marked articles present.
+ ;; Save current state.
+ (gnus-summary-save-process-mark)
+ ;; Return the list.
(reverse gnus-newsgroup-processable))
(t
;; Just return the current article.
(list (gnus-summary-article-number)))))
+(defun gnus-summary-save-process-mark ()
+ "Push the current set of process marked articles on the stack."
+ (interactive)
+ (push (copy-sequence gnus-newsgroup-processable)
+ gnus-newsgroup-process-stack))
+
+(defun gnus-summary-kill-process-mark ()
+ "Push the current set of process marked articles on the stack and unmark."
+ (interactive)
+ (gnus-summary-save-process-mark)
+ (gnus-summary-unmark-all-processable))
+
+(defun gnus-summary-yank-process-mark ()
+ "Pop the last process mark state off the stack and restore it."
+ (interactive)
+ (unless gnus-newsgroup-process-stack
+ (error "Empty mark stack"))
+ (gnus-summary-process-mark-set (pop gnus-newsgroup-process-stack)))
+
+(defun gnus-summary-process-mark-set (set)
+ "Make SET into the current process marked articles."
+ (gnus-summary-unmark-all-processable)
+ (while set
+ (gnus-summary-set-process-mark (pop set))))
+
+;;; Searching and stuff
+
(defun gnus-summary-search-group (&optional backward use-level)
"Search for next unread newsgroup.
If optional argument BACKWARD is non-nil, search backward instead."
;; The user has to want it.
(when gnus-auto-center-summary
(when (get-buffer-window gnus-article-buffer)
- ;; Only do recentering when the article buffer is displayed,
- ;; Set the window start to either `bottom', which is the biggest
- ;; possible valid number, or the second line from the top,
- ;; whichever is the least.
- (set-window-start
- window (min bottom (save-excursion
- (forward-line (- top)) (point)))))
+ ;; Only do recentering when the article buffer is displayed,
+ ;; Set the window start to either `bottom', which is the biggest
+ ;; possible valid number, or the second line from the top,
+ ;; whichever is the least.
+ (set-window-start
+ window (min bottom (save-excursion
+ (forward-line (- top)) (point)))))
;; Do horizontal recentering while we're at it.
(when (and (get-buffer-window (current-buffer) t)
(not (eq gnus-auto-center-summary 'vertical)))
;; the range of active articles.
(defun gnus-list-of-unread-articles (group)
(let* ((read (gnus-info-read (gnus-get-info group)))
- (active (gnus-active group))
+ (active (or (gnus-active group) (gnus-activate-group group)))
(last (cdr active))
first nlast unread)
;; If none are read, then all are unread.
(bury-buffer gnus-article-buffer))
;; We clear the global counterparts of the buffer-local
;; variables as well, just to be on the safe side.
- (gnus-configure-windows 'group 'force)
+ (set-buffer gnus-group-buffer)
(gnus-summary-clear-local-variables)
;; Return to group mode buffer.
(if (eq mode 'gnus-summary-mode)
(if (not (buffer-name (car quit-config)))
(gnus-configure-windows 'group 'force)
(set-buffer (car quit-config))
- (and (eq major-mode 'gnus-summary-mode)
- (gnus-set-global-variables))
- (gnus-configure-windows (cdr quit-config))))
+ (cond ((eq major-mode 'gnus-summary-mode)
+ (gnus-set-global-variables))
+ ((eq major-mode 'gnus-article-mode)
+ (save-excursion
+ ;; The `gnus-summary-buffer' variable may point
+ ;; to the old summary buffer when using a single
+ ;; article buffer.
+ (unless (gnus-buffer-live-p gnus-summary-buffer)
+ (set-buffer gnus-group-buffer))
+ (set-buffer gnus-summary-buffer)
+ (gnus-set-global-variables))))
+ (gnus-configure-windows (cdr quit-config) 'force)))
(unless quit-config
(setq gnus-newsgroup-name nil)))))
(defvar gnus-dead-summary-mode-map nil)
-(if gnus-dead-summary-mode-map
- nil
+(unless gnus-dead-summary-mode-map
(setq gnus-dead-summary-mode-map (make-keymap))
(suppress-keymap gnus-dead-summary-mode-map)
(substitute-key-definition
(gnus-message 5 "Returning to the group buffer")
(setq entered t)
(set-buffer current-buffer)
- (gnus-summary-exit))
+ (gnus-summary-exit)
+ (run-hooks 'gnus-group-no-more-groups-hook))
;; We try to enter the target group.
(gnus-group-jump-to-group target-group)
(let ((unreads (gnus-group-group-unread)))
(defun gnus-summary-goto-subject (article &optional force silent)
"Go the subject line of ARTICLE.
If FORCE, also allow jumping to articles not currently shown."
+ (interactive "nArticle number: ")
(let ((b (point))
(data (gnus-data-find article)))
;; We read in the article if we have to.
(funcall gnus-summary-display-article-function article all-header)
(gnus-article-prepare article all-header))
(run-hooks 'gnus-select-article-hook)
- (unless (zerop gnus-current-article)
+ (when (and gnus-current-article
+ (not (zerop gnus-current-article)))
(gnus-summary-goto-subject gnus-current-article))
(gnus-summary-recenter)
(when gnus-use-trees
;; If not, we try the first unread, if that is wanted.
((and subject
gnus-auto-select-same
+ ;; Make sure that we don't select the current article.
+ (not (eq (gnus-summary-article-number)
+ (save-excursion
+ (gnus-summary-first-subject t)
+ (gnus-summary-article-number))))
(gnus-summary-first-unread-article))
(gnus-summary-position-point)
(gnus-message 6 "Wrapped"))
(defun gnus-summary-walk-group-buffer (from-group cmd unread backward)
(let ((keystrokes '((?\C-n (gnus-group-next-unread-group 1))
(?\C-p (gnus-group-prev-unread-group 1))))
+ (cursor-in-echo-area t)
keve key group ended)
(save-excursion
(set-buffer gnus-group-buffer)
(gnus-summary-next-article unread subject t))
(defun gnus-summary-prev-unread-article ()
- "Select unred article before current one."
+ "Select unread article before current one."
(interactive)
(gnus-summary-prev-article t (and gnus-auto-select-same
(gnus-summary-article-subject))))
(gnus-summary-display-article article)
(gnus-eval-in-buffer-window gnus-article-buffer
(setq endp (gnus-article-next-page lines)))
- (if endp
- (cond (circular
- (gnus-summary-beginning-of-article))
- (lines
- (gnus-message 3 "End of message"))
- ((null lines)
- (if (and (eq gnus-summary-goto-unread 'never)
- (not (gnus-summary-last-article-p article)))
- (gnus-summary-next-article)
- (gnus-summary-next-unread-article)))))))
+ (when endp
+ (cond (circular
+ (gnus-summary-beginning-of-article))
+ (lines
+ (gnus-message 3 "End of message"))
+ ((null lines)
+ (if (and (eq gnus-summary-goto-unread 'never)
+ (not (gnus-summary-last-article-p article)))
+ (gnus-summary-next-article)
+ (gnus-summary-next-unread-article)))))))
(gnus-summary-recenter)
(gnus-summary-position-point)))
(interactive)
(gnus-set-global-variables)
(prog1
- (if (gnus-summary-first-subject t)
- (progn
- (gnus-summary-show-thread)
- (gnus-summary-first-subject t)
- (gnus-summary-display-article (gnus-summary-article-number))))
+ (when (gnus-summary-first-subject t)
+ (gnus-summary-show-thread)
+ (gnus-summary-first-subject t)
+ (gnus-summary-display-article (gnus-summary-article-number)))
(gnus-summary-position-point)))
(defun gnus-summary-best-unread-article ()
(gnus-summary-hide-all-threads))
;; Try to return to the article you were at, or one in the
;; neighborhood.
- (if data
- ;; We try to find some article after the current one.
- (while data
- (and (gnus-summary-goto-subject
- (gnus-data-number (car data)) nil t)
- (setq data nil
- found t))
- (setq data (cdr data))))
- (or found
- ;; If there is no data, that means that we were after the last
- ;; article. The same goes when we can't find any articles
- ;; after the current one.
- (progn
- (goto-char (point-max))
- (gnus-summary-find-prev)))
+ (when data
+ ;; We try to find some article after the current one.
+ (while data
+ (when (gnus-summary-goto-subject (gnus-data-number (car data)) nil t)
+ (setq data nil
+ found t))
+ (setq data (cdr data))))
+ (unless found
+ ;; If there is no data, that means that we were after the last
+ ;; article. The same goes when we can't find any articles
+ ;; after the current one.
+ (goto-char (point-max))
+ (gnus-summary-find-prev))
;; We return how many articles were removed from the summary
;; buffer as a result of the new limit.
(- total (length gnus-newsgroup-data))))
(not (eq gnus-build-sparse-threads 'more))
(null gnus-thread-expunge-below)
(not gnus-use-nocem)))
- () ; Do nothing.
+ () ; Do nothing.
(push gnus-newsgroup-limit gnus-newsgroup-limits)
(setq gnus-newsgroup-limit nil)
(mapatoms
0))
(number (mail-header-number (car thread)))
score)
- (if (or
- ;; If this article is dormant and has absolutely no visible
- ;; children, then this article isn't visible.
- (and (memq number gnus-newsgroup-dormant)
- (= children 0))
- ;; If this is "fetch-old-headered" and there is only one
- ;; visible child (or less), then we don't want this article.
- (and (eq gnus-fetch-old-headers 'some)
- (memq number gnus-newsgroup-ancient)
- (zerop children))
- ;; If this is a sparsely inserted article with no children,
- ;; we don't want it.
- (and (eq gnus-build-sparse-threads 'some)
- (memq number gnus-newsgroup-sparse)
- (zerop children))
- ;; If we use expunging, and this article is really
- ;; low-scored, then we don't want this article.
- (when (and gnus-summary-expunge-below
- (< (setq score
- (or (cdr (assq number gnus-newsgroup-scored))
- gnus-summary-default-score))
- gnus-summary-expunge-below))
- ;; We increase the expunge-tally here, but that has
- ;; nothing to do with the limits, really.
- (incf gnus-newsgroup-expunged-tally)
- ;; We also mark as read here, if that's wanted.
- (when (and gnus-summary-mark-below
- (< score gnus-summary-mark-below))
- (setq gnus-newsgroup-unreads
- (delq number gnus-newsgroup-unreads))
- (if gnus-newsgroup-auto-expire
- (push number gnus-newsgroup-expirable)
- (push (cons number gnus-low-score-mark)
- gnus-newsgroup-reads)))
- t)
- (and gnus-use-nocem
- (gnus-nocem-unwanted-article-p (mail-header-id (car thread)))))
+ (if (and
+ (not (memq number gnus-newsgroup-marked))
+ (or
+ ;; If this article is dormant and has absolutely no visible
+ ;; children, then this article isn't visible.
+ (and (memq number gnus-newsgroup-dormant)
+ (= children 0))
+ ;; If this is "fetch-old-headered" and there is only one
+ ;; visible child (or less), then we don't want this article.
+ (and (eq gnus-fetch-old-headers 'some)
+ (memq number gnus-newsgroup-ancient)
+ (zerop children))
+ ;; If this is a sparsely inserted article with no children,
+ ;; we don't want it.
+ (and (eq gnus-build-sparse-threads 'some)
+ (memq number gnus-newsgroup-sparse)
+ (zerop children))
+ ;; If we use expunging, and this article is really
+ ;; low-scored, then we don't want this article.
+ (when (and gnus-summary-expunge-below
+ (< (setq score
+ (or (cdr (assq number gnus-newsgroup-scored))
+ gnus-summary-default-score))
+ gnus-summary-expunge-below))
+ ;; We increase the expunge-tally here, but that has
+ ;; nothing to do with the limits, really.
+ (incf gnus-newsgroup-expunged-tally)
+ ;; We also mark as read here, if that's wanted.
+ (when (and gnus-summary-mark-below
+ (< score gnus-summary-mark-below))
+ (setq gnus-newsgroup-unreads
+ (delq number gnus-newsgroup-unreads))
+ (if gnus-newsgroup-auto-expire
+ (push number gnus-newsgroup-expirable)
+ (push (cons number gnus-low-score-mark)
+ gnus-newsgroup-reads)))
+ t)
+ ;; Check NoCeM things.
+ (and gnus-use-nocem
+ (gnus-nocem-unwanted-article-p
+ (mail-header-id (car thread))))))
;; Nope, invisible article.
0
;; Ok, this article is to be visible, so we add it to the limit
(defun gnus-summary-refer-parent-article (n)
"Refer parent article N times.
+If N is negative, go to ancestor -N instead.
The difference between N and the number of articles fetched is returned."
(interactive "p")
(gnus-set-global-variables)
- (while
- (and
- (> n 0)
- (let* ((header (gnus-summary-article-header))
- (ref
- ;; If we try to find the parent of the currently
- ;; displayed article, then we take a look at the actual
- ;; References header, since this is slightly more
- ;; reliable than the References field we got from the
- ;; server.
- (if (and (eq (mail-header-number header)
- (cdr gnus-article-current))
- (equal gnus-newsgroup-name
- (car gnus-article-current)))
- (save-excursion
- (set-buffer gnus-original-article-buffer)
- (nnheader-narrow-to-headers)
- (prog1
- (message-fetch-field "references")
- (widen)))
- ;; It's not the current article, so we take a bet on
- ;; the value we got from the server.
- (mail-header-references header))))
- (if (setq ref (or ref (mail-header-references header)))
- (or (gnus-summary-refer-article (gnus-parent-id ref))
- (gnus-message 1 "Couldn't find parent"))
- (gnus-message 1 "No references in article %d"
- (gnus-summary-article-number))
- nil)))
- (setq n (1- n)))
- (gnus-summary-position-point)
- n)
+ (let ((skip 1)
+ error header ref)
+ (when (not (natnump n))
+ (setq skip (abs n)
+ n 1))
+ (while (and (> n 0)
+ (not error))
+ (setq header (gnus-summary-article-header))
+ (setq ref
+ ;; If we try to find the parent of the currently
+ ;; displayed article, then we take a look at the actual
+ ;; References header, since this is slightly more
+ ;; reliable than the References field we got from the
+ ;; server.
+ (if (and (eq (mail-header-number header)
+ (cdr gnus-article-current))
+ (equal gnus-newsgroup-name
+ (car gnus-article-current)))
+ (save-excursion
+ (set-buffer gnus-original-article-buffer)
+ (nnheader-narrow-to-headers)
+ (prog1
+ (message-fetch-field "references")
+ (widen)))
+ ;; It's not the current article, so we take a bet on
+ ;; the value we got from the server.
+ (mail-header-references header)))
+ (if ref
+ (unless (gnus-summary-refer-article (gnus-parent-id ref skip))
+ (gnus-message 1 "Couldn't find parent"))
+ (gnus-message 1 "No references in article %d"
+ (gnus-summary-article-number))
+ (setq error t))
+ (decf n))
+ (gnus-summary-position-point)
+ n))
(defun gnus-summary-refer-references ()
"Fetch all articles mentioned in the References header.
(gnus-message 3 "Couldn't fetch article %s" message-id)))))))
(defun gnus-summary-enter-digest-group (&optional force)
- "Enter a digest group based on the current article."
+ "Enter an nndoc group based on the current article.
+If FORCE, force a digest interpretation. If not, try
+to guess what the document format is."
(interactive "P")
(gnus-set-global-variables)
- (gnus-summary-select-article)
- (let ((name (format "%s-%d"
- (gnus-group-prefixed-name
- gnus-newsgroup-name (list 'nndoc ""))
- gnus-current-article))
- (ogroup gnus-newsgroup-name)
- (case-fold-search t)
- (buf (current-buffer))
- dig)
+ (let ((conf gnus-current-window-configuration))
(save-excursion
- (setq dig (nnheader-set-temp-buffer " *gnus digest buffer*"))
- (insert-buffer-substring gnus-original-article-buffer)
- (narrow-to-region
- (goto-char (point-min))
- (or (search-forward "\n\n" nil t) (point)))
- (goto-char (point-min))
- (delete-matching-lines "^\\(Path\\):\\|^From ")
- (widen))
- (unwind-protect
- (if (gnus-group-read-ephemeral-group
- name `(nndoc ,name (nndoc-address
- ,(get-buffer dig))
- (nndoc-article-type ,(if force 'digest 'guess))) t)
- ;; Make all postings to this group go to the parent group.
- (nconc (gnus-info-params (gnus-get-info name))
- (list (cons 'to-group ogroup)))
- ;; Couldn't select this doc group.
- (switch-to-buffer buf)
- (gnus-set-global-variables)
- (gnus-configure-windows 'summary)
- (gnus-message 3 "Article couldn't be entered?"))
- (kill-buffer dig))))
-
+ (gnus-summary-select-article))
+ (setq gnus-current-window-configuration conf)
+ (let* ((name (format "%s-%d"
+ (gnus-group-prefixed-name
+ gnus-newsgroup-name (list 'nndoc ""))
+ (save-excursion
+ (set-buffer gnus-summary-buffer)
+ gnus-current-article)))
+ (ogroup gnus-newsgroup-name)
+ (params (append (gnus-info-params (gnus-get-info ogroup))
+ (list (cons 'to-group ogroup))))
+ (case-fold-search t)
+ (buf (current-buffer))
+ dig)
+ (save-excursion
+ (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
+ ;; document type.
+ (narrow-to-region
+ (goto-char (point-min))
+ (or (search-forward "\n\n" nil t) (point)))
+ (goto-char (point-min))
+ (delete-matching-lines "^\\(Path\\):\\|^From ")
+ (widen))
+ (unwind-protect
+ (let ((gnus-current-window-configuration
+ (if (and (boundp 'gnus-pick-mode)
+ (symbol-value (intern "gnus-pick-mode")))
+ 'pick 'summary)))
+ (if (gnus-group-read-ephemeral-group
+ name `(nndoc ,name (nndoc-address ,(get-buffer dig))
+ (nndoc-article-type
+ ,(if force 'digest 'guess))) t)
+ ;; Make all postings to this group go to the parent group.
+ (nconc (gnus-info-params (gnus-get-info name))
+ params)
+ ;; Couldn't select this doc group.
+ (switch-to-buffer buf)
+ (gnus-set-global-variables)
+ (gnus-configure-windows 'summary)
+ (gnus-message 3 "Article couldn't be entered?")))
+ (kill-buffer dig)))))
+
+(defun gnus-summary-read-document (n)
+ "Open a new group based on the current article(s).
+Obeys the standard process/prefix convention."
+ (interactive "P")
+ (let* ((articles (gnus-summary-work-articles n))
+ (ogroup gnus-newsgroup-name)
+ (params (append (gnus-info-params (gnus-get-info ogroup))
+ (list (cons 'to-group ogroup))))
+ article group egroup groups vgroup)
+ (while (setq article (pop articles))
+ (setq group (format "%s-%d" gnus-newsgroup-name article))
+ (gnus-summary-remove-process-mark article)
+ (when (gnus-summary-display-article article)
+ (save-excursion
+ (nnheader-temp-write nil
+ (insert-buffer-substring gnus-original-article-buffer)
+ ;; Remove some headers that may lead nndoc to make
+ ;; the wrong guess.
+ (message-narrow-to-head)
+ (goto-char (point-min))
+ (delete-matching-lines "^\\(Path\\):\\|^From ")
+ (widen)
+ (if (setq egroup
+ (gnus-group-read-ephemeral-group
+ group `(nndoc ,group (nndoc-address ,(current-buffer))
+ (nndoc-article-type guess))
+ t nil t))
+ (progn
+ ;; Make all postings to this group go to the parent group.
+ (nconc (gnus-info-params (gnus-get-info egroup))
+ params)
+ (push egroup groups))
+ ;; Couldn't select this doc group.
+ (gnus-error 3 "Article couldn't be entered"))))))
+ ;; Now we have selected all the documents.
+ (cond
+ ((not groups)
+ (error "None of the articles could be interpreted as documents"))
+ ((gnus-group-read-ephemeral-group
+ (setq vgroup (format
+ "nnvirtual:%s-%s" gnus-newsgroup-name
+ (format-time-string "%Y%m%dT%H%M%S" (current-time))))
+ `(nnvirtual ,vgroup (nnvirtual-component-groups ,groups))
+ t
+ (cons (current-buffer) 'summary)))
+ (t
+ (error "Couldn't select virtual nndoc group")))))
+
(defun gnus-summary-isearch-article (&optional regexp-p)
"Do incremental search forward on the current article.
If REGEXP-P (the prefix) is non-nil, do regexp isearch."
(if (string-equal regexp "")
(setq regexp (or gnus-last-search-regexp ""))
(setq gnus-last-search-regexp regexp))
- (unless (gnus-summary-search-article regexp backward)
+ (if (gnus-summary-search-article regexp backward)
+ (gnus-summary-show-thread)
(error "Search failed: \"%s\"" regexp)))
(defun gnus-summary-search-article-backward (regexp)
(let ((gnus-select-article-hook nil) ;Disable hook.
(gnus-article-display-hook nil)
(gnus-mark-article-hook nil) ;Inhibit marking as read.
- (re-search
- (if backward
- 're-search-backward 're-search-forward))
+ (gnus-use-article-prefetch nil)
(sum (current-buffer))
- (found nil))
+ (found nil)
+ point)
(gnus-save-hidden-threads
(gnus-summary-select-article)
(set-buffer gnus-article-buffer)
(get-buffer-window (current-buffer))
(point))
(forward-line 1)
- (set-buffer sum))
+ (set-buffer sum)
+ (setq point (point)))
;; We didn't find it, so we go to the next article.
(set-buffer sum)
(if (not (if backward (gnus-summary-find-prev)
(gnus-message 7 ""))
;; Return whether we found the regexp.
(when (eq found 'found)
+ (goto-char point)
(gnus-summary-show-thread)
(gnus-summary-goto-subject gnus-current-article)
(gnus-summary-position-point)
(gnus-message 6 "Executing %s..." (key-description command))
;; We'd like to execute COMMAND interactively so as to give arguments.
(gnus-execute header regexp
- `(lambda () (call-interactively ',(key-binding command)))
+ `(call-interactively ',(key-binding command))
backward)
(gnus-message 6 "Executing %s...done" (key-description command)))))
gnus-visual)
(gnus-summary-select-article nil 'force)))
(gnus-summary-goto-subject gnus-current-article)
-; (gnus-configure-windows 'article)
+ ; (gnus-configure-windows 'article)
(gnus-summary-position-point))
(defun gnus-summary-verbose-headers (&optional arg)
If ARG is a negative number, turn header display off."
(interactive "P")
(gnus-set-global-variables)
- (gnus-summary-toggle-header arg)
(setq gnus-show-all-headers
(cond ((or (not (numberp arg))
(zerop arg))
(not gnus-show-all-headers))
((natnump arg)
- t))))
+ t)))
+ (gnus-summary-show-article))
(defun gnus-summary-toggle-header (&optional arg)
"Show the headers if they are hidden, or hide them if they are shown.
((eq action 'move)
(gnus-request-move-article
article ; Article to move
- gnus-newsgroup-name ; From newsgrouo
+ gnus-newsgroup-name ; From newsgroup
(nth 1 (gnus-find-method-for-group
gnus-newsgroup-name)) ; Server
(list 'gnus-request-accept-article
(gnus-request-accept-article group nil t)
(kill-buffer (current-buffer)))))
+(defun gnus-summary-article-posted-p ()
+ "Say whether the current (mail) article is available from `gnus-select-method' 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)))
+ (if (gnus-request-head id "")
+ (gnus-message 2 "The current message was found on %s"
+ gnus-override-method)
+ (gnus-message 2 "The current message couldn't be found on %s"
+ gnus-override-method)
+ nil)))
+
(defun gnus-summary-expire-articles (&optional now)
"Expire all articles that are marked as expirable in the current group."
(interactive)
(setq gnus-newsgroup-expirable
(sort gnus-newsgroup-expirable '<))))
(expiry-wait (if now 'immediate
- (gnus-group-get-parameter
+ (gnus-group-find-parameter
gnus-newsgroup-name 'expiry-wait)))
es)
(when expirable
expirable gnus-newsgroup-name)))
(setq es (gnus-request-expire-articles
expirable gnus-newsgroup-name)))
- (or total (setq gnus-newsgroup-expirable es))
+ (unless total
+ (setq gnus-newsgroup-expirable es))
;; We go through the old list of expirable, and mark all
;; really expired articles as nonexistent.
(unless (eq es expirable) ;If nothing was expired, we don't mark.
not-deleted))
(defun gnus-summary-edit-article (&optional force)
- "Enter into a buffer and edit the current article.
+ "Edit the current article.
This will have permanent effect only in mail groups.
If FORCE is non-nil, allow editing of articles even in read-only
-groups."
+groups."
(interactive "P")
(save-excursion
(set-buffer gnus-summary-buffer)
(when (and (not force)
(gnus-group-read-only-p))
(error "The current newsgroup does not support article editing."))
- (gnus-summary-select-article t nil t)
- (gnus-configure-windows 'article)
- (select-window (get-buffer-window gnus-article-buffer))
- (gnus-message 6 "C-c C-c to end edits")
- (setq buffer-read-only nil)
- (gnus-article-edit-mode)
- (buffer-enable-undo)
- (widen)
- (goto-char (point-min))
- (search-forward "\n\n" nil t)))
-
-(defun gnus-summary-edit-article-done ()
+ ;; Select article if needed.
+ (unless (eq (gnus-summary-article-number)
+ gnus-current-article)
+ (gnus-summary-select-article t))
+ (gnus-article-edit-article
+ `(lambda ()
+ (gnus-summary-edit-article-done
+ ,(or (mail-header-references gnus-current-headers) "")
+ ,(gnus-group-read-only-p) ,gnus-summary-buffer)))))
+
+(defalias 'gnus-summary-edit-article-postpone 'gnus-article-edit-exit)
+
+(defun gnus-summary-edit-article-done (&optional references read-only buffer)
"Make edits to the current article permanent."
(interactive)
- (if (gnus-group-read-only-p)
- (progn
- (let ((beep (not (eq major-mode 'text-mode))))
- (gnus-summary-edit-article-postpone)
- (when beep
- (gnus-error
- 3 "The current newsgroup does not support article editing."))))
- (let ((buf (format "%s" (buffer-string))))
- (erase-buffer)
- (insert buf)
- (if (not (gnus-request-replace-article
- (cdr gnus-article-current) (car gnus-article-current)
- (current-buffer)))
- (error "Couldn't replace article.")
- (gnus-article-mode)
- (use-local-map gnus-article-mode-map)
- (setq buffer-read-only t)
- (buffer-disable-undo (current-buffer))
- (gnus-configure-windows 'summary)
- (gnus-summary-update-article (cdr gnus-article-current))
- (when gnus-use-cache
- (gnus-cache-update-article
- (car gnus-article-current) (cdr gnus-article-current)))
- (when gnus-keep-backlog
- (gnus-backlog-remove-article
- (car gnus-article-current) (cdr gnus-article-current))))
- (save-excursion
- (when (get-buffer gnus-original-article-buffer)
- (set-buffer gnus-original-article-buffer)
- (setq gnus-original-article nil)))
- (setq gnus-article-current nil
- gnus-current-article nil)
- (run-hooks 'gnus-article-display-hook)
- (and (gnus-visual-p 'summary-highlight 'highlight)
- (run-hooks 'gnus-visual-mark-article-hook)))))
-
-(defun gnus-summary-edit-article-postpone ()
- "Postpone changes to the current article."
- (interactive)
- (gnus-article-mode)
- (use-local-map gnus-article-mode-map)
- (setq buffer-read-only t)
- (buffer-disable-undo (current-buffer))
- (gnus-configure-windows 'summary)
- (and (gnus-visual-p 'summary-highlight 'highlight)
- (run-hooks 'gnus-visual-mark-article-hook)))
+ ;; Replace the article.
+ (if (and (not read-only)
+ (not (gnus-request-replace-article
+ (cdr gnus-article-current) (car gnus-article-current)
+ (current-buffer))))
+ (error "Couldn't replace article.")
+ ;; Update the summary buffer.
+ (if (and references
+ (equal (message-tokenize-header references " ")
+ (message-tokenize-header
+ (or (message-fetch-field "references") "") " ")))
+ ;; We only have to update this line.
+ (save-excursion
+ (save-restriction
+ (message-narrow-to-head)
+ (let ((header (nnheader-parse-head t)))
+ (set-buffer buffer)
+ (mail-header-set-number header (cdr gnus-article-current))
+ (gnus-summary-update-article-line
+ (cdr gnus-article-current) header))))
+ ;; Update threads.
+ (set-buffer (or buffer gnus-summary-buffer))
+ (gnus-summary-update-article (cdr gnus-article-current)))
+ ;; Prettify the article buffer again.
+ (save-excursion
+ (set-buffer gnus-article-buffer)
+ (run-hooks 'gnus-article-display-hook))
+ ;; Prettify the summary buffer line.
+ (when (gnus-visual-p 'summary-highlight 'highlight)
+ (run-hooks 'gnus-visual-mark-article-hook))))
(defun gnus-summary-edit-wash (key)
"Perform editing command in the article buffer."
(message "")
(gnus-summary-edit-article)
(execute-kbd-macro (concat (this-command-keys) key))
- (gnus-summary-edit-article-done))
+ (gnus-article-edit-done))
;;; Respooling
(goto-char (point-min))
(search-forward "\n\n")
(narrow-to-region (point-min) (point))
- (pp-eval-expression
- (list 'quote (mapcar 'car (nnmail-article-group 'identity)))))))
+ (message "This message would go to %s"
+ (mapconcat 'car (nnmail-article-group 'identity) ", ")))))
;; Summary marking commands.
(let ((forward (cdr (assq type gnus-summary-mark-positions)))
(buffer-read-only nil))
(re-search-backward "[\n\r]" (gnus-point-at-bol) 'move-to-limit)
- (and (looking-at "\r") (setq forward (1+ forward)))
+ (when (looking-at "\r")
+ (incf forward))
(when (and forward
(<= (+ forward (point)) (point-max)))
;; Go to the right position on the line.
(defun gnus-mark-article-as-unread (article &optional mark)
"Enter ARTICLE in the pertinent lists and remove it from others."
(let ((mark (or mark gnus-ticked-mark)))
- (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked))
- (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant))
- (setq gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable))
- (setq gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads))
+ (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked)
+ gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant)
+ gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable)
+ gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads))
+
+ ;; Unsuppress duplicates?
+ (when gnus-suppress-duplicates
+ (gnus-dup-unsuppress-article article))
+
(cond ((= mark gnus-ticked-mark)
(push article gnus-newsgroup-marked))
((= mark gnus-dormant-mark)
(interactive "P")
(gnus-set-global-variables)
(prog1
- (if (or quietly
- (not gnus-interactive-catchup) ;Without confirmation?
- gnus-expert-user
- (gnus-y-or-n-p
- (if all
- "Mark absolutely all articles as read? "
- "Mark all unread articles as read? ")))
- (if (and not-mark
- (not gnus-newsgroup-adaptive)
- (not gnus-newsgroup-auto-expire))
- (progn
- (when all
- (setq gnus-newsgroup-marked nil
- gnus-newsgroup-dormant nil))
- (setq gnus-newsgroup-unreads nil))
- ;; We actually mark all articles as canceled, which we
- ;; have to do when using auto-expiry or adaptive scoring.
- (gnus-summary-show-all-threads)
- (if (gnus-summary-first-subject (not all))
- (while (and
- (if to-here (< (point) to-here) t)
- (gnus-summary-mark-article-as-read gnus-catchup-mark)
- (gnus-summary-find-next (not all)))))
- (unless to-here
+ (when (or quietly
+ (not gnus-interactive-catchup) ;Without confirmation?
+ gnus-expert-user
+ (gnus-y-or-n-p
+ (if all
+ "Mark absolutely all articles as read? "
+ "Mark all unread articles as read? ")))
+ (if (and not-mark
+ (not gnus-newsgroup-adaptive)
+ (not gnus-newsgroup-auto-expire)
+ (not gnus-suppress-duplicates))
+ (progn
+ (when all
+ (setq gnus-newsgroup-marked nil
+ gnus-newsgroup-dormant nil))
(setq gnus-newsgroup-unreads nil))
- (gnus-set-mode-line 'summary)))
+ ;; We actually mark all articles as canceled, which we
+ ;; have to do when using auto-expiry or adaptive scoring.
+ (gnus-summary-show-all-threads)
+ (when (gnus-summary-first-subject (not all))
+ (while (and
+ (if to-here (< (point) to-here) t)
+ (gnus-summary-mark-article-as-read gnus-catchup-mark)
+ (gnus-summary-find-next (not all)))))
+ (unless to-here
+ (setq gnus-newsgroup-unreads nil))
+ (gnus-set-mode-line 'summary)))
(let ((method (gnus-find-method-for-group gnus-newsgroup-name)))
- (if (and (not to-here) (eq 'nnvirtual (car method)))
- (nnvirtual-catchup-group
- (gnus-group-real-name gnus-newsgroup-name) (nth 1 method) all)))
+ (when (and (not to-here) (eq 'nnvirtual (car method)))
+ (nnvirtual-catchup-group
+ (gnus-group-real-name gnus-newsgroup-name) (nth 1 method) all)))
(gnus-summary-position-point)))
(defun gnus-summary-catchup-to-here (&optional all)
(save-window-excursion
(let ((gnus-article-buffer " *reparent*")
(current-article (gnus-summary-article-number))
- ; first grab the marked article, otherwise one line up.
+ ; first grab the marked article, otherwise one line up.
(parent-article (if (not (null gnus-newsgroup-processable))
(car gnus-newsgroup-processable)
(save-excursion
(gnus-summary-article-number)
(goto-char beg)))))
-(defun gnus-summary-go-to-next-thread-old (&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."
- (if (and (eq gnus-summary-make-false-root 'dummy)
- (gnus-summary-article-intangible-p))
- (let ((beg (point)))
- (while (and (zerop (forward-line 1))
- (not (gnus-summary-article-intangible-p))
- (not (zerop (save-excursion
- (gnus-summary-thread-level))))))
- (if (eobp)
- (progn
- (goto-char beg)
- nil)
- (point)))
- (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 &optional silent)
"Go to the same level next N'th thread.
If N is negative, search backward instead.
(interactive "p")
(gnus-set-global-variables)
(let ((backward (< n 0))
- (n (abs n))
- old dum int)
+ (n (abs n)))
(while (and (> n 0)
(gnus-summary-go-to-next-thread backward))
(decf n))
(gnus-summary-sort 'author reverse))
(defun gnus-summary-sort-by-subject (&optional reverse)
- "Sort summary buffer by subject alphabetically. `Re:'s are ignored.
+ "Sort summary buffer by subject alphabetically. `Re:'s are ignored.
If case-fold-search is non-nil, case of letters is ignored.
Argument REVERSE means reverse order."
(interactive "P")
The variable `gnus-default-article-saver' specifies the saver function."
(interactive "P")
(gnus-set-global-variables)
- (let ((articles (gnus-summary-work-articles n))
- (save-buffer (save-excursion
- (nnheader-set-temp-buffer " *Gnus Save*")))
- header article file)
+ (let* ((articles (gnus-summary-work-articles n))
+ (save-buffer (save-excursion
+ (nnheader-set-temp-buffer " *Gnus Save*")))
+ (num (length articles))
+ header article file)
(while articles
(setq header (gnus-summary-article-header
(setq article (pop articles))))
(set-buffer save-buffer)
(erase-buffer)
(insert-buffer-substring gnus-original-article-buffer))
- (setq file (gnus-article-save save-buffer file))
+ (setq file (gnus-article-save save-buffer file num))
(gnus-summary-remove-process-mark article)
(unless not-saved
(gnus-summary-set-saved-mark article))))
(forward-line 1)
(setq b (point))
(insert " " (file-name-nondirectory
- (cdr (assq 'name (car pslist))))
+ (cdr (assq 'name (car pslist))))
": " (or (cdr (assq 'execute (car pslist))) "") "\n")
(setq e (point))
(forward-line -1) ; back to `b'
(t gnus-reffed-article-number))
(current-buffer))
(insert " Article retrieved.\n"))
- ;(when (and header
- ; (memq (mail-header-number header) gnus-newsgroup-sparse))
- ; (setcar (gnus-id-to-thread id) nil))
(if (not (setq header (car (gnus-get-newsgroup-headers))))
() ; Malformed head.
(unless (memq (mail-header-number header) gnus-newsgroup-sparse)
(when (cdr headers)
(setcdr headers (cddr headers))))))
+;;;
+;;; summary highlights
+;;;
+
+(defun gnus-highlight-selected-summary ()
+ ;; Added by Per Abrahamsen <amanda@iesd.auc.dk>.
+ ;; Highlight selected article in summary buffer
+ (when gnus-summary-selected-face
+ (save-excursion
+ (let* ((beg (progn (beginning-of-line) (point)))
+ (end (progn (end-of-line) (point)))
+ ;; Fix by Mike Dugan <dugan@bucrf16.bu.edu>.
+ (from (if (get-text-property beg gnus-mouse-face-prop)
+ beg
+ (or (next-single-property-change
+ beg gnus-mouse-face-prop nil end)
+ beg)))
+ (to
+ (if (= from end)
+ (- from 2)
+ (or (next-single-property-change
+ from gnus-mouse-face-prop nil end)
+ end))))
+ ;; If no mouse-face prop on line we will have to = from = end,
+ ;; so we highlight the entire line instead.
+ (when (= (+ to 2) from)
+ (setq from beg)
+ (setq to end))
+ (if gnus-newsgroup-selected-overlay
+ ;; Move old overlay.
+ (gnus-move-overlay
+ gnus-newsgroup-selected-overlay from to (current-buffer))
+ ;; Create new overlay.
+ (gnus-overlay-put
+ (setq gnus-newsgroup-selected-overlay (gnus-make-overlay from to))
+ 'face gnus-summary-selected-face))))))
+
+;; New implementation by Christian Limpach <Christian.Limpach@nice.ch>.
+(defun gnus-summary-highlight-line ()
+ "Highlight current line according to `gnus-summary-highlight'."
+ (let* ((list gnus-summary-highlight)
+ (p (point))
+ (end (progn (end-of-line) (point)))
+ ;; now find out where the line starts and leave point there.
+ (beg (progn (beginning-of-line) (point)))
+ (article (gnus-summary-article-number))
+ (score (or (cdr (assq (or article gnus-current-article)
+ gnus-newsgroup-scored))
+ gnus-summary-default-score 0))
+ (mark (or (gnus-summary-article-mark) gnus-unread-mark))
+ (inhibit-read-only t))
+ ;; Eval the cars of the lists until we find a match.
+ (let ((default gnus-summary-default-score))
+ (while (and list
+ (not (eval (caar list))))
+ (setq list (cdr list))))
+ (let ((face (cdar list)))
+ (unless (eq face (get-text-property beg 'face))
+ (gnus-put-text-property
+ beg end 'face
+ (setq face (if (boundp face) (symbol-value face) face)))
+ (when gnus-summary-highlight-line-function
+ (funcall gnus-summary-highlight-line-function article face))))
+ (goto-char p)))
+
+(defun gnus-update-read-articles (group unread)
+ "Update the list of read articles in GROUP."
+ (let* ((active (or gnus-newsgroup-active (gnus-active group)))
+ (entry (gnus-gethash group gnus-newsrc-hashtb))
+ (info (nth 2 entry))
+ (prev 1)
+ (unread (sort (copy-sequence unread) '<))
+ read)
+ (if (or (not info) (not active))
+ ;; There is no info on this group if it was, in fact,
+ ;; killed. Gnus stores no information on killed groups, so
+ ;; there's nothing to be done.
+ ;; One could store the information somewhere temporarily,
+ ;; perhaps... Hmmm...
+ ()
+ ;; Remove any negative articles numbers.
+ (while (and unread (< (car unread) 0))
+ (setq unread (cdr unread)))
+ ;; Remove any expired article numbers
+ (while (and unread (< (car unread) (car active)))
+ (setq unread (cdr unread)))
+ ;; Compute the ranges of read articles by looking at the list of
+ ;; unread articles.
+ (while unread
+ (if (/= (car unread) prev)
+ (setq read (cons (if (= prev (1- (car unread))) prev
+ (cons prev (1- (car unread)))) read)))
+ (setq prev (1+ (car unread)))
+ (setq unread (cdr unread)))
+ (when (<= prev (cdr active))
+ (setq read (cons (cons prev (cdr active)) read)))
+ (gnus-undo-register
+ `(progn
+ (gnus-info-set-marks ,info ,(gnus-info-marks info))
+ (gnus-info-set-read ,info ,(gnus-info-read info))
+ (gnus-get-unread-articles-in-group ,info (gnus-active ,group))))
+ ;; Enter this list into the group info.
+ (gnus-info-set-read
+ info (if (> (length read) 1) (nreverse read) read))
+ ;; Set the number of unread articles in gnus-newsrc-hashtb.
+ (gnus-get-unread-articles-in-group info (gnus-active group))
+ t)))
+
(provide 'gnus-sum)
;;; gnus-sum.el ends here
projects / gnus / blobdiff