;;; gnus-sum.el --- summary mode commands for Gnus
-;; Copyright (C) 1996 Free Software Foundation, Inc.
+;; Copyright (C) 1996,97 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
;; Keywords: news
(require 'gnus-int)
(require 'gnus-undo)
-;; Belongs to to gnus.el
-(defgroup gnus-various nil
- "Other Gnus options."
- :link '(custom-manual "(gnus)Various Various")
- :group 'gnus)
-
-;; Belongs to to gnus-group.el
-(defgroup gnus-group-select nil
- "Selecting a Group."
- :link '(custom-manual "(gnus)Selecting a Group")
- :group 'gnus-group)
-
-;; Belongs to to gnus-uu.el
-(defgroup gnus-extract-view nil
- "Viewing extracted files."
- :link '(custom-manual "(gnus)Viewing Files")
- :group 'gnus-extract)
-
-;; Belongs to article.el
-(defgroup article-hiding-headers nil
- "Hiding headers in the article buffer."
- :link '(custom-manual "(gnus)Hiding Headers")
- :group 'article)
-
-(defgroup article-various nil
- "Miscellaneous article options."
- :link '(custom-manual "(gnus)Misc Article")
- :group 'article)
-
-(defgroup article-mime nil
- "Encoding articles and including attachments."
- :link '(custom-manual "(gnus)Using MIME")
- :group 'article)
-
-;; These belong here.
-(defgroup gnus-summary nil
- "Summary buffers."
- :link '(custom-manual "(gnus)The Summary Buffer")
- :group 'gnus)
-
-(defgroup gnus-summary-exit nil
- "Leaving summary buffers."
- :link '(custom-manual "(gnus)Exiting the Summary Buffer")
- :group 'gnus-summary)
-
-(defgroup gnus-summary-marks nil
- "Marks used in summary buffers."
- :link '(custom-manual "(gnus)Marking Articles")
- :group 'gnus-summary)
-
-(defgroup gnus-thread nil
- "Ordering articles according to replies."
- :link '(custom-manual "(gnus)Threading")
- :group 'gnus-summary)
-
-(defgroup gnus-summary-format nil
- "Formatting of the summary buffer."
- :link '(custom-manual "(gnus)Summary Buffer Format")
- :group 'gnus-summary)
-
-(defgroup gnus-summary-choose nil
- "Choosing Articles."
- :link '(custom-manual "(gnus)Choosing Articles")
- :group 'gnus-summary)
-
-(defgroup gnus-summary-maneuvering nil
- "Summary movement commands."
- :link '(custom-manual "(gnus)Summary Maneuvering")
- :group 'gnus-summary)
-
-(defgroup gnus-summary-mail nil
- "Mail group commands."
- :link '(custom-manual "(gnus)Mail Group Commands")
- :group 'gnus-summary)
-
-(defgroup gnus-summary-sort nil
- "Sorting the summary buffer."
- :link '(custom-manual "(gnus)Sorting")
- :group 'gnus-summary)
-
-(defgroup gnus-summary-visual nil
- "Highlighting and menus in the summary buffer."
- :link '(custom-manual "(gnus)Summary Highlighting")
- :group 'gnus-visual
- :group 'gnus-summary)
-
-(defgroup gnus-summary-various nil
- "Various summary buffer options."
- :link '(custom-manual "(gnus)Various Summary Stuff")
- :group 'gnus-summary)
-
(defcustom 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
(const more)
(sexp :menu-tag "all" t)))
-(defcustom gnus-summary-thread-gathering-function 'gnus-gather-threads-by-subject
+(defcustom gnus-summary-thread-gathering-function
+ 'gnus-gather-threads-by-subject
"Function used for gathering loose threads.
There are two pre-defined functions: `gnus-gather-threads-by-subject',
which only takes Subjects into consideration; and
(defcustom gnus-summary-default-score 0
"*Default article score level.
+All scores generated by the score files will be added to this score.
If this variable is nil, scoring will be disabled."
- :group 'gnus-score
+ :group 'gnus-score-default
:type '(choice (const :tag "disable")
integer))
(defcustom gnus-show-all-headers nil
"*If non-nil, don't hide any headers."
- :group 'article-hiding-headers
+ :group 'gnus-article-hiding
+ :group 'gnus-article-headers
:type 'boolean)
+(defcustom gnus-summary-ignore-duplicates nil
+ "*If non-nil, ignore articles with identical Message-ID headers."
+ :group 'gnus-summary
+ :type 'boolean)
+
(defcustom gnus-single-article-buffer t
"*If non-nil, display all articles in the same buffer.
If nil, each group will get its own article buffer."
- :group 'article-various
+ :group 'gnus-article-various
:type 'boolean)
(defcustom gnus-break-pages t
"*If non-nil, do page breaking on articles.
The page delimiter is specified by the `gnus-page-delimiter'
variable."
- :group 'article-various
+ :group 'gnus-article-various
:type 'boolean)
(defcustom gnus-show-mime nil
"*If non-nil, do mime processing of articles.
The articles will simply be fed to the function given by
`gnus-show-mime-method'."
- :group 'article-mime
+ :group 'gnus-article-mime
:type 'boolean)
(defcustom gnus-move-split-methods nil
(cons regexp (repeat string))
sexp)))
-;; Mark variables suggested by Thomas Michanek
-;; <Thomas.Michanek@telelogic.se>.
-
(defcustom gnus-unread-mark ?
"*Mark used for unread articles."
:group 'gnus-summary-marks
"*Mark all articles with a score below this variable as read.
This variable is local to each summary buffer and usually set by the
score file."
- :group 'gnus-score
+ :group 'gnus-score-default
:type 'integer)
(defcustom gnus-article-sort-functions '(gnus-article-sort-by-number)
(defcustom gnus-summary-expunge-below nil
"All articles that have a score less than this variable will be expunged."
- :group 'gnus-score
+ :group 'gnus-score-default
:type '(choice (const :tag "off" nil)
integer))
See `gnus-thread-score-function' for en explanation of what a
\"thread score\" is."
:group 'gnus-treading
- :group 'gnus-score
+ :group 'gnus-score-default
:type '(choice (const :tag "off" nil)
integer))
:type 'hook)
(defcustom gnus-summary-exit-hook nil
- "*A hook called on exit from the summary buffer."
+ "*A hook called on exit from the summary buffer.
+It will be called with point in the group buffer."
:group 'gnus-summary-exit
:type 'hook)
:group 'gnus-summary-visual
:type 'hook)
-(defcustom gnus-parse-headers-hook
+(defcustom gnus-parse-headers-hook
(list 'gnus-decode-rfc1522)
"*A hook called before parsing the headers."
:group 'gnus-various
:group 'gnus-group-select
:type 'hook)
+(defcustom gnus-ps-print-hook nil
+ "*A hook run before ps-printing something from Gnus."
+ :group 'gnus-summary
+ :type 'hook)
+
(defcustom gnus-summary-selected-face 'gnus-summary-selected-face
"Face used for highlighting the current article in the summary buffer."
:group 'gnus-summary-visual
:type 'face)
-(defcustom gnus-summary-highlight
+(defcustom gnus-summary-highlight
'(((= mark gnus-canceled-mark)
. gnus-summary-cancelled-face)
((and (> score default)
. gnus-summary-low-unread-face)
((and (= mark gnus-unread-mark))
. gnus-summary-normal-unread-face)
- ((> score default)
+ ((> score default)
. gnus-summary-high-read-face)
- ((< score default)
+ ((< score default)
. gnus-summary-low-read-face)
- (t
+ (t
. gnus-summary-normal-read-face))
- "Controls the highlighting of summary buffer lines.
+ "Controls the highlighting of summary buffer lines.
A list of (FORM . FACE) pairs. When deciding how a a particular
summary line should be displayed, each form is evaluated. The content
score: The articles score
default: The default article score.
-below: The score below which articles are automatically marked as read.
+below: The score below which articles are automatically marked as read.
mark: The articles mark."
:group 'gnus-summary-visual
:type '(repeat (cons (sexp :tag "Form" nil)
face)))
+
;;; 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
- ;; display only a single character.
-
- ;; We start from the standard display table, if any.
- (let ((table (or (copy-sequence standard-display-table)
- (make-display-table)))
- ;; Nix out all the control chars...
- (i 32))
- (while (>= (setq i (1- i)) 0)
- (aset table i [??]))
- ;; ... but not newline and cr, of course. (cr is necessary for the
- ;; selective display).
- (aset table ?\n nil)
- (aset table ?\r nil)
- ;; We nix out any glyphs over 126 that are not set already.
- (let ((i 256))
- (while (>= (setq i (1- i)) 127)
- ;; Only modify if the entry is nil.
- (or (aref table i)
- (aset table i [??]))))
- table)
- "Display table used in summary mode buffers.")
+(defvar gnus-page-broken nil)
(defvar gnus-original-article nil)
(defvar gnus-article-internal-prepare-hook nil)
;; Remove any leading "re:"s, any trailing paren phrases, and simplify
;; all whitespace.
-;; Written by Stainless Steel Rat <ratinox@ccs.neu.edu>.
+(defsubst gnus-simplify-buffer-fuzzy-step (regexp &optional newtext)
+ (goto-char (point-min))
+ (while (re-search-forward regexp nil t)
+ (replace-match (or newtext ""))))
+
(defun gnus-simplify-buffer-fuzzy ()
- (let ((case-fold-search t))
- (goto-char (point-min))
- (while (search-forward "\t" nil t)
- (replace-match " " t t))
- (goto-char (point-min))
- (re-search-forward "^ *\\(re\\|fwd\\)[[{(^0-9]*[])}]?[:;] *" nil t)
- (goto-char (match-beginning 0))
- (while (or
- (and
- gnus-simplify-subject-fuzzy-regexp
- (looking-at gnus-simplify-subject-fuzzy-regexp))
- (looking-at "^ *\\(re\\|fwd\\)[[{(^0-9]*[])}]?[:;] *")
- (looking-at "^[[].*: .*[]]$"))
- (goto-char (point-min))
- (when gnus-simplify-subject-fuzzy-regexp
- (while (re-search-forward gnus-simplify-subject-fuzzy-regexp
- nil t)
- (replace-match "" t t)))
- (goto-char (point-min))
- (while (re-search-forward "^ *\\(re\\|fw\\|fwd\\)[[{(^0-9]*[])}]?[:;] *"
- nil t)
- (replace-match "" t t))
- (goto-char (point-min))
- (while (re-search-forward "^[[].*: .*[]]$" nil t)
- (goto-char (match-end 0))
- (delete-char -1)
- (delete-region
- (progn (goto-char (match-beginning 0)))
- (re-search-forward ":"))))
- (goto-char (point-min))
- (while (re-search-forward " *[[{(][^()\n]*[]})] *$" nil t)
- (replace-match "" t t))
- (goto-char (point-min))
- (while (re-search-forward " +" nil t)
- (replace-match " " t t))
- (goto-char (point-min))
- (while (re-search-forward " $" nil t)
- (replace-match "" t t))
- (goto-char (point-min))
- (while (re-search-forward "^ +" nil t)
- (replace-match "" t t))))
+ "Simplify string in the buffer fuzzily.
+The string in the accessible portion of the current buffer is simplified.
+It is assumed to be a single-line subject.
+Whitespace is generally cleaned up, and miscellaneous leading/trailing
+matter is removed. Additional things can be deleted by setting
+gnus-simplify-subject-fuzzy-regexp."
+ (let ((case-fold-search t)
+ (modified-tick))
+ (gnus-simplify-buffer-fuzzy-step "\t" " ")
+
+ (while (not (eq modified-tick (buffer-modified-tick)))
+ (setq modified-tick (buffer-modified-tick))
+ (cond
+ ((listp gnus-simplify-subject-fuzzy-regexp)
+ (mapcar 'gnus-simplify-buffer-fuzzy-step
+ gnus-simplify-subject-fuzzy-regexp))
+ (gnus-simplify-subject-fuzzy-regexp
+ (gnus-simplify-buffer-fuzzy-step gnus-simplify-subject-fuzzy-regexp)))
+ (gnus-simplify-buffer-fuzzy-step "^ *\\[[-+?*!][-+?*!]\\] *")
+ (gnus-simplify-buffer-fuzzy-step
+ "^ *\\(re\\|fw\\|fwd\\)[[{(^0-9]*[])}]?[:;] *")
+ (gnus-simplify-buffer-fuzzy-step "^[[].*:\\( .*\\)[]]$" "\\1"))
+
+ (gnus-simplify-buffer-fuzzy-step " *[[{(][^()\n]*[]})] *$")
+ (gnus-simplify-buffer-fuzzy-step " +" " ")
+ (gnus-simplify-buffer-fuzzy-step " $")
+ (gnus-simplify-buffer-fuzzy-step "^ +")))
(defun gnus-simplify-subject-fuzzy (subject)
- "Simplify a subject string fuzzily."
+ "Simplify a subject string fuzzily.
+See gnus-simplify-buffer-fuzzy for details."
(save-excursion
(gnus-set-work-buffer)
(let ((case-fold-search t))
(buffer-string))))
(defsubst gnus-simplify-subject-fully (subject)
- "Simplify a subject string according to the user's wishes."
+ "Simplify a subject string according to gnus-summary-gather-subject-limit."
(cond
((null gnus-summary-gather-subject-limit)
(gnus-simplify-subject-re subject))
(equal s1
(gnus-simplify-subject-fully s2)))))
-(defun gnus-offer-save-summaries ()
- "Offer to save all active summary buffers."
- (save-excursion
- (let ((buflist (buffer-list))
- buffers bufname)
- ;; Go through all buffers and find all summaries.
- (while buflist
- (and (setq bufname (buffer-name (car buflist)))
- (string-match "Summary" bufname)
- (save-excursion
- (set-buffer bufname)
- ;; We check that this is, indeed, a summary buffer.
- (and (eq major-mode 'gnus-summary-mode)
- ;; Also make sure this isn't bogus.
- gnus-newsgroup-prepared))
- (push bufname buffers))
- (setq buflist (cdr buflist)))
- ;; Go through all these summary buffers and offer to save them.
- (when buffers
- (map-y-or-n-p
- "Update summary buffer %s? "
- (lambda (buf) (set-buffer buf) (gnus-summary-exit))
- buffers)))))
-
(defun gnus-summary-bubble-group ()
"Increase the score of the current group.
This is a handy function to add to `gnus-summary-exit-hook' to
"\M-#" gnus-uu-unmark-thread)
(gnus-define-keys (gnus-summary-buffer-map "Y" gnus-summary-mode-map)
- "g" gnus-summary-prepare
+ "g" gnus-summary-prepare
"c" gnus-summary-insert-cached-articles)
(gnus-define-keys (gnus-summary-exit-map "Z" gnus-summary-mode-map)
"r" gnus-summary-caesar-message
"t" gnus-article-hide-headers
"v" gnus-summary-verbose-headers
- "m" gnus-summary-toggle-mime)
+ "m" gnus-summary-toggle-mime
+ "h" gnus-article-treat-html)
(gnus-define-keys (gnus-summary-wash-hide-map "W" gnus-summary-wash-map)
"a" gnus-article-hide
"u" gnus-article-date-ut
"l" gnus-article-date-local
"e" gnus-article-date-lapsed
- "o" gnus-article-date-original)
+ "o" gnus-article-date-original
+ "s" gnus-article-date-user)
(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)
+ "a" gnus-article-strip-blank-lines
+ "s" gnus-article-strip-leading-space)
(gnus-define-keys (gnus-summary-help-map "H" gnus-summary-mode-map)
"v" gnus-version
'(("Default header"
["Ask" (gnus-score-set-default 'gnus-score-default-header nil)
- :style radio
+ :style radio
:selected (null gnus-score-default-header)]
["From" (gnus-score-set-default 'gnus-score-default-header 'a)
- :style radio
+ :style radio
:selected (eq gnus-score-default-header 'a)]
["Subject" (gnus-score-set-default 'gnus-score-default-header 's)
- :style radio
+ :style radio
:selected (eq gnus-score-default-header 's)]
["Article body"
(gnus-score-set-default 'gnus-score-default-header 'b)
- :style radio
+ :style radio
:selected (eq gnus-score-default-header 'b )]
["All headers"
(gnus-score-set-default 'gnus-score-default-header 'h)
- :style radio
+ :style radio
:selected (eq gnus-score-default-header 'h )]
["Message-ID" (gnus-score-set-default 'gnus-score-default-header 'i)
- :style radio
+ :style radio
:selected (eq gnus-score-default-header 'i )]
["Thread" (gnus-score-set-default 'gnus-score-default-header 't)
- :style radio
+ :style radio
:selected (eq gnus-score-default-header 't )]
["Crossposting"
(gnus-score-set-default 'gnus-score-default-header 'x)
- :style radio
+ :style radio
:selected (eq gnus-score-default-header 'x )]
["Lines" (gnus-score-set-default 'gnus-score-default-header 'l)
- :style radio
+ :style radio
:selected (eq gnus-score-default-header 'l )]
["Date" (gnus-score-set-default 'gnus-score-default-header 'd)
- :style radio
+ :style radio
:selected (eq gnus-score-default-header 'd )]
["Followups to author"
(gnus-score-set-default 'gnus-score-default-header 'f)
- :style radio
+ :style radio
:selected (eq gnus-score-default-header 'f )])
("Default type"
["Ask" (gnus-score-set-default 'gnus-score-default-type nil)
- :style radio
+ :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.
+ ;; active to indicate which button is selected.
["Substring" (gnus-score-set-default 'gnus-score-default-type 's)
- :style radio
+ :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)
;; :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
+ :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
+ :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
+ :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
+ :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
+ :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
+ :style radio
;; :active (eq (gnus-score-default-header 'l))
:selected (eq gnus-score-default-type '=)]
- ["Greater than number"
+ ["Greater than number"
(gnus-score-set-default 'gnus-score-default-type '>)
- :style radio
+ :style radio
;; :active (eq (gnus-score-default-header 'l))
:selected (eq gnus-score-default-type '>)])
["Default fold" gnus-score-default-fold-toggle
(gnus-score-set-default 'gnus-score-default-duration 't)
:style radio
:selected (eq gnus-score-default-duration 't)]
- ["Immediate"
+ ["Immediate"
(gnus-score-set-default 'gnus-score-default-duration 'i)
:style radio
:selected (eq gnus-score-default-duration 'i)]))
["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"
+ ["Lapsed" gnus-article-date-lapsed t]
+ ["User-defined" gnus-article-date-user t])
+ ("Washing"
("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])
+ ["All of the above" gnus-article-strip-blank-lines t]
+ ["Leading space" gnus-article-strip-leading-space 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]
+ ["UnHTMLize" gnus-article-treat-html t]
["Rot 13" gnus-summary-caesar-message t]
+ ["Unix pipe" gnus-summary-pipe-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]
["Save" gnus-uu-decode-save t]
["Binhex" gnus-uu-decode-binhex t]
["Postscript" gnus-uu-decode-postscript t])
+ ("Cache"
+ ["Enter article" gnus-cache-enter-article t]
+ ["Remove article" gnus-cache-remove-article 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]
["Cancel article" gnus-summary-cancel-article t]
["Reply" gnus-summary-reply t]
["Reply and yank" gnus-summary-reply-with-original t]
+ ["Wide reply" gnus-summary-wide-reply t]
+ ["Wide reply and yank" gnus-summary-wide-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]
["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"
+ ["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])
["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])
["Toggle threading" gnus-summary-toggle-threads t])
["Filter articles..." gnus-summary-execute-command t]
["Run command on subjects..." gnus-summary-universal-argument t]
+ ["Search articles forward..." gnus-summary-search-article-forward t]
+ ["Search articles backward..." gnus-summary-search-article-backward 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"
("permanent" nil)
("immediate" now)))
header)
- (list
- (apply
+ (list
+ (apply
'nconc
(list
(if (eq type 'lower)
(let (outh)
(while headers
(setq header (car headers))
- (setq outh
- (cons
- (apply
+ (setq outh
+ (cons
+ (apply
'nconc
(list (car header))
(let ((ts (cdr (assoc (nth 2 header) types)))
outt)
(while ts
(setq outt
- (cons
- (apply
+ (cons
+ (apply
'nconc
(list (caar ts))
(let ((ps perms)
(string= (nth 1 header)
"body"))
""
- (list 'gnus-summary-header
+ (list 'gnus-summary-header
(nth 1 header)))
(list 'quote (nth 1 (car ts)))
(list 'gnus-score-default nil)
(setq truncate-lines t)
(setq selective-display t)
(setq selective-display-ellipses t) ;Display `...'
- (setq buffer-display-table gnus-summary-display-table)
+ (gnus-summary-set-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)
(make-local-variable 'gnus-summary-mark-positions)
- (gnus-make-local-hook 'post-command-hook)
- (gnus-add-hook 'post-command-hook 'gnus-clear-inboxes-moved nil t)
+ (make-local-hook 'post-command-hook)
+ (add-hook 'post-command-hook 'gnus-clear-inboxes-moved nil t)
(run-hooks 'gnus-summary-mode-hook)
(gnus-update-format-specifications nil 'summary 'summary-mode 'summary-dummy)
(gnus-update-summary-mark-positions))
(defmacro gnus-data-header (data)
`(nth 3 ,data))
+(defmacro gnus-data-set-header (data header)
+ `(setf (nth 3 ,data) ,header))
+
(defmacro gnus-data-level (data)
`(nth 4 ,data))
(level (gnus-data-level (car data)))
children)
(setq data (cdr data))
- (while (and data
+ (while (and data
(= (gnus-data-level (car data)) (1+ level)))
(push (gnus-data-number (car data)) children)
(setq data (cdr data)))
(mouse-set-point e)
(gnus-summary-next-page nil t))
+(defun gnus-summary-set-display-table ()
+ ;; Change the display table. Odd characters have a tendency to mess
+ ;; up nicely formatted displays - we make all possible glyphs
+ ;; display only a single character.
+
+ ;; We start from the standard display table, if any.
+ (let ((table (or (copy-sequence standard-display-table)
+ (make-display-table)))
+ (i 32))
+ ;; Nix out all the control chars...
+ (while (>= (setq i (1- i)) 0)
+ (aset table i [??]))
+ ;; ... but not newline and cr, of course. (cr is necessary for the
+ ;; selective display).
+ (aset table ?\n nil)
+ (aset table ?\r nil)
+ ;; We nix out any glyphs over 126 that are not set already.
+ (let ((i 256))
+ (while (>= (setq i (1- i)) 127)
+ ;; Only modify if the entry is nil.
+ (unless (aref table i)
+ (aset table i [??]))))
+ (setq buffer-display-table table)))
+
(defun gnus-summary-setup-buffer (group)
"Initialize summary buffer."
(let ((buffer (concat "*Summary " group "*")))
(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
+(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
+ &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))
(defvar gnus-tmp-new-adopts nil)
(defun gnus-summary-number-of-articles-in-thread (thread &optional level char)
- "Return the number of articles in THREAD.
+ "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
(symbolp (car elem)) ; Has to be a symbol in there.
(not (memq (car elem)
'(quit-config to-address to-list to-group)))
- (progn ; So we set it.
+ (ignore-errors ; So we set it.
(make-local-variable (car elem))
(set (car elem) (eval (nth 1 elem))))))))
If SHOW-ALL is non-nil, already read articles are also listed.
If NO-ARTICLE is non-nil, no article is selected initially.
If NO-DISPLAY, don't generate a summary buffer."
+ (let (result)
+ (while (and group
+ (null (setq result
+ (let ((gnus-auto-select-next nil))
+ (gnus-summary-read-group-1
+ group show-all no-article
+ kill-buffer no-display))))
+ (eq gnus-auto-select-next 'quietly))
+ (set-buffer gnus-group-buffer)
+ (if (not (equal group (gnus-group-group-name)))
+ (setq group (gnus-group-group-name))
+ (setq group nil)))
+ result))
+
+(defun gnus-summary-read-group-1 (group show-all no-article
+ kill-buffer no-display)
+ ;; Killed foreign groups can't be entered.
+ (when (and (not (gnus-group-native-p group))
+ (not (gnus-gethash group gnus-newsrc-hashtb)))
+ (error "Dead non-native groups can't be entered"))
(gnus-message 5 "Retrieving newsgroup: %s..." group)
(let* ((new-group (gnus-summary-setup-buffer group))
(quit-config (gnus-group-quit-config group))
(let ((gnus-newsgroup-dormant nil))
(gnus-summary-initial-limit show-all))
(gnus-summary-initial-limit show-all))
- (setq gnus-newsgroup-limit
- (mapcar
+ (setq gnus-newsgroup-limit
+ (mapcar
(lambda (header) (mail-header-number header))
gnus-newsgroup-headers)))
;; Generate the summary buffer.
(not no-display))
(progn
;; This newsgroup is empty.
- (gnus-summary-catchup-and-exit nil t) ;Without confirmations.
+ (gnus-summary-catchup-and-exit nil t)
(gnus-message 6 "No unread news")
(when kill-buffer
(gnus-kill-or-deaden-summary kill-buffer))
(select-window (get-buffer-window gnus-group-buffer t))
(when (gnus-group-goto-group group)
(recenter))
- (select-window owin))))
- ;; Mark this buffer as "prepared".
- (setq gnus-newsgroup-prepared t)
- t))))
+ (select-window owin)))
+ ;; Mark this buffer as "prepared".
+ (setq gnus-newsgroup-prepared t)
+ t)))))
(defun gnus-summary-prepare ()
"Generate the summary buffer."
;; Just remove the leading "Re:".
(t
(gnus-simplify-subject-re subject))))
-
+
(if (and gnus-summary-gather-exclude-subject
(string-match gnus-summary-gather-exclude-subject subject))
nil ; This article shouldn't be gathered
subject hthread whole-subject)
(while threads
(setq subject (gnus-general-simplify-subject
- (setq whole-subject (mail-header-subject
+ (setq whole-subject (mail-header-subject
(caar threads)))))
(when subject
(if (setq hthread (gnus-gethash subject hashtb))
(defun gnus-thread-loop-p (root thread)
"Say whether ROOT is in THREAD."
- (let ((th (cdr thread)))
- (while (and th
- (not (eq (caar th) root)))
- (pop th))
- (if th
- ;; We have found a loop.
- (let (ref-dep)
- (setcdr thread (delq (car th) (cdr thread)))
- (if (boundp (setq ref-dep (intern "none"
- gnus-newsgroup-dependencies)))
- (setcdr (symbol-value ref-dep)
- (nconc (cdr (symbol-value ref-dep))
- (list (car th))))
- (set ref-dep (list nil (car th))))
- 1)
- ;; Recurse down into the sub-threads and look for loops.
- (apply '+
- (mapcar
- (lambda (thread) (gnus-thread-loop-p root thread))
- (cdr thread))))))
+ (let ((stack (list thread))
+ (infloop 0)
+ th)
+ (while (setq thread (pop stack))
+ (setq th (cdr thread))
+ (while (and th
+ (not (eq (caar th) root)))
+ (pop th))
+ (if th
+ ;; We have found a loop.
+ (let (ref-dep)
+ (setcdr thread (delq (car th) (cdr thread)))
+ (if (boundp (setq ref-dep (intern "none"
+ gnus-newsgroup-dependencies)))
+ (setcdr (symbol-value ref-dep)
+ (nconc (cdr (symbol-value ref-dep))
+ (list (car th))))
+ (set ref-dep (list nil (car th))))
+ (setq infloop 1
+ stack nil))
+ ;; Push all the subthreads onto the stack.
+ (push (cdr thread) stack)))
+ infloop))
(defun gnus-make-threads ()
"Go through the dependency hashtb and find the roots. Return all threads."
;; Deal with self-referencing References loops.
(when (and (car (symbol-value refs))
(not (zerop
- (apply
+ (apply
'+
(mapcar
(lambda (thread)
(defun gnus-build-sparse-threads ()
(let ((headers gnus-newsgroup-headers)
(deps gnus-newsgroup-dependencies)
- header references generation relations
+ header references generation relations
cthread subject child end pthread relation)
- ;; First we create an alist of generations/relations, where
+ ;; First we create an alist of generations/relations, where
;; generations is how much we trust the relation, and the relation
;; is parent/child.
(gnus-message 7 "Making sparse threads...")
(unless (car (symbol-value cthread))
;; Make this article the parent of these threads.
(setcar (symbol-value cthread)
- (vector gnus-reffed-article-number
+ (vector gnus-reffed-article-number
(cadddr relation)
"" ""
(cadr relation)
(prog1
(save-excursion
(set-buffer nntp-server-buffer)
- (goto-char (point-min))
- (while (and (not found) (search-forward id nil t))
- (beginning-of-line)
- (setq found (looking-at
- (format "^[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t%s"
- (regexp-quote id))))
- (or found (beginning-of-line 2)))
- (when found
- (beginning-of-line)
- (and
- (setq header (gnus-nov-parse-line
- (read (current-buffer)) deps))
- (gnus-parent-id (mail-header-references header)))))
+ (let ((case-fold-search nil))
+ (goto-char (point-min))
+ (while (and (not found)
+ (search-forward id nil t))
+ (beginning-of-line)
+ (setq found (looking-at
+ (format "^[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t%s"
+ (regexp-quote id))))
+ (or found (beginning-of-line 2)))
+ (when found
+ (beginning-of-line)
+ (and
+ (setq header (gnus-nov-parse-line
+ (read (current-buffer)) deps))
+ (gnus-parent-id (mail-header-references header))))))
(when header
(let ((number (mail-header-number header)))
(push number gnus-newsgroup-limit)
header level nil (gnus-article-mark article)
(memq article gnus-newsgroup-replied)
(memq article gnus-newsgroup-expirable)
- (mail-header-subject header)
+ ;; Only insert the Subject string when it's different
+ ;; from the previous Subject string.
+ (if (gnus-subject-equal
+ (condition-case ()
+ (mail-header-subject
+ (gnus-data-header
+ (cadr
+ (gnus-data-find-list
+ article
+ (gnus-data-list t)))))
+ ;; Error on the side of excessive subjects.
+ (error ""))
+ (mail-header-subject header))
+ ""
+ (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)
(references (mail-header-references header))
(parent
(gnus-id-to-thread
- (or (gnus-parent-id
+ (or (gnus-parent-id
(when (and references
(not (equal "" references)))
references))
(defun gnus-parent-headers (headers &optional generation)
"Return the headers of the GENERATIONeth parent of HEADERS."
- (unless generation
+ (unless generation
(setq generation 1))
(let (references parent)
(while (and headers (not (zerop generation)))
(let ((level (gnus-summary-thread-level article))
(refs (mail-header-references (gnus-summary-article-header article)))
particle)
- (cond
+ (cond
((null level) nil)
((zerop level) t)
((null refs) t)
(defun gnus-root-id (id)
"Return the id of the root of the thread where ID appears."
(let (last-id prev)
- (while (and id (setq prev (car (gnus-gethash
+ (while (and id (setq prev (car (gnus-gethash
id gnus-newsgroup-dependencies))))
(setq last-id id
id (gnus-parent-id (mail-header-references prev))))
(gnus-remove-thread-1 (pop thread)))
(when (setq d (gnus-data-find number))
(goto-char (gnus-data-pos d))
- (gnus-data-remove
+ (gnus-data-remove
number
(- (gnus-point-at-bol)
(prog1
(gnus-message 7 "Sorting articles...")
(prog1
(setq gnus-newsgroup-headers
- (sort articles (gnus-make-sort-function
+ (sort articles (gnus-make-sort-function
gnus-article-sort-functions)))
(gnus-message 7 "Sorting articles...done"))))
(let ((extract (funcall
gnus-extract-address-components
(mail-header-from h1))))
- (or (car extract) (cdr extract)))
+ (or (car extract) (cadr extract) ""))
(let ((extract (funcall
gnus-extract-address-components
(mail-header-from h2))))
- (or (car extract) (cdr extract)))))
+ (or (car extract) (cadr extract) ""))))
(defun gnus-thread-sort-by-author (h1 h2)
"Sort threads by root author."
"Generate an unthreaded summary buffer based on HEADERS."
(let (header number mark)
+ (beginning-of-line)
+
(while headers
;; We may have to root out some bad articles...
(when (memq (setq number (mail-header-number
"Select newsgroup GROUP.
If READ-ALL is non-nil, all articles in the group are selected."
(let* ((entry (gnus-gethash group gnus-newsrc-hashtb))
+ ;;!!! Dirty hack; should be removed.
+ (gnus-summary-ignore-duplicates
+ (if (eq (car (gnus-find-method-for-group group)) 'nnvirtual)
+ t
+ gnus-summary-ignore-duplicates))
(info (nth 2 entry))
articles fetched-articles cached)
(unless (gnus-check-server
- (setq gnus-current-select-method (gnus-find-method-for-group group)))
+ (setq gnus-current-select-method
+ (gnus-find-method-for-group group)))
(error "Couldn't open server"))
(or (and entry (not (eq (car entry) t))) ; Either it's active...
(setq gnus-newsgroup-processable nil)
+ (gnus-update-read-articles group gnus-newsgroup-unreads)
+ (unless (gnus-ephemeral-group-p gnus-newsgroup-name)
+ (gnus-group-update-group group))
+
(setq articles (gnus-articles-to-read group read-all))
(cond
(not (eq gnus-fetch-old-headers 'some))
(not (numberp gnus-fetch-old-headers)))
(> (length articles) 1))))))
- (gnus-get-newsgroup-headers-xover articles)
+ (gnus-get-newsgroup-headers-xover
+ articles nil nil gnus-newsgroup-name t)
(gnus-get-newsgroup-headers)))
(gnus-message 5 "Fetching headers for %s...done" gnus-newsgroup-name)
(read-string
(format
"How many articles from %s (default %d): "
- gnus-newsgroup-name number))))
+ (gnus-limit-string gnus-newsgroup-name 35)
+ number))))
(if (string-match "^[ \t]*$" input) number input)))
((and (> scored marked) (< scored number)
(> (- scored number) 20))
;; All articles have to be subsets of the active articles.
(cond
;; Adjust "simple" lists.
- ((memq mark '(tick dormant expirable reply save))
+ ((memq mark '(tick dormant expire reply save))
(while articles
(when (or (< (setq article (pop articles)) min) (> article max))
(set var (delq article (symbol-value var))))))
type list newmarked symbol)
(when info
;; Add all marks lists that are non-nil to the list of marks lists.
- (while types
- (setq type (pop types))
+ (while (setq type (pop types))
(when (setq list (symbol-value
(setq symbol
(intern (format "gnus-newsgroup-%s"
(car type))))))
+
+ ;; Get rid of the entries of the articles that have the
+ ;; default score.
+ (when (and (eq (cdr type) 'score)
+ gnus-save-score
+ list)
+ (let* ((arts list)
+ (prev (cons nil list))
+ (all prev))
+ (while arts
+ (if (or (not (consp (car arts)))
+ (= (cdar arts) gnus-summary-default-score))
+ (setcdr prev (cdr arts))
+ (setq prev arts))
+ (setq arts (cdr arts)))
+ (setq list (cdr all))))
+
(push (cons (cdr type)
(if (memq (cdr type) uncompressed) list
- (gnus-compress-sequence
+ (gnus-compress-sequence
(set symbol (sort list '<)) t)))
newmarked)))
(gnus-mode-string-quote
(mail-header-subject gnus-current-headers))
""))
- max-len
+ bufname-length max-len
gnus-tmp-header);; passed as argument to any user-format-funcs
(setq mode-string (eval mformat))
+ (setq bufname-length (if (string-match "%b" mode-string)
+ (- (length
+ (buffer-name
+ (if (eq where 'summary)
+ nil
+ (get-buffer gnus-article-buffer))))
+ 2)
+ 0))
(setq max-len (max 4 (if gnus-mode-non-string-length
(- (window-width)
- gnus-mode-non-string-length)
+ gnus-mode-non-string-length
+ bufname-length)
(length mode-string))))
;; We might have to chop a bit of the string off...
(when (> (length mode-string) max-len)
;; Pad the mode string a bit.
(setq mode-string (format (format "%%-%ds" max-len) mode-string))))
;; Update the mode line.
- (setq mode-line-buffer-identification
- (gnus-mode-line-buffer-identification
- (list mode-string)))
+ (setq mode-line-buffer-identification
+ (gnus-mode-line-buffer-identification (list mode-string)))
(set-buffer-modified-p t))))
(defun gnus-create-xref-hashtb (from-newsgroup headers unreads)
xref-hashtb)))))
(defun gnus-group-make-articles-read (group articles)
- "Update the info of GROUP to say that only ARTICLES are unread."
+ "Update the info of GROUP to say that ARTICLES are read."
(let* ((num 0)
(entry (gnus-gethash group gnus-newsrc-hashtb))
(info (nth 2 entry))
;; Message-ID.
(progn
(goto-char p)
- (setq id (if (search-forward "\nmessage-id: " nil t)
- (nnheader-header-value)
+ (setq id (if (search-forward "\nmessage-id:" nil t)
+ (buffer-substring
+ (1- (or (search-forward "<" nil t) (point)))
+ (or (search-forward ">" nil t) (point)))
;; If there was no message-id, we just fake one
;; to make subsequent routines simpler.
(nnheader-generate-fake-message-id))))
(progn
(goto-char p)
(if (search-forward "\nlines: " nil t)
- (if (numberp (setq lines (read cur)))
+ (if (numberp (setq lines (ignore-errors (read cur))))
lines 0)
0))
;; Xref.
(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))
+ ;; An article with this Message-ID has already been seen.
+ (if gnus-summary-ignore-duplicates
+ ;; 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))
+ ;; We rename the Message-ID.
+ (set
+ (setq id-dep (intern (setq id (nnmail-message-id))
+ dependencies))
+ (list header))
+ (mail-header-set-id header id))
(setcar (symbol-value id-dep) header))
(set id-dep (list header)))
(when header
(gnus-nov-read-integer) ; lines
(if (= (following-char) ?\n)
nil
- (gnus-nov-field)) ; misc
- )))
+ (gnus-nov-field))))) ; misc
(widen))
(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))
+ ;; An article with this Message-ID has already been seen.
+ (if gnus-summary-ignore-duplicates
+ ;; 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))
+ ;; We rename the Message-ID.
+ (set
+ (setq id-dep (intern (setq id (nnmail-message-id))
+ dependencies))
+ (list header))
+ (mail-header-set-id header id))
(setcar (symbol-value id-dep) header))
(set id-dep (list header)))
(when header
header))
;; Goes through the xover lines and returns a list of vectors
-(defun gnus-get-newsgroup-headers-xover (sequence &optional
- force-new dependencies)
+(defun gnus-get-newsgroup-headers-xover (sequence &optional
+ force-new dependencies
+ group also-fetch-heads)
"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
;; article may not have been generated yet, so this may fail.
;; We work around this problem by retrieving the last few
;; headers using HEAD.
- (if (not sequence)
+ (if (or (not also-fetch-heads)
+ (not sequence))
+ ;; We (probably) got all the headers.
(nreverse headers)
- (let ((gnus-nov-is-evil t)
- (nntp-nov-is-evil t))
+ (let ((gnus-nov-is-evil t))
(nconc
(nreverse headers)
- (when (gnus-retrieve-headers sequence gnus-newsgroup-name)
+ (when (gnus-retrieve-headers sequence group)
(gnus-get-newsgroup-headers))))))))
(defun gnus-article-get-xrefs ()
old-header)
(when (setq d (gnus-data-find (mail-header-number old-header)))
(goto-char (gnus-data-pos d))
- (gnus-data-remove
+ (gnus-data-remove
number
(- (gnus-point-at-bol)
(prog1
(cond
(n
;; A numerical prefix has been given.
+ (setq n (prefix-numeric-value n))
(let ((backward (< n 0))
(n (abs (prefix-numeric-value n)))
articles article)
(gnus-summary-find-next nil article)))
(decf n)))
(nreverse articles)))
- ((and (boundp 'transient-mark-mode)
- transient-mark-mode
- mark-active)
+ ((gnus-region-active-p)
;; Work on the region between point and mark.
(let ((max (max (point) (mark)))
articles article)
;; possible valid number, or the second line from the top,
;; whichever is the least.
(set-window-start
- window (min bottom (save-excursion
+ 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)
(group gnus-newsgroup-name))
(setq gnus-newsgroup-begin nil)
(gnus-summary-exit)
- ;; We have to adjust the point of group mode buffer because the
- ;; current point was moved to the next unread newsgroup by
- ;; exiting.
+ ;; We have to adjust the point of group mode buffer because
+ ;; point was moved to the next unread newsgroup by exiting.
(gnus-summary-jump-to-group group)
(when rescan
(save-excursion
(defun gnus-summary-save-newsrc (&optional force)
"Save the current number of read/marked articles in the dribble buffer.
+The dribble buffer will then be saved.
If FORCE (the prefix), also save the .newsrc file(s)."
(interactive "P")
(gnus-summary-update-info t)
- (when force
- (gnus-save-newsrc-file)))
+ (if force
+ (gnus-save-newsrc-file)
+ (gnus-dribble-save)))
(defun gnus-summary-exit (&optional temporary)
"Exit reading current newsgroup, and then return to group selection mode.
(run-hooks 'gnus-exit-group-hook)
(gnus-summary-update-info))
(gnus-close-group group)
- ;; Make sure where I was, and go to next newsgroup.
+ ;; Make sure where we were, and go to next newsgroup.
(set-buffer gnus-group-buffer)
(unless quit-config
(gnus-group-jump-to-group group))
(progn
(gnus-message 5 "Returning to the group buffer")
(setq entered t)
- (set-buffer current-buffer)
- (gnus-summary-exit)
+ (when (gnus-buffer-live-p current-buffer)
+ (set-buffer current-buffer)
+ (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)
;; 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"))
(unless (gnus-ephemeral-group-p gnus-newsgroup-name)
(gnus-summary-jump-to-group gnus-newsgroup-name))
(let ((cmd last-command-char)
+ (point
+ (save-excursion
+ (set-buffer gnus-group-buffer)
+ (point)))
(group
(if (eq gnus-keep-same-level 'best)
(gnus-summary-best-group gnus-newsgroup-name)
(t
(when (gnus-key-press-event-p last-input-event)
(gnus-summary-walk-group-buffer
- gnus-newsgroup-name cmd unread backward))))))))
+ gnus-newsgroup-name cmd unread backward point))))))))
-(defun gnus-summary-walk-group-buffer (from-group cmd unread backward)
+(defun gnus-summary-walk-group-buffer (from-group cmd unread backward start)
(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-jump-to-group from-group)
+ (goto-char start)
(setq group
(if (eq gnus-keep-same-level 'best)
(gnus-summary-best-group gnus-newsgroup-name)
(defun gnus-summary-next-unread-article ()
"Select unread article after current one."
(interactive)
- (gnus-summary-next-article
+ (gnus-summary-next-article
(or (not (eq gnus-summary-goto-unread 'never))
(gnus-summary-last-article-p (gnus-summary-article-number)))
(and gnus-auto-select-same
(setq gnus-summary-buffer (current-buffer))
(gnus-set-global-variables)
(let ((article (gnus-summary-article-number))
- (endp nil))
+ (article-window (get-buffer-window gnus-article-buffer t))
+ endp)
(gnus-configure-windows 'article)
(if (eq (cdr (assq article gnus-newsgroup-reads)) gnus-canceled-mark)
(if (and (eq gnus-summary-goto-unread 'never)
(not (equal (car gnus-article-current) gnus-newsgroup-name)))
;; Selected subject is different from current article's.
(gnus-summary-display-article article)
- (gnus-eval-in-buffer-window gnus-article-buffer
- (setq endp (gnus-article-next-page lines)))
- (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)))))))
+ (when article-window
+ (gnus-eval-in-buffer-window gnus-article-buffer
+ (setq endp (gnus-article-next-page lines)))
+ (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)))
-(defun gnus-summary-prev-page (&optional lines)
+(defun gnus-summary-prev-page (&optional lines move)
"Show previous page of selected article.
-Argument LINES specifies lines to be scrolled down."
+Argument LINES specifies lines to be scrolled down.
+If MOVE, move to the previous unread article if point is at
+the beginning of the buffer."
(interactive "P")
(gnus-set-global-variables)
- (let ((article (gnus-summary-article-number)))
+ (let ((article (gnus-summary-article-number))
+ (article-window (get-buffer-window gnus-article-buffer t))
+ endp)
(gnus-configure-windows 'article)
(if (or (null gnus-current-article)
(null gnus-article-current)
;; Selected subject is different from current article's.
(gnus-summary-display-article article)
(gnus-summary-recenter)
- (gnus-eval-in-buffer-window gnus-article-buffer
- (gnus-article-prev-page lines))))
+ (when article-window
+ (gnus-eval-in-buffer-window gnus-article-buffer
+ (setq endp (gnus-article-prev-page lines)))
+ (when (and move endp)
+ (cond (lines
+ (gnus-message 3 "Beginning of message"))
+ ((null lines)
+ (if (and (eq gnus-summary-goto-unread 'never)
+ (not (gnus-summary-first-article-p article)))
+ (gnus-summary-prev-article)
+ (gnus-summary-prev-unread-article))))))))
(gnus-summary-position-point))
+(defun gnus-summary-prev-page-or-article (&optional lines)
+ "Show previous page of selected article.
+Argument LINES specifies lines to be scrolled down.
+If at the beginning of the article, go to the next article."
+ (interactive "P")
+ (gnus-summary-prev-page lines t))
+
(defun gnus-summary-scroll-up (lines)
"Scroll up (or down) one line current article.
Argument LINES specifies lines to be scrolled up (or down if negative)."
If given a prefix, remove all limits."
(interactive "P")
(gnus-set-global-variables)
- (when total
+ (when total
(setq gnus-newsgroup-limits
(list (mapcar (lambda (h) (mail-header-number h))
gnus-newsgroup-headers))))
(gnus-summary-limit-to-subject from "from"))
(defun gnus-summary-limit-to-age (age &optional younger-p)
- "Limit the summary buffer to articles that are older than (or equal) AGE days.
+ "Limit the summary buffer to articles that are older than (or equal) AGE days.
If YOUNGER-P (the prefix) is non-nil, limit the summary buffer to
articles that are younger than AGE days."
(interactive "nTime in days: \nP")
gnus-killed-mark gnus-kill-file-mark
gnus-low-score-mark gnus-expirable-mark
gnus-canceled-mark gnus-catchup-mark gnus-sparse-mark
- gnus-duplicate-mark)
+ gnus-duplicate-mark gnus-souped-mark)
'reverse)))
(defalias 'gnus-summary-delete-marked-with 'gnus-summary-limit-exclude-marks)
Returns how many articles were removed."
(interactive "sMarks: ")
(gnus-summary-limit-to-marks marks t))
-
+
(defun gnus-summary-limit-to-marks (marks &optional reverse)
"Limit the summary buffer to articles that are marked with MARKS (e.g. \"DK\").
If REVERSE (the prefix), limit the summary buffer to articles that are
;; children.
(while (setq d (pop data))
(when (or (not (= (gnus-data-mark d) gnus-dormant-mark))
- (and (setq children
+ (and (setq children
(gnus-article-children (gnus-data-number d)))
(let (found)
(while children
(gnus-nocem-unwanted-article-p
(mail-header-id (car thread))))
(progn
- (setq gnus-newsgroup-reads
+ (setq gnus-newsgroup-reads
(delq number gnus-newsgroup-unreads))
t))))
;; Nope, invisible article.
(gnus-summary-position-point)
n)))
-(defun gnus-summary-refer-article (message-id)
- "Fetch an article specified by MESSAGE-ID."
- (interactive "sMessage-ID: ")
+(defun gnus-summary-refer-article (message-id &optional arg)
+ "Fetch an article specified by MESSAGE-ID.
+If ARG (the prefix), fetch the article using `gnus-refer-article-method'
+or `gnus-select-method', no matter what backend the article comes from."
+ (interactive "sMessage-ID: \nP")
(when (and (stringp message-id)
(not (zerop (length message-id))))
;; Construct the correct Message-ID if necessary.
(setq message-id (concat message-id ">")))
(let* ((header (gnus-id-to-header message-id))
(sparse (and header
- (gnus-summary-article-sparse-p
+ (gnus-summary-article-sparse-p
(mail-header-number header)))))
(if header
(prog1
;; The article is present in the buffer, to we just go to it.
- (gnus-summary-goto-article
+ (gnus-summary-goto-article
(mail-header-number header) nil header)
(when sparse
(gnus-summary-update-article (mail-header-number header))))
;; We fetch the article
- (let ((gnus-override-method
- (and (gnus-news-group-p gnus-newsgroup-name)
- gnus-refer-article-method))
+ (let ((gnus-override-method
+ (cond ((gnus-news-group-p gnus-newsgroup-name)
+ gnus-refer-article-method)
+ (arg
+ (or gnus-refer-article-method gnus-select-method))
+ (t nil)))
number)
;; Start the special refer-article method, if necessary.
(when (and gnus-refer-article-method
gnus-current-article)))
(ogroup gnus-newsgroup-name)
(params (append (gnus-info-params (gnus-get-info ogroup))
- (list (cons 'to-group ogroup))))
+ (list (cons 'to-group ogroup))
+ (list (cons 'save-article-group ogroup))))
(case-fold-search t)
(buf (current-buffer))
dig)
(unwind-protect
(if (gnus-group-read-ephemeral-group
name `(nndoc ,name (nndoc-address ,(get-buffer dig))
- (nndoc-article-type
+ (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))
(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."
(gnus-article-display-hook nil)
(gnus-mark-article-hook nil) ;Inhibit marking as read.
(gnus-use-article-prefetch nil)
+ (gnus-xmas-force-redisplay nil) ;Inhibit XEmacs redisplay.
(sum (current-buffer))
(found nil)
point)
(gnus-eval-in-buffer-window gnus-article-buffer
(widen)
(goto-char (point-min))
- (when gnus-break-pages
+ (when gnus-page-broken
(gnus-narrow-to-page))))
(defun gnus-summary-end-of-article ()
(widen)
(goto-char (point-max))
(recenter -3)
- (when gnus-break-pages
+ (when gnus-page-broken
(gnus-narrow-to-page))))
(defun gnus-summary-print-article (&optional filename)
(copy-to-buffer buffer (point-min) (point-max))
(set-buffer buffer)
(gnus-article-delete-invisible-text)
+ (run-hooks 'gnus-ps-print-hook)
(ps-print-buffer-with-faces filename))
(kill-buffer buffer)))))
gnus-article-display-hook
gnus-article-prepare-hook
gnus-break-pages
+ gnus-show-mime
gnus-visual)
(gnus-summary-select-article nil 'force)))
(gnus-summary-goto-subject gnus-current-article)
- ; (gnus-configure-windows 'article)
(gnus-summary-position-point))
(defun gnus-summary-verbose-headers (&optional arg)
(defun gnus-summary-caesar-message (&optional arg)
"Caesar rotate the current article by 13.
-The numerical prefix specifies how manu places to rotate each letter
+The numerical prefix specifies how many places to rotate each letter
forward."
(interactive "P")
(gnus-set-global-variables)
(gnus-remove-text-with-property 'gnus-prev)
(gnus-remove-text-with-property 'gnus-next)))))
-(defun gnus-summary-move-article (&optional n to-newsgroup
+(defun gnus-summary-move-article (&optional n to-newsgroup
select-method action)
"Move the current article to a different newsgroup.
If N is a positive number, move the N next articles.
(symbol-value (intern (format "gnus-current-%s-group" action)))
articles prefix))
(set (intern (format "gnus-current-%s-group" action)) to-newsgroup))
- (setq to-method (or select-method
+ (setq to-method (or select-method
(gnus-group-name-to-method to-newsgroup)))
;; Check the method we are to move this article to...
- (unless (gnus-check-backend-function
+ (unless (gnus-check-backend-function
'request-accept-article (car to-method))
(error "%s does not support article copying" (car to-method)))
(unless (gnus-check-server to-method)
" ")))
(setq new-xref (concat (gnus-group-real-name gnus-newsgroup-name)
":" article))
- (unless xref
+ (unless xref
(setq xref (list (system-name))))
(setq new-xref
(concat
- (mapconcat 'identity
+ (mapconcat 'identity
(delete "Xref:" (delete new-xref xref))
" ")
- new-xref))
+ " " new-xref))
(save-excursion
(set-buffer copy-buf)
+ ;; First put the article in the destination group.
(gnus-request-article-this-buffer article gnus-newsgroup-name)
- (nnheader-replace-header "xref" new-xref)
- (gnus-request-accept-article
- to-newsgroup select-method (not articles)))))))
- (if (not art-group)
- (gnus-message 1 "Couldn't %s article %s"
- (cadr (assq action names)) article)
+ (when (consp (setq art-group
+ (gnus-request-accept-article
+ to-newsgroup select-method (not articles))))
+ (setq new-xref (concat new-xref " " (car art-group)
+ ":" (cdr art-group)))
+ ;; Now we have the new Xrefs header, so we insert
+ ;; it and replace the new article.
+ (nnheader-replace-header "Xref" new-xref)
+ (gnus-request-replace-article
+ (cdr art-group) to-newsgroup (current-buffer))
+ art-group))))))
+ (cond
+ ((not art-group)
+ (gnus-message 1 "Couldn't %s article %s"
+ (cadr (assq action names)) article))
+ ((and (eq art-group 'junk)
+ (eq action 'move))
+ (gnus-summary-mark-article article gnus-canceled-mark)
+ (gnus-message 4 "Deleted article %s" article))
+ (t
(let* ((entry
(or
(gnus-gethash (car art-group) gnus-newsrc-hashtb)
(gnus-gethash
(gnus-group-prefixed-name
(car art-group)
- (or select-method
+ (or select-method
(gnus-find-method-for-group to-newsgroup)))
gnus-newsrc-hashtb)))
(info (nth 2 entry))
(memq article gnus-newsgroup-dormant)
(memq article gnus-newsgroup-unreads)))
+ (when (and (equal to-group gnus-newsgroup-name)
+ (not (memq article gnus-newsgroup-unreads)))
+ ;; Mark this article as read in this group.
+ (push (cons to-article gnus-read-mark) gnus-newsgroup-reads)
+ (setcdr (gnus-active to-group) to-article)
+ (setcdr gnus-newsgroup-active to-article))
+
(while marks
(when (memq article (symbol-value
(intern (format "gnus-newsgroup-%s"
(symbol-value
(intern (format "gnus-newsgroup-%s"
(caar marks)))))))
- ;; Copy mark to other group.
+ ;; Copy the marks to other group.
(gnus-add-marked-articles
to-group (cdar marks) (list to-article) info))
- (setq marks (cdr marks)))))
+ (setq marks (cdr marks)))
+
+ (gnus-dribble-enter
+ (concat "(gnus-group-set-info '"
+ (gnus-prin1-to-string (gnus-get-info to-group))
+ ")"))))
;; Update the Xref header in this article to point to
;; the new crossposted article we have just created.
(save-excursion
(set-buffer copy-buf)
(gnus-request-article-this-buffer article gnus-newsgroup-name)
- (nnheader-replace-header
- "xref" (concat new-xref " " (car art-group)
- ":" (cdr art-group)))
+ (nnheader-replace-header "Xref" new-xref)
(gnus-request-replace-article
article gnus-newsgroup-name (current-buffer)))))
(gnus-summary-goto-subject article)
(when (eq action 'move)
- (gnus-summary-mark-article article gnus-canceled-mark)))
+ (gnus-summary-mark-article article gnus-canceled-mark))))
(gnus-summary-remove-process-mark article))
;; Re-activate all groups that have been moved to.
(while to-groups
- (gnus-activate-group (pop to-groups)))
-
+ (save-excursion
+ (set-buffer gnus-group-buffer)
+ (when (gnus-group-goto-group (car to-groups) t)
+ (gnus-group-get-new-news-this-group 1))
+ (pop to-groups)))
+
(gnus-kill-buffer copy-buf)
(gnus-summary-position-point)
(gnus-set-mode-line 'summary)))
If SELECT-METHOD is non-nil, do not move to a specific newsgroup, but
re-spool using this method."
(interactive "P")
- (gnus-summary-move-article n nil select-method 'copy))
+ (gnus-summary-move-article n to-newsgroup select-method 'copy))
(defun gnus-summary-crosspost-article (&optional n)
"Crosspost the current article to some other group."
(gnus-summary-move-article n nil nil 'crosspost))
(defcustom gnus-summary-respool-default-method nil
- "Default method for respooling an article.
+ "Default method for respooling an article.
If nil, use to the current newsgroup method."
:type 'gnus-select-method-name
:group 'gnus-summary-mail)
In the former case, the articles in question will be moved from the
current group into whatever groups they are destined to. In the
latter case, they will be copied into the relevant groups."
- (interactive
+ (interactive
(list current-prefix-arg
(let* ((methods (gnus-methods-using 'respool))
(methname
(car (gnus-find-method-for-group
gnus-newsgroup-name)))))
(method
- (gnus-completing-read
+ (gnus-completing-read
methname "What backend do you want to use when respooling?"
methods nil t nil 'gnus-mail-method-history))
ms)
(cond
- ((zerop (length (setq ms (gnus-servers-using-backend
+ ((zerop (length (setq ms (gnus-servers-using-backend
(intern method)))))
(list (intern method) ""))
((= 1 (length ms))
;; after all.
(unless (memq (car articles) not-deleted)
(gnus-summary-mark-article (car articles) gnus-canceled-mark))
- (setq articles (cdr articles))))
+ (setq articles (cdr articles)))
+ (when not-deleted
+ (gnus-message 4 "Couldn't delete articles %s" not-deleted)))
(gnus-summary-position-point)
(gnus-set-mode-line 'summary)
not-deleted))
"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)
(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))))
+ (let ((head (buffer-string))
+ header)
+ (nnheader-temp-write nil
+ (insert (format "211 %d Article retrieved.\n"
+ (cdr gnus-article-current)))
+ (insert head)
+ (insert ".\n")
+ (let ((nntp-server-buffer (current-buffer)))
+ (setq header (car (gnus-get-newsgroup-headers
+ (save-excursion
+ (set-buffer gnus-summary-buffer)
+ gnus-newsgroup-dependencies)
+ t))))
+ (save-excursion
+ (set-buffer gnus-summary-buffer)
+ (gnus-data-set-header
+ (gnus-data-find (cdr gnus-article-current))
+ header)
+ (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))
+ (run-hooks 'gnus-article-display-hook)
+ (set-buffer gnus-original-article-buffer)
+ (gnus-request-article
+ (cdr gnus-article-current) (car gnus-article-current) (current-buffer)))
;; 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."
- (interactive
+ (interactive
(list
(progn
(message "%s" (concat (this-command-keys) "- "))
;;; Respooling
-(defun gnus-summary-respool-query ()
+(defun gnus-summary-respool-query (&optional silent)
"Query where the respool algorithm would put this article."
(interactive)
(gnus-set-global-variables)
- (gnus-summary-select-article)
- (save-excursion
- (set-buffer gnus-article-buffer)
- (save-restriction
- (goto-char (point-min))
- (search-forward "\n\n")
- (narrow-to-region (point-min) (point))
- (message "This message would go to %s"
- (mapconcat 'car (nnmail-article-group 'identity) ", ")))))
+ (let (gnus-mark-article-hook)
+ (gnus-summary-select-article)
+ (save-excursion
+ (set-buffer gnus-original-article-buffer)
+ (save-restriction
+ (message-narrow-to-head)
+ (let ((groups (nnmail-article-group 'identity)))
+ (unless silent
+ (if groups
+ (message "This message would go to %s"
+ (mapconcat 'car groups ", "))
+ (message "This message would go to no groups"))
+ groups))))))
;; Summary marking commands.
(save-excursion
(set-buffer gnus-summary-buffer)
(goto-char (point-min))
- (while
+ (while
(progn
(and (< (gnus-summary-article-score) score)
(gnus-summary-mark-article nil mark))
(defun gnus-summary-catchup (&optional all quietly to-here not-mark)
"Mark all unread articles in this newsgroup as read.
-If prefix argument ALL is non-nil, ticked and dormant articles will
+If prefix argument ALL is non-nil, ticked and dormant articles will
also be marked as read.
If QUIETLY is non-nil, no questions will be asked.
If TO-HERE is non-nil, it should be a point in the buffer. All
(gnus-summary-goto-subject article)))
(defun gnus-summary-reparent-thread ()
- "Make current article child of the marked (or previous) article.
+ "Make the current article child of the marked (or previous) article.
Note that the re-threading will only work if `gnus-thread-ignore-subject'
is non-nil or the Subject: of both articles are the same."
(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
(error "Beginning of summary buffer."))))))
(unless (not (eq current-article parent-article))
(error "An article may not be self-referential."))
- (let ((message-id (mail-header-id
+ (let ((message-id (mail-header-id
(gnus-summary-article-header parent-article))))
(unless (and message-id (not (equal message-id "")))
(error "No message-id in desired parent."))
(gnus-summary-select-article t t nil current-article)
- (set-buffer gnus-article-buffer)
- (setq buffer-read-only nil)
+ (set-buffer gnus-original-article-buffer)
(let ((buf (format "%s" (buffer-string))))
- (erase-buffer)
- (insert buf))
- (goto-char (point-min))
- (if (search-forward-regexp "^References: " nil t)
- (insert message-id " " )
- (insert "References: " message-id "\n"))
- (unless (gnus-request-replace-article current-article
- (car gnus-article-current)
- gnus-article-buffer)
- (error "Couldn't replace article."))
+ (nnheader-temp-write nil
+ (insert buf)
+ (goto-char (point-min))
+ (if (search-forward-regexp "^References: " nil t)
+ (insert message-id " " )
+ (insert "References: " message-id "\n"))
+ (unless (gnus-request-replace-article
+ current-article (car gnus-article-current)
+ (current-buffer))
+ (error "Couldn't replace article."))))
(set-buffer gnus-summary-buffer)
(gnus-summary-unmark-all-processable)
(gnus-summary-rethread-current)
(while (and (> n 0)
(gnus-summary-go-to-next-thread backward))
(decf n))
- (unless silent
+ (unless silent
(gnus-summary-position-point))
(when (and (not silent) (/= 0 n))
(gnus-message 7 "No more threads"))
(interactive "P")
(gnus-set-global-variables)
(let* ((articles (gnus-summary-work-articles n))
- (save-buffer (save-excursion
+ (save-buffer (save-excursion
(nnheader-set-temp-buffer " *Gnus Save*")))
(num (length articles))
header article file)
(let ((gnus-default-article-saver 'gnus-summary-save-body-in-file))
(gnus-summary-save-article arg)))
+(defun gnus-summary-pipe-message (program)
+ "Pipe the current article through PROGRAM."
+ (interactive "sProgram: ")
+ (gnus-set-global-variables)
+ (gnus-summary-select-article)
+ (let ((mail-header-separator "")
+ (art-buf (get-buffer gnus-article-buffer)))
+ (gnus-eval-in-buffer-window gnus-article-buffer
+ (save-restriction
+ (widen)
+ (let ((start (window-start))
+ buffer-read-only)
+ (message-pipe-buffer-body program)
+ (set-window-start (get-buffer-window (current-buffer)) start))))))
+
(defun gnus-get-split-value (methods)
"Return a value based on the split METHODS."
(let (split-name method result match)
nil nil
'gnus-group-history))
(t
- (gnus-completing-read nil prom
+ (gnus-completing-read nil prom
(mapcar (lambda (el) (list el))
(nreverse split-name))
nil nil nil
(when to-newsgroup
(if (or (string= to-newsgroup "")
(string= to-newsgroup prefix))
- (setq to-newsgroup (or default "")))
+ (setq to-newsgroup default))
+ (unless to-newsgroup
+ (error "No group name entered"))
(or (gnus-active to-newsgroup)
(gnus-activate-group to-newsgroup)
(if (gnus-y-or-n-p (format "No such group: %s. Create it? "
to-newsgroup))
- (or (and (gnus-request-create-group
+ (or (and (gnus-request-create-group
to-newsgroup (gnus-group-name-to-method to-newsgroup))
(gnus-activate-group to-newsgroup nil nil
(gnus-group-name-to-method
(funcall (if (string-match "%s" action)
'format 'concat)
action
- (mapconcat (lambda (f) f) files " ")))))
+ (mapconcat
+ (lambda (f)
+ (if (equal f " ")
+ f
+ (gnus-quote-arg-for-sh-or-csh f)))
+ files " ")))))
(setq ps (cdr ps)))))
(if (and gnus-view-pseudos (not not-view))
(while pslist
(gnus-article-setup-buffer)
(set-buffer gnus-article-buffer)
(setq buffer-read-only nil)
- (let ((command (if automatic command (read-string "Command: " command)))
- ;; Just binding this here doesn't help, because there might
- ;; be output from the process after exiting the scope of
- ;; this `let'.
- ;; (buffer-read-only nil)
- )
+ (let ((command (if automatic command (read-string "Command: " command))))
(erase-buffer)
(insert "$ " command "\n\n")
(if gnus-view-pseudo-asynchronously
- (start-process "gnus-execute" nil shell-file-name
+ (start-process "gnus-execute" (current-buffer) shell-file-name
shell-command-switch command)
(call-process shell-file-name nil t nil
shell-command-switch command)))))
(defun gnus-read-header (id &optional header)
"Read the headers of article ID and enter them into the Gnus system."
(let ((group gnus-newsgroup-name)
- (gnus-override-method
+ (gnus-override-method
(and (gnus-news-group-p gnus-newsgroup-name)
gnus-refer-article-method))
where)
(t gnus-reffed-article-number))
(current-buffer))
(insert " Article retrieved.\n"))
- (if (not (setq header (car (gnus-get-newsgroup-headers nil t))))
+ (if (or (not where)
+ (not (setq header (car (gnus-get-newsgroup-headers nil t)))))
() ; Malformed head.
(unless (gnus-summary-article-sparse-p (mail-header-number header))
(when (and (stringp id)
;; Fix by Mike Dugan <dugan@bucrf16.bu.edu>.
(from (if (get-text-property beg gnus-mouse-face-prop)
beg
- (or (next-single-property-change
+ (or (next-single-property-change
beg gnus-mouse-face-prop nil end)
beg)))
(to
(setq list (cdr list))))
(let ((face (cdar list)))
(unless (eq face (get-text-property beg 'face))
- (gnus-put-text-property
- beg end '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))))
(gnus-get-unread-articles-in-group info (gnus-active group))
t)))
+(defun gnus-offer-save-summaries ()
+ "Offer to save all active summary buffers."
+ (save-excursion
+ (let ((buflist (buffer-list))
+ buffers bufname)
+ ;; Go through all buffers and find all summaries.
+ (while buflist
+ (and (setq bufname (buffer-name (car buflist)))
+ (string-match "Summary" bufname)
+ (save-excursion
+ (set-buffer bufname)
+ ;; We check that this is, indeed, a summary buffer.
+ (and (eq major-mode 'gnus-summary-mode)
+ ;; Also make sure this isn't bogus.
+ gnus-newsgroup-prepared
+ ;; Also make sure that this isn't a dead summary buffer.
+ (not gnus-dead-summary-mode)))
+ (push bufname buffers))
+ (setq buflist (cdr buflist)))
+ ;; Go through all these summary buffers and offer to save them.
+ (when buffers
+ (map-y-or-n-p
+ "Update summary buffer %s? "
+ (lambda (buf) (switch-to-buffer buf) (gnus-summary-exit))
+ buffers)))))
+
+(gnus-ems-redefine)
+
(provide 'gnus-sum)
(run-hooks 'gnus-sum-load-hook)
projects / gnus / blobdiff