(require 'mail-utils)
(require 'timezone)
(require 'nnheader)
-(require 'message)
+(require 'nnmail)
+(require 'nnoo)
(eval-when-compile (require 'cl))
+(defvar gnus-directory (or (getenv "SAVEDIR") "~/News/")
+ "*Directory variable from which all other Gnus file variables are derived.")
+
;; Site dependent variables. These variables should be defined in
;; paths.el.
see the manual for details.")
(defvar gnus-message-archive-method
- '(nnfolder "archive" (nnfolder-directory "~/Mail/archive/")
- (nnfolder-active-file "~/Mail/archive/active")
- (nnfolder-get-new-mail nil)
- (nnfolder-inhibit-expiry t))
+ `(nnfolder
+ "archive"
+ (nnfolder-directory ,(nnheader-concat message-directory "archive"))
+ (nnfolder-active-file
+ ,(nnheader-concat message-directory "archive/active"))
+ (nnfolder-get-new-mail nil)
+ (nnfolder-inhibit-expiry t))
"*Method used for archiving messages you've sent.
-This should be a mail method.")
+This should be a mail method.
+
+It's probably not a very effective to change this variable once you've
+run Gnus once. After doing that, you must edit this server from the
+server buffer.")
+
+(defvar gnus-message-archive-group nil
+ "*Name of the group in which to save the messages you've written.
+This can either be a string, a list of strings; or an alist
+of regexps/functions/forms to be evaluated to return a string (or a list
+of strings). The functions are called with the name of the current
+group (or nil) as a parameter.
+
+If you want to save your mail in one group and the news articles you
+write in another group, you could say something like:
+
+ \(setq gnus-message-archive-group
+ '((if (message-news-p)
+ \"misc-news\"
+ \"misc-mail\")))
+
+Normally the group names returned by this variable should be
+unprefixed -- which implictly means \"store on the archive server\".
+However, you may wish to store the message on some other server. In
+that case, just return a fully prefixed name of the group --
+\"nnml+private:mail.misc\", for instance.")
(defvar gnus-refer-article-method nil
"*Preferred method for fetching an article by Message-ID.
(defvar gnus-group-faq-directory
'("/ftp@mirrors.aol.com:/pub/rtfm/usenet/"
"/ftp@sunsite.auc.dk:/pub/usenet/"
+ "/ftp@sunsite.doc.ic.ac.uk:/pub/usenet/news-faqs/"
"/ftp@src.doc.ic.ac.uk:/usenet/news-FAQS/"
"/ftp@ftp.seas.gwu.edu:/pub/rtfm/"
"/ftp@rtfm.mit.edu:/pub/usenet/"
fetched by ange-ftp.
This variable can also be a list of directories. In that case, the
-first element in the list will be used by default, and the others will
-be used as backup sites.
+first element in the list will be used by default. The others can
+be used when being prompted for a site.
Note that Gnus uses an aol machine as the default directory. If this
feels fundamentally unclean, just think of it as a way to finally get
`not-score', long file names will not be used for score files; if it
contains the element `not-save', long file names will not be used for
saving; and if it contains the element `not-kill', long file names
-will not be used for kill files.")
+will not be used for kill files.
-(defvar gnus-article-save-directory (or (getenv "SAVEDIR") "~/News/")
- "*Name of the directory articles will be saved in (default \"~/News\").
-Initialized from the SAVEDIR environment variable.")
+Note that the default for this variable varies according to what system
+type you're using. On `usg-unix-v' and `xenix' this variable defaults
+to nil while on all other systems it defaults to t.")
-(defvar gnus-kill-files-directory (or (getenv "SAVEDIR") "~/News/")
- "*Name of the directory where kill files will be stored (default \"~/News\").
-Initialized from the SAVEDIR environment variable.")
+(defvar gnus-article-save-directory gnus-directory
+ "*Name of the directory articles will be saved in (default \"~/News\").")
+
+(defvar gnus-kill-files-directory gnus-directory
+ "*Name of the directory where kill files will be stored (default \"~/News\").")
(defvar gnus-default-article-saver 'gnus-summary-save-in-rmail
"*A function to save articles in your favorite format.
(defvar gnus-use-adaptive-scoring nil
"*If non-nil, use some adaptive scoring scheme.")
-(defvar gnus-use-cache nil
+(defvar gnus-use-cache 'passive
"*If nil, Gnus will ignore the article cache.
If `passive', it will allow entering (and reading) articles
explicitly entered into the cache. If anything else, use the
comparing subjects.")
(defvar gnus-simplify-ignored-prefixes nil
- "*Regexp, matches for which are removed from subject lines when simplifying.")
+ "*Regexp, matches for which are removed from subject lines when simplifying fuzzily.")
(defvar gnus-build-sparse-threads nil
"*If non-nil, fill in the gaps in threads.
"*If non-nil, the \\<gnus-group-mode-map>\\[gnus-group-get-new-news-this-group] command will advance point to the next group.")
(defvar gnus-check-new-newsgroups t
- "*Non-nil means that Gnus will add new newsgroups at startup.
-If this variable is `ask-server', Gnus will ask the server for new
-groups since the last time it checked. This means that the killed list
-is no longer necessary, so you could set `gnus-save-killed-list' to
-nil.
-
-A variant is to have this variable be a list of select methods. Gnus
-will then use the `ask-server' method on all these select methods to
-query for new groups from all those servers.
+ "*Non-nil means that Gnus will run gnus-find-new-newsgroups at startup.
+This normally finds new newsgroups by comparing the active groups the
+servers have already reported with those Gnus already knows, either alive
+or killed.
+
+When any of the following are true, gnus-find-new-newsgroups will instead
+ask the servers (primary, secondary, and archive servers) to list new
+groups since the last time it checked:
+ 1. This variable is `ask-server'.
+ 2. This variable is a list of select methods (see below).
+ 3. `gnus-read-active-file' is nil or `some'.
+ 4. A prefix argument is given to gnus-find-new-newsgroups interactively.
+
+Thus, if this variable is `ask-server' or a list of select methods or
+`gnus-read-active-file' is nil or `some', then the killed list is no
+longer necessary, so you could safely set `gnus-save-killed-list' to nil.
+
+This variable can be a list of select methods which Gnus will query with
+the `ask-server' method in addition to the primary, secondary, and archive
+servers.
Eg.
(setq gnus-check-new-newsgroups
(defvar gnus-interactive-catchup t
"*If non-nil, require your confirmation when catching up a group.")
-(defvar gnus-interactive-post t
- "*If non-nil, group name will be asked for when posting.")
-
(defvar gnus-interactive-exit t
"*If non-nil, require your confirmation when exiting Gnus.")
'(vertical 1.0
(summary 0.25 point)
(if gnus-carpal '(summary-carpal 4))
- (if gnus-use-trees '(tree 0.25))
(article 1.0)))))
(server
(vertical 1.0
`gnus-subscribe-alphabetically' inserts new groups in strict
alphabetic order; `gnus-subscribe-hierarchically' inserts new groups
in hierarchical newsgroup order; `gnus-subscribe-interactively' asks
-for your decision; `gnus-subscribe-killed' kills all new groups.")
+for your decision; `gnus-subscribe-killed' kills all new groups;
+`gnus-subscribe-zombies' will make all new groups into zombies.")
;; Suggested by a bug report by Hallvard B Furuseth.
;; <h.b.furuseth@usit.uio.no>.
(defvar gnus-insert-pseudo-articles t
"*If non-nil, insert pseudo-articles when decoding articles.")
-(defvar gnus-group-line-format "%M%S%p%P%5y: %(%g%)%l\n"
+(defvar gnus-group-line-format "%M\%S\%p\%P\%5y: %(%g%)%l\n"
"*Format of group lines.
It works along the same lines as a normal formatting string,
with some simple extensions.
of these specs, you must probably re-start Gnus to see them go into
effect.")
-(defvar gnus-summary-line-format "%U%R%z%I%(%[%4L: %-20,20n%]%) %s\n"
+(defvar gnus-summary-line-format "%U\%R\%z\%I\%(%[%4L: %-20,20n%]%) %s\n"
"*The format specification of the lines in the summary buffer.
It works along the same lines as a normal formatting string,
"*The format specification for the article mode line.
See `gnus-summary-mode-line-format' for a closer description.")
-(defvar gnus-group-mode-line-format "Gnus: %%b {%M:%S}"
+(defvar gnus-group-mode-line-format "Gnus: %%b {%M\%:%S}"
"*The format specification for the group mode line.
It works along the same lines as a normal formatting string,
with some simple extensions:
%S The native news server.
-%M The native select method.")
+%M The native select method.
+%: \":\" if %S isn't \"\".")
(defvar gnus-valid-select-methods
'(("nntp" post address prompt-address)
("nneething" none address prompt-address)
("nndoc" none address prompt-address)
("nnbabyl" mail address respool)
- ("nnkiboze" post address virtual)
+ ("nnkiboze" post virtual)
("nnsoup" post-mail address)
("nndraft" post-mail)
("nnfolder" mail respool address))
"An alist of valid select methods.
The first element of each list lists should be a string with the name
-of the select method. The other elements may be be the category of
+of the select method. The other elements may be the category of
this method (ie. `post', `mail', `none' or whatever) or other
properties that this method has (like being respoolable).
If you implement a new select method, all you should have to change is
; "*Face used for mouse highlighting in Gnus.
;No mouse highlights will be done if `gnus-visual' is nil.")
-(defvar gnus-summary-mark-below nil
+(defvar gnus-summary-mark-below 0
"*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.")
"^nnml\\|^nnfolder\\|^nnmbox\\|^nnmh\\|^nnbabyl"
"*All new groups that match this regexp will be subscribed automatically.
Note that this variable only deals with new groups. It has no effect
-whatsoever on old groups.")
+whatsoever on old groups.
+
+New groups that match this regexp will not be handled by
+`gnus-subscribe-newsgroup-method'. Instead, they will
+be subscribed using `gnus-subscribe-options-newsgroup-method'.")
(defvar gnus-options-subscribe nil
"*All new groups matching this regexp will be subscribed unconditionally.
Note that this variable deals only with new newsgroups. This variable
-does not affect old newsgroups.")
+does not affect old newsgroups.
+
+New groups that match this regexp will not be handled by
+`gnus-subscribe-newsgroup-method'. Instead, they will
+be subscribed using `gnus-subscribe-options-newsgroup-method'.")
(defvar gnus-options-not-subscribe nil
"*All new groups matching this regexp will be ignored.
(defvar gnus-summary-exit-hook nil
"*A hook called on exit from the summary buffer.")
+(defvar gnus-check-bogus-groups-hook nil
+ "A hook run after removing bogus groups.")
+
(defvar gnus-group-catchup-group-hook nil
"*A hook run when catching up a group from the group buffer.")
+(defvar gnus-group-update-group-hook nil
+ "*A hook called when updating group lines.")
+
(defvar gnus-open-server-hook nil
"*A hook called just before opening connection to the news server.")
;(add-hook 'gnus-article-display-hook 'gnus-article-treat-overstrike)
;(add-hook 'gnus-article-display-hook 'gnus-article-maybe-highlight)
-(defvar gnus-article-x-face-command
- "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | xv -quit -"
- "String or function to be executed to display an X-Face header.
-If it is a string, the command will be executed in a sub-shell
-asynchronously. The compressed face will be piped to this command.")
-
(defvar gnus-article-x-face-too-ugly nil
"Regexp matching posters whose face shouldn't be shown automatically.")
(defvar gnus-parse-headers-hook nil
"*A hook called before parsing the headers.")
-(add-hook 'gnus-parse-headers-hook 'gnus-headers-decode-quoted-printable)
+(add-hook 'gnus-parse-headers-hook 'gnus-decode-rfc1522)
(defvar gnus-exit-group-hook nil
"*A hook called when exiting (not quitting) summary mode.")
(?A gnus-tmp-article-number ?d)
(?Z gnus-tmp-unread-and-unselected ?s)
(?V gnus-version ?s)
- (?U gnus-tmp-unread ?d)
+ (?U gnus-tmp-unread-and-unticked ?d)
(?S gnus-tmp-subject ?s)
(?e gnus-tmp-unselected ?d)
(?u gnus-tmp-user-defined ?s)
(defvar gnus-group-mode-line-format-alist
`((?S gnus-tmp-news-server ?s)
(?M gnus-tmp-news-method ?s)
- (?u gnus-tmp-user-defined ?s)))
+ (?u gnus-tmp-user-defined ?s)
+ (?: gnus-tmp-colon ?s)))
(defvar gnus-have-read-active-file nil)
"gnus-bug@ifi.uio.no (The Gnus Bugfixing Girls + Boys)"
"The mail address of the Gnus maintainers.")
-(defconst gnus-version "September Gnus v0.84"
+(defconst gnus-version-number "5.2.35"
"Version number for this version of Gnus.")
+(defconst gnus-version (format "Gnus v%s" gnus-version-number)
+ "Version string for this version of Gnus.")
+
(defvar gnus-info-nodes
'((gnus-group-mode "(gnus)The Group Buffer")
(gnus-summary-mode "(gnus)The Summary Buffer")
- (gnus-article-mode "(gnus)The Article Buffer"))
- "Assoc list of major modes and related Info nodes.")
+ (gnus-article-mode "(gnus)The Article Buffer")
+ (gnus-server-mode "(gnus)The Server Buffer")
+ (gnus-browse-mode "(gnus)Browse Foreign Server")
+ (gnus-tree-mode "(gnus)Tree Display")
+ )
+ "Alist of major modes and related Info nodes.")
(defvar gnus-group-buffer "*Group*")
(defvar gnus-summary-buffer "*Summary*")
gnus-newsgroup-scored gnus-newsgroup-kill-headers
gnus-newsgroup-async gnus-thread-expunge-below
gnus-score-alist gnus-current-score-file gnus-summary-expunge-below
- gnus-summary-mark-below gnus-newsgroup-active gnus-scores-exclude-files
+ (gnus-summary-mark-below . global)
+ gnus-newsgroup-active gnus-scores-exclude-files
gnus-newsgroup-history gnus-newsgroup-ancient
gnus-newsgroup-sparse
(gnus-newsgroup-adaptive . gnus-use-adaptive-scoring)
- gnus-newsgroup-adaptive-score-file
+ gnus-newsgroup-adaptive-score-file (gnus-reffed-article-number . -1)
(gnus-newsgroup-expunged-tally . 0)
gnus-cache-removable-articles gnus-newsgroup-cached
gnus-newsgroup-data gnus-newsgroup-data-reverse
("nnvirtual" nnvirtual-catchup-group)
("timezone" timezone-make-date-arpa-standard timezone-fix-time
timezone-make-sortable-date timezone-make-time-string)
- ("sendmail" mail-position-on-field mail-setup)
("rmailout" rmail-output)
- ("rnewspost" news-mail-other-window news-reply-yank-original
- news-caesar-buffer-body)
("rmail" rmail-insert-rmail-file-header rmail-count-new-messages
rmail-show-message)
("gnus-soup" :interactive t
gnus-group-brew-soup gnus-brew-soup gnus-soup-add-article
gnus-soup-send-replies gnus-soup-save-areas gnus-soup-pack-packet)
("nnsoup" nnsoup-pack-replies)
- ("gnus-scomo" :interactive t gnus-score-mode)
+ ("score-mode" :interactive t gnus-score-mode)
("gnus-mh" gnus-mh-mail-setup gnus-summary-save-article-folder
gnus-Folder-save-name gnus-folder-save-name)
("gnus-mh" :interactive t gnus-summary-save-in-folder)
gnus-score-raise-same-subject gnus-score-default
gnus-score-raise-thread gnus-score-lower-same-subject-and-select
gnus-score-lower-same-subject gnus-score-lower-thread
- gnus-possibly-score-headers)
+ gnus-possibly-score-headers gnus-summary-raise-score
+ gnus-summary-set-score gnus-summary-current-score)
("gnus-score"
(gnus-summary-score-map keymap) gnus-score-save gnus-score-headers
gnus-current-score-file-nondirectory gnus-score-adaptive
gnus-uu-decode-binhex-view)
("gnus-msg" (gnus-summary-send-map keymap)
gnus-mail-yank-original gnus-mail-send-and-exit
- gnus-sendmail-setup-mail gnus-article-mail
- gnus-inews-message-id gnus-new-mail gnus-mail-reply)
+ gnus-article-mail gnus-new-mail gnus-mail-reply
+ gnus-copy-article-buffer)
("gnus-msg" :interactive t
gnus-group-post-news gnus-group-mail gnus-summary-post-news
gnus-summary-followup gnus-summary-followup-with-original
- gnus-summary-followup-and-reply
- gnus-summary-followup-and-reply-with-original
gnus-summary-cancel-article gnus-summary-supersede-article
- gnus-post-news gnus-inews-news gnus-cancel-news
+ gnus-post-news gnus-inews-news
gnus-summary-reply gnus-summary-reply-with-original
gnus-summary-mail-forward gnus-summary-mail-other-window
gnus-bug)
("gnus-picon" :interactive t gnus-article-display-picons
- gnus-group-display-picons gnus-picons-article-display-x-face)
+ gnus-group-display-picons gnus-picons-article-display-x-face
+ gnus-picons-display-x-face)
("gnus-gl" bbb-login bbb-logout bbb-grouplens-group-p
gnus-grouplens-mode)
+ ("smiley" :interactive t gnus-smiley-display)
("gnus-vm" gnus-vm-mail-setup)
("gnus-vm" :interactive t gnus-summary-save-in-vm
- gnus-summary-save-article-vm gnus-yank-article))))
+ gnus-summary-save-article-vm))))
\f
(defmacro gnus-eval-in-buffer-window (buffer &rest forms)
"Pop to BUFFER, evaluate FORMS, and then return to the original window."
- (let ((tempvar (make-symbol "GnusStartBufferWindow")))
- `(let ((,tempvar (selected-window)))
+ (let ((tempvar (make-symbol "GnusStartBufferWindow"))
+ (w (make-symbol "w"))
+ (buf (make-symbol "buf")))
+ `(let* ((,tempvar (selected-window))
+ (,buf ,buffer)
+ (,w (get-buffer-window ,buf 'visible)))
(unwind-protect
(progn
- (pop-to-buffer ,buffer)
+ (if ,w
+ (select-window ,w)
+ (pop-to-buffer ,buf))
,@forms)
(select-window ,tempvar)))))
+(put 'gnus-eval-in-buffer-window 'lisp-indent-function 1)
+(put 'gnus-eval-in-buffer-window 'lisp-indent-hook 1)
+(put 'gnus-eval-in-buffer-window 'edebug-form-spec '(form body))
+
(defmacro gnus-gethash (string hashtable)
"Get hash value of STRING in HASHTABLE."
`(symbol-value (intern-soft ,string ,hashtable)))
(and gnus-group-buffer
(get-buffer gnus-group-buffer)))
+(defun gnus-delete-first (elt list)
+ "Delete by side effect the first occurrence of ELT as a member of LIST."
+ (if (equal (car list) elt)
+ (cdr list)
+ (let ((total list))
+ (while (and (cdr list)
+ (not (equal (cadr list) elt)))
+ (setq list (cdr list)))
+ (when (cdr list)
+ (setcdr list (cddr list)))
+ total)))
+
;; Delete the current line (and the next N lines.);
(defmacro gnus-delete-line (&optional n)
`(delete-region (progn (beginning-of-line) (point))
flist)
(cons 'progn (cddr fval)))))
+;; Find out whether the gnus-visual TYPE is wanted.
+(defun gnus-visual-p (&optional type class)
+ (and gnus-visual ; Has to be non-nil, at least.
+ (if (not type) ; We don't care about type.
+ gnus-visual
+ (if (listp gnus-visual) ; It's a list, so we check it.
+ (or (memq type gnus-visual)
+ (memq class gnus-visual))
+ t))))
+
;;; Load the compatability functions.
(require 'gnus-cus)
(defun gnus-summary-line-format-spec ()
(insert gnus-tmp-unread gnus-tmp-replied
gnus-tmp-score-char gnus-tmp-indentation)
- (put-text-property
+ (gnus-put-text-property
(point)
(progn
(insert
(defun gnus-summary-dummy-line-format-spec ()
(insert "* ")
- (put-text-property
+ (gnus-put-text-property
(point)
(progn
(insert ": :")
gnus-tmp-process-marked
gnus-group-indentation
(format "%5s: " gnus-tmp-number-of-unread))
- (put-text-property
+ (gnus-put-text-property
(point)
(progn
(insert gnus-tmp-group "\n")
(let ((case-fold-search t)
(inhibit-point-motion-hooks t))
(nnheader-narrow-to-headers)
- (mail-fetch-field field)))))
+ (message-fetch-field field)))))
(defun gnus-goto-colon ()
(beginning-of-line)
(defvar gnus-mouse-face-4 'highlight)
(defun gnus-mouse-face-function (form type)
- `(put-text-property
+ `(gnus-put-text-property
(point) (progn ,@form (point))
gnus-mouse-face-prop
,(if (equal type 0)
(defvar gnus-face-4 'bold)
(defun gnus-face-face-function (form type)
- `(put-text-property
+ `(gnus-put-text-property
(point) (progn ,@form (point))
'face ',(symbol-value (intern (format "gnus-face-%d" type)))))
If PROPS, insert the result."
(let ((form (gnus-parse-format format alist props)))
(if props
- (add-text-properties (point) (progn (eval form) (point)) props)
+ (gnus-add-text-properties (point) (progn (eval form) (point)) props)
(eval form))))
(defun gnus-remove-text-with-property (prop)
(gnus-capitalize-newsgroup newsgroup)
(gnus-newsgroup-directory-form newsgroup))
"/" (int-to-string (mail-header-number headers)))
- (or gnus-article-save-directory "~/News"))))
+ gnus-article-save-directory)))
(if (and last-file
(string-equal (file-name-directory default)
(file-name-directory last-file))
newsgroup
(gnus-newsgroup-directory-form newsgroup))
"/" (int-to-string (mail-header-number headers)))
- (or gnus-article-save-directory "~/News"))))
+ gnus-article-save-directory)))
(if (and last-file
(string-equal (file-name-directory default)
(file-name-directory last-file))
(if (gnus-use-long-file-name 'not-save)
(gnus-capitalize-newsgroup newsgroup)
(concat (gnus-newsgroup-directory-form newsgroup) "/news"))
- (or gnus-article-save-directory "~/News"))))
+ gnus-article-save-directory)))
(defun gnus-plain-save-name (newsgroup headers &optional last-file)
"Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
(if (gnus-use-long-file-name 'not-save)
newsgroup
(concat (gnus-newsgroup-directory-form newsgroup) "/news"))
- (or gnus-article-save-directory "~/News"))))
+ gnus-article-save-directory)))
;; For subscribing new newsgroup
(setq prefixes (cons prefix prefixes))
(message "Descend hierarchy %s? ([y]nsq): "
(substring prefix 1 (1- (length prefix))))
- (setq ans (read-char))
+ (while (not (memq (setq ans (read-char)) '(?y ?\n ?n ?s ?q)))
+ (ding)
+ (message "Descend hierarchy %s? ([y]nsq): "
+ (substring prefix 1 (1- (length prefix)))))
(cond ((= ans ?n)
(while (and groups
(string-match prefix
(setq groups (cdr groups))))
(t nil)))
(message "Subscribe %s? ([n]yq)" (car groups))
- (setq ans (read-char))
+ (while (not (memq (setq ans (read-char)) '(?y ?\n ?q ?n)))
+ (ding)
+ (message "Subscribe %s? ([n]yq)" (car groups)))
(setq group (car groups))
(cond ((= ans ?y)
(gnus-subscribe-alphabetically (car groups))
(setq groupkey
(if (string-match "^\\(.*\\)\\.[^.]+$" groupkey)
(substring groupkey (match-beginning 1) (match-end 1)))))
- (gnus-subscribe-newsgroup newgroup before))))
+ (gnus-subscribe-newsgroup newgroup before))
+ (kill-buffer (current-buffer))))
(defun gnus-subscribe-interactively (group)
"Subscribe the new GROUP interactively.
;; all whitespace.
;; Written by Stainless Steel Rat <ratinox@ccs.neu.edu>.
(defun gnus-simplify-buffer-fuzzy ()
- (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
- (looking-at "^ *\\(re\\|fwd\\)[[{(^0-9]*[])}]?[:;] *")
- (looking-at "^[[].*: .*[]]$"))
+ (let ((case-fold-search t))
(goto-char (point-min))
- (while (re-search-forward "^ *\\(re\\|fwd\\)[[{(^0-9]*[])}]?[:;] *"
- nil t)
+ (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
+ (looking-at "^ *\\(re\\|fwd\\)[[{(^0-9]*[])}]?[:;] *")
+ (looking-at "^[[].*: .*[]]$"))
+ (goto-char (point-min))
+ (while (re-search-forward "^ *\\(re\\|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)
- (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))
- (goto-char (point-min))
- (when gnus-simplify-subject-fuzzy-regexp
- (if (listp gnus-simplify-subject-fuzzy-regexp)
- (let ((list gnus-simplify-subject-fuzzy-regexp))
- (while list
- (goto-char (point-min))
- (while (re-search-forward (car list) nil t)
- (replace-match "" t t))
- (setq list (cdr list))))
- (while (re-search-forward gnus-simplify-subject-fuzzy-regexp nil t)
- (replace-match "" t t)))))
+ (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))
+ (goto-char (point-min))
+ (when gnus-simplify-subject-fuzzy-regexp
+ (if (listp gnus-simplify-subject-fuzzy-regexp)
+ (let ((list gnus-simplify-subject-fuzzy-regexp))
+ (while list
+ (goto-char (point-min))
+ (while (re-search-forward (car list) nil t)
+ (replace-match "" t t))
+ (setq list (cdr list))))
+ (while (re-search-forward gnus-simplify-subject-fuzzy-regexp nil t)
+ (replace-match "" t t))))))
(defun gnus-simplify-subject-fuzzy (subject)
"Siplify a subject string fuzzily."
gnus-server-alist nil
gnus-group-list-mode nil
gnus-opened-servers nil
+ gnus-group-mark-positions nil
+ gnus-newsgroup-data nil
+ gnus-newsgroup-unreads nil
+ nnoo-state-alist nil
gnus-current-select-method nil)
(gnus-shutdown 'gnus)
;; Kill the startup file.
(while gnus-buffer-list
(gnus-kill-buffer (pop gnus-buffer-list)))
;; Remove Gnus frames.
+ (gnus-kill-gnus-frames))
+
+(defun gnus-kill-gnus-frames ()
+ "Kill all frames Gnus has created."
(while gnus-created-frames
(when (frame-live-p (car gnus-created-frames))
;; We slap a condition-case around this `delete-frame' to ensure
- ;; agains errors if we try do delete the single frame that's left.
+ ;; against errors if we try do delete the single frame that's left.
(condition-case ()
(delete-frame (car gnus-created-frames))
(error nil)))
(or (not (numberp (nth i elem)))
(zerop (nth i elem))
(progn
- (setq perc (/ (float (nth 0 elem)) total))
+ (setq perc (if (= i 2)
+ 1.0
+ (/ (float (nth 0 elem)) total)))
(setq out (cons (if (eq pbuf (nth i types))
- (vector (nth i types) perc 'point)
- (vector (nth i types) perc))
+ (list (nth i types) perc 'point)
+ (list (nth i types) perc))
out))))
(setq i (1+ i)))
- (list (nreverse out)))))
+ `(vertical 1.0 ,@(nreverse out)))))
;;;###autoload
(defun gnus-add-configuration (conf)
(delete-windows-on (car bufs)))
(setq bufs (cdr bufs))))))
-(defun gnus-version ()
- "Version numbers of this version of Gnus."
- (interactive)
+(defun gnus-version (&optional arg)
+ "Version number of this version of Gnus.
+If ARG, insert string at point."
+ (interactive "P")
(let ((methods gnus-valid-select-methods)
(mess gnus-version)
meth)
(stringp (symbol-value meth))
(setq mess (concat mess "; " (symbol-value meth))))
(setq methods (cdr methods)))
- (gnus-message 2 mess)))
+ (if arg
+ (insert (message mess))
+ (message mess))))
(defun gnus-info-find-node ()
"Find Info documentation of Gnus."
;; it yet. -erik selberg@cs.washington.edu
(defun gnus-dd-mmm (messy-date)
"Return a string like DD-MMM from a big messy string"
- (let ((datevec (timezone-parse-date messy-date)))
- (format "%2s-%s"
- (condition-case ()
- ;; Make sure leading zeroes are stripped.
- (number-to-string (string-to-number (aref datevec 2)))
- (error "??"))
- (capitalize
- (or (car
- (nth (1- (string-to-number (aref datevec 1)))
- timezone-months-assoc))
- "???")))))
+ (let ((datevec (condition-case () (timezone-parse-date messy-date)
+ (error nil))))
+ (if (not datevec)
+ "??-???"
+ (format "%2s-%s"
+ (condition-case ()
+ ;; Make sure leading zeroes are stripped.
+ (number-to-string (string-to-number (aref datevec 2)))
+ (error "??"))
+ (capitalize
+ (or (car
+ (nth (1- (string-to-number (aref datevec 1)))
+ timezone-months-assoc))
+ "???"))))))
+
+(defun gnus-mode-string-quote (string)
+ "Quote all \"%\" in STRING."
+ (save-excursion
+ (gnus-set-work-buffer)
+ (insert string)
+ (goto-char (point-min))
+ (while (search-forward "%" nil t)
+ (insert "%"))
+ (buffer-string)))
;; Make a hash table (default and minimum size is 255).
;; Optional argument HASHSIZE specifies the table size.
(apply 'format args)))
(defun gnus-error (level &rest args)
- "Beep an error if `gnus-verbose' is on LEVEL or less."
+ "Beep an error if LEVEL is equal to or less than `gnus-verbose'."
(when (<= (floor level) gnus-verbose)
(apply 'message args)
(ding)
name))
(defsubst gnus-hide-text (b e props)
- "Set text PROPS on the B to E region, extending `intangble' 1 past B."
- (add-text-properties b e props)
+ "Set text PROPS on the B to E region, extending `intangible' 1 past B."
+ (gnus-add-text-properties b e props)
(when (memq 'intangible props)
- (put-text-property (max (1- b) (point-min))
+ (gnus-put-text-property (max (1- b) (point-min))
b 'intangible (cddr (memq 'intangible props)))))
(defsubst gnus-unhide-text (b e)
"Remove hidden text properties from region between B and E."
(remove-text-properties b e gnus-hidden-properties)
(when (memq 'intangible gnus-hidden-properties)
- (put-text-property (max (1- b) (point-min))
- b 'intangible nil)))
+ (gnus-put-text-property (max (1- b) (point-min))
+ b 'intangible nil)))
(defun gnus-hide-text-type (b e type)
"Hide text of TYPE between B and E."
(gnus-hide-text b e (cons 'gnus-type (cons type gnus-hidden-properties))))
-;; Find out whether the gnus-visual TYPE is wanted.
-(defun gnus-visual-p (&optional type class)
- (and gnus-visual ; Has to be non-nil, at least.
- (if (not type) ; We don't care about type.
- gnus-visual
- (if (listp gnus-visual) ; It's a list, so we check it.
- (or (memq type gnus-visual)
- (memq class gnus-visual))
- t))))
+(defun gnus-parent-headers (headers &optional generation)
+ "Return the headers of the GENERATIONeth parent of HEADERS."
+ (unless generation
+ (setq generation 1))
+ (let (references parent)
+ (while (and headers (not (zerop generation)))
+ (setq references (mail-header-references headers))
+ (when (and references
+ (setq parent (gnus-parent-id references))
+ (setq headers (car (gnus-id-to-thread parent))))
+ (decf generation)))
+ headers))
(defun gnus-parent-id (references)
"Return the last Message-ID in REFERENCES."
"V" gnus-version
"s" gnus-group-save-newsrc
"z" gnus-group-suspend
- "Z" gnus-group-clear-dribble
+; "Z" gnus-group-clear-dribble
"q" gnus-group-exit
"Q" gnus-group-quit
"?" gnus-group-describe-briefly
(buffer-disable-undo (current-buffer))
(setq truncate-lines t)
(setq buffer-read-only t)
+ (gnus-make-local-hook 'post-command-hook)
+ (gnus-add-hook 'post-command-hook 'gnus-clear-inboxes-moved nil t)
(run-hooks 'gnus-group-mode-hook))
+(defun gnus-clear-inboxes-moved ()
+ (setq nnmail-moved-inboxes nil))
+
(defun gnus-mouse-pick-group (e)
"Enter the group under the mouse pointer."
(interactive "e")
prompt the user for the name of an NNTP server to use.
As opposed to `gnus', this command will not connect to the local server."
(interactive "P")
- (make-local-variable 'gnus-group-use-permanent-levels)
- (setq gnus-group-use-permanent-levels
- (or arg (1- gnus-level-default-subscribed)))
- (gnus gnus-group-use-permanent-levels t slave))
+ (let ((val (or arg (1- gnus-level-default-subscribed))))
+ (gnus val t slave)
+ (make-local-variable 'gnus-group-use-permanent-levels)
+ (setq gnus-group-use-permanent-levels val)))
;;;###autoload
(defun gnus-slave (&optional arg)
(gnus-make-newsrc-file gnus-startup-file))
;; Read the dribble file.
- (and (or gnus-slave gnus-use-dribble-file) (gnus-dribble-read-file))
+ (when (or gnus-slave gnus-use-dribble-file)
+ (gnus-dribble-read-file))
;; Allow using GroupLens predictions.
(when gnus-use-grouplens
(setcar (cddr entry) (gnus-byte-code 'gnus-tmp-func)))))
(push (cons 'version emacs-version) gnus-format-specs)
-
+ ;; Mark the .newsrc.eld file as "dirty".
+ (gnus-dribble-enter " ")
(gnus-message 7 "Compiling user specs...done"))))
(defun gnus-indent-rigidly (start end arg)
;; Fontify some.
(goto-char (point-min))
(and (search-forward "Praxis" nil t)
- (put-text-property (match-beginning 0) (match-end 0) 'face 'bold))
+ (gnus-put-text-property (match-beginning 0) (match-end 0) 'face 'bold))
(goto-char (point-min))
(let* ((mode-string (gnus-group-set-mode-line)))
(setq mode-line-buffer-identification
(while groups
(setq group (pop groups))
(when (string-match regexp group)
- (add-text-properties
+ (gnus-add-text-properties
(point) (prog1 (1+ (point))
(insert " " mark " *: " group "\n"))
(list 'gnus-group (gnus-intern-safe group gnus-active-hashtb)
'gnus-level level))))
;; This loop is used when listing all groups.
(while groups
- (add-text-properties
+ (gnus-add-text-properties
(point) (prog1 (1+ (point))
(insert " " mark " *: "
(setq group (pop groups)) "\n"))
(defun gnus-server-to-method (server)
"Map virtual server names to select methods."
(or
+ ;; Is this a method, perhaps?
+ (and server (listp server) server)
;; Perhaps this is the native server?
(and (equal server "native") gnus-select-method)
;; It should be in the server alist.
(pop opened))
out))
+(defun gnus-archive-server-wanted-p ()
+ "Say whether the user wants to use the archive server."
+ (cond
+ ((or (not gnus-message-archive-method)
+ (not gnus-message-archive-group))
+ nil)
+ ((and gnus-message-archive-method gnus-message-archive-group)
+ t)
+ (t
+ (let ((active (cadr (assq 'nnfolder-active-file
+ gnus-message-archive-method))))
+ (and active
+ (file-exists-p active))))))
+
(defun gnus-group-prefixed-name (group method)
"Return the whole name from GROUP and METHOD."
(and (stringp method) (setq method (gnus-server-to-method method)))
"Update the current line in the group buffer."
(let* ((buffer-read-only nil)
(group (gnus-group-group-name))
- (gnus-group-indentation (gnus-group-group-indentation))
- (entry (and group (gnus-gethash group gnus-newsrc-hashtb))))
- (and entry
- (not (gnus-ephemeral-group-p group))
- (gnus-dribble-enter
- (concat "(gnus-group-set-info '"
- (prin1-to-string (nth 2 entry)) ")")))
- (gnus-delete-line)
- (gnus-group-insert-group-line-info group)
- (forward-line -1)
- (gnus-group-position-point)))
+ (entry (and group (gnus-gethash group gnus-newsrc-hashtb)))
+ gnus-group-indentation)
+ (when group
+ (and entry
+ (not (gnus-ephemeral-group-p group))
+ (gnus-dribble-enter
+ (concat "(gnus-group-set-info '"
+ (prin1-to-string (nth 2 entry)) ")")))
+ (setq gnus-group-indentation (gnus-group-group-indentation))
+ (gnus-delete-line)
+ (gnus-group-insert-group-line-info group)
+ (forward-line -1)
+ (gnus-group-position-point))))
(defun gnus-group-insert-group-line-info (group)
"Insert GROUP on the current line."
(let ((entry (gnus-gethash group gnus-newsrc-hashtb))
active info)
- (setq gnus-group-indentation (gnus-group-group-indentation))
(if entry
(progn
;; (Un)subscribed group.
(buffer-read-only nil)
header gnus-tmp-header) ; passed as parameter to user-funcs.
(beginning-of-line)
- (add-text-properties
+ (gnus-add-text-properties
(point)
(prog1 (1+ (point))
;; Insert the text.
(goto-char loc)
(let ((gnus-group-indentation (gnus-group-group-indentation)))
(gnus-delete-line)
- (gnus-group-insert-group-line-info group))
+ (gnus-group-insert-group-line-info group)
+ (save-excursion
+ (forward-line -1)
+ (run-hooks 'gnus-group-update-group-hook)))
(setq loc (1+ loc)))
(unless (or found visible-only)
;; No such line in the buffer, find out where it's supposed to
(or entry (goto-char (point-max)))))
;; Finally insert the line.
(let ((gnus-group-indentation (gnus-group-group-indentation)))
- (gnus-group-insert-group-line-info group)))
+ (gnus-group-insert-group-line-info group)
+ (save-excursion
+ (forward-line -1)
+ (run-hooks 'gnus-group-update-group-hook))))
(gnus-group-set-mode-line)))))
(defun gnus-group-set-mode-line ()
+ "Update the mode line in the group buffer."
(when (memq 'group gnus-updated-mode-lines)
- (let* ((gformat (or gnus-group-mode-line-format-spec
- (setq gnus-group-mode-line-format-spec
- (gnus-parse-format
- gnus-group-mode-line-format
- gnus-group-mode-line-format-alist))))
- (gnus-tmp-news-server (cadr gnus-select-method))
- (gnus-tmp-news-method (car gnus-select-method))
- (max-len 60)
- gnus-tmp-header ;Dummy binding for user-defined formats
- ;; Get the resulting string.
- (mode-string (eval gformat)))
- ;; If the line is too long, we chop it off.
- (when (> (length mode-string) max-len)
- (setq mode-string (substring mode-string 0 (- max-len 4))))
- (prog1
- (setq mode-line-buffer-identification (list mode-string))
- (set-buffer-modified-p t)))))
+ ;; Yes, we want to keep this mode line updated.
+ (save-excursion
+ (set-buffer gnus-group-buffer)
+ (let* ((gformat (or gnus-group-mode-line-format-spec
+ (setq gnus-group-mode-line-format-spec
+ (gnus-parse-format
+ gnus-group-mode-line-format
+ gnus-group-mode-line-format-alist))))
+ (gnus-tmp-news-server (cadr gnus-select-method))
+ (gnus-tmp-news-method (car gnus-select-method))
+ (gnus-tmp-colon (if (equal gnus-tmp-news-server "") "" ":"))
+ (max-len 60)
+ gnus-tmp-header ;Dummy binding for user-defined formats
+ ;; Get the resulting string.
+ (modified
+ (and gnus-dribble-buffer
+ (buffer-name gnus-dribble-buffer)
+ (buffer-modified-p gnus-dribble-buffer)
+ (save-excursion
+ (set-buffer gnus-dribble-buffer)
+ (not (zerop (buffer-size))))))
+ (mode-string (eval gformat)))
+ ;; Say whether the dribble buffer has been modified.
+ (setq mode-line-modified
+ (if modified "---*- " "----- "))
+ ;; If the line is too long, we chop it off.
+ (when (> (length mode-string) max-len)
+ (setq mode-string (substring mode-string 0 (- max-len 4))))
+ (prog1
+ (setq mode-line-buffer-identification
+ (gnus-mode-line-buffer-identification
+ (list mode-string)))
+ (set-buffer-modified-p modified))))))
(defun gnus-group-group-name ()
"Get the name of the newsgroup on the current line."
(setq gnus-group-marked (delete group gnus-group-marked)))
(insert "#")
(setq gnus-group-marked
- (cons group (delete group gnus-group-marked))))
- (or no-advance (zerop (gnus-group-next-group 1))))
+ (cons group (delete group gnus-group-marked)))))
+ (or no-advance (gnus-group-next-group 1))
(decf n))
(gnus-summary-position-point)
n))
group gnus-active-hashtb))))
(and b (goto-char b)))))
-(defun gnus-group-next-group (n)
+(defun gnus-group-next-group (n &optional silent)
"Go to next N'th newsgroup.
If N is negative, search backward instead.
Returns the difference between N and the number of skips actually
done."
(interactive "p")
- (gnus-group-next-unread-group n t))
+ (gnus-group-next-unread-group n t nil silent))
-(defun gnus-group-next-unread-group (n &optional all level)
+(defun gnus-group-next-unread-group (n &optional all level silent)
"Go to next N'th unread newsgroup.
If N is negative, search backward instead.
If ALL is non-nil, choose any newsgroup, unread or not.
(gnus-group-search-forward
backward (or (not gnus-group-goto-unread) all) level))
(setq n (1- n)))
- (if (/= 0 n) (gnus-message 7 "No more%s newsgroups%s" (if all "" " unread")
- (if level " on this level or higher" "")))
+ (when (and (/= 0 n)
+ (not silent))
+ (gnus-message 7 "No more%s newsgroups%s" (if all "" " unread")
+ (if level " on this level or higher" "")))
n))
(defun gnus-group-prev-group (n)
t))
(defun gnus-group-delete-group (group &optional force)
- "Delete the current group.
+ "Delete the current group. Only meaningful with mail groups.
If FORCE (the prefix) is non-nil, all the articles in the group will
be deleted. This is \"deleted\" as in \"removed forever from the face
-of the Earth\". There is no undo."
+of the Earth\". There is no undo. The user will be prompted before
+doing the deletion."
(interactive
(list (gnus-group-group-name)
current-prefix-arg))
The difference between N and actual number of newsgroups that were
caught up is returned."
(interactive "P")
+ (unless (gnus-group-group-name)
+ (error "No group on the current line"))
(if (not (or (not gnus-interactive-catchup) ;Without confirmation?
gnus-expert-user
(gnus-y-or-n-p
(gnus-uncompress-sequence (cdr expirable)) group))
;; Just expire using the normal expiry values.
(gnus-request-expire-articles
- (gnus-uncompress-sequence (cdr expirable)) group)))))
+ (gnus-uncompress-sequence (cdr expirable)) group))))
+ (gnus-close-group group))
(gnus-message 6 "Expiring articles in %s...done" group)))
(gnus-group-position-point))))
(while groups
(gnus-group-remove-mark (setq group (pop groups)))
(gnus-delete-line)
+ (push group gnus-killed-list)
+ (setq gnus-newsrc-alist
+ (delq (assoc group gnus-newsrc-alist)
+ gnus-newsrc-alist))
+ (when gnus-group-change-level-function
+ (funcall gnus-group-change-level-function group 9 3))
(cond
((setq entry (gnus-gethash group gnus-newsrc-hashtb))
(push (cons (car entry) (nth 2 entry))
(let* ((prev gnus-newsrc-alist)
(alist (cdr prev)))
(while alist
- (if (= (gnus-info-level level) level)
- (setcdr prev (cdr alist))
+ (if (= (gnus-info-level (car alist)) level)
+ (progn
+ (push (gnus-info-group (car alist)) gnus-killed-list)
+ (setcdr prev (cdr alist)))
(setq prev alist))
(setq alist (cdr alist)))
(gnus-make-hashtable-from-newsrc-alist)
(let (list)
(mapatoms
(lambda (sym)
- (and (symbol-value sym)
+ (and (boundp sym)
+ (symbol-value sym)
(setq list (cons (symbol-name sym) list))))
gnus-active-hashtb)
list)
(unless (gnus-virtual-group-p group)
(gnus-close-group group))
(gnus-group-update-group group))
- (gnus-error 3 "%s error: %s" group (gnus-status-message group))))
+ (if (eq (gnus-server-status (gnus-find-method-for-group group))
+ 'denied)
+ (gnus-error "Server denied access")
+ (gnus-error 3 "%s error: %s" group (gnus-status-message group)))))
(when beg (goto-char beg))
(when gnus-goto-next-group-when-activating
(gnus-group-next-unread-group 1 t))
"Fetch the FAQ for the current group."
(interactive
(list
- (gnus-group-real-name (gnus-group-group-name))
+ (and (gnus-group-group-name)
+ (gnus-group-real-name (gnus-group-group-name)))
(cond (current-prefix-arg
(completing-read
"Faq dir: " (and (listp gnus-group-faq-directory)
- gnus-group-faq-directory))))))
+ (mapcar (lambda (file) (list file))
+ gnus-group-faq-directory)))))))
(or faq-dir
(setq faq-dir (if (listp gnus-group-faq-directory)
(car gnus-group-faq-directory)
(defun gnus-group-describe-group (force &optional group)
"Display a description of the current newsgroup."
(interactive (list current-prefix-arg (gnus-group-group-name)))
- (and force (setq gnus-description-hashtb nil))
- (let ((method (gnus-find-method-for-group group))
- desc)
+ (let* ((method (gnus-find-method-for-group group))
+ (mname (gnus-group-prefixed-name "" method))
+ desc)
+ (when (and force
+ gnus-description-hashtb)
+ (gnus-sethash mname nil gnus-description-hashtb))
(or group (error "No group name given"))
(and (or (and gnus-description-hashtb
;; We check whether this group's method has been
;; queried for a description file.
- (gnus-gethash
- (gnus-group-prefixed-name "" method)
- gnus-description-hashtb))
+ (gnus-gethash mname gnus-description-hashtb))
(setq desc (gnus-group-get-description group))
(gnus-read-descriptions-file method))
(gnus-message 1
(setq b (point))
(insert (format " *: %-20s %s\n" (symbol-name group)
(symbol-value group)))
- (add-text-properties
+ (gnus-add-text-properties
b (1+ b) (list 'gnus-group group
'gnus-unread t 'gnus-marked nil
'gnus-level (1+ gnus-level-subscribed))))
(goto-char (point-min))
(gnus-group-position-point)))
-;; Suggested by by Daniel Quinlan <quinlan@best.com>.
+;; Suggested by Daniel Quinlan <quinlan@best.com>.
(defun gnus-group-apropos (regexp &optional search-description)
"List all newsgroups that have names that match a regexp."
(interactive "sGnus apropos (regexp): ")
(interactive "P\nsList newsgroups matching: ")
;; First make sure active file has been read.
(when (and level
- (>= (prefix-numeric-value level) gnus-level-killed))
+ (> (prefix-numeric-value level) gnus-level-killed))
(gnus-get-killed-groups))
(gnus-group-prepare-flat (or level gnus-level-subscribed)
all (or lowest 1) regexp)
(interactive)
(run-hooks 'gnus-suspend-gnus-hook)
;; Kill Gnus buffers except for group mode buffer.
- (let ((group-buf (get-buffer gnus-group-buffer)))
- ;; Do this on a separate list in case the user does a ^G before we finish
- (let ((gnus-buffer-list
- (delq group-buf (delq gnus-dribble-buffer
- (append gnus-buffer-list nil)))))
- (while gnus-buffer-list
- (gnus-kill-buffer (car gnus-buffer-list))
- (setq gnus-buffer-list (cdr gnus-buffer-list))))
- (if group-buf
- (progn
- (setq gnus-buffer-list (list group-buf))
- (bury-buffer group-buf)
- (delete-windows-on group-buf t)))))
+ (let* ((group-buf (get-buffer gnus-group-buffer))
+ ;; Do this on a separate list in case the user does a ^G before we finish
+ (gnus-buffer-list
+ (delete group-buf (delete gnus-dribble-buffer
+ (append gnus-buffer-list nil)))))
+ (while gnus-buffer-list
+ (gnus-kill-buffer (pop gnus-buffer-list)))
+ (gnus-kill-gnus-frames)
+ (when group-buf
+ (setq gnus-buffer-list (list group-buf))
+ (bury-buffer group-buf)
+ (delete-windows-on group-buf t))))
(defun gnus-group-clear-dribble ()
"Clear all information from the dribble buffer."
(interactive)
(when
(or noninteractive ;For gnus-batch-kill
- (not (gnus-server-opened gnus-select-method)) ;NNTP connection closed
(not gnus-interactive-exit) ;Without confirmation
gnus-expert-user
(gnus-y-or-n-p "Are you sure you want to quit reading news? "))
"s" gnus-article-hide-signature
"c" gnus-article-hide-citation
"p" gnus-article-hide-pgp
+ "P" gnus-article-hide-pem
"\C-c" gnus-article-hide-citation-maybe)
(gnus-define-keys (gnus-summary-wash-highlight-map "H" gnus-summary-wash-map)
(gnus-visual-p 'summary-menu 'menu))
(gnus-summary-make-menu-bar))
(kill-all-local-variables)
- (let ((locals gnus-summary-local-variables))
- (while locals
- (if (consp (car locals))
- (progn
- (make-local-variable (caar locals))
- (set (caar locals) (eval (cdar locals))))
- (make-local-variable (car locals))
- (set (car locals) nil))
- (setq locals (cdr locals))))
+ (gnus-summary-make-local-variables)
(gnus-make-thread-indent-array)
(gnus-simplify-mode-line)
(setq major-mode 'gnus-summary-mode)
(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)
(run-hooks 'gnus-summary-mode-hook))
+(defun gnus-summary-make-local-variables ()
+ "Make all the local summary buffer variables."
+ (let ((locals gnus-summary-local-variables)
+ global local)
+ (while (setq local (pop locals))
+ (if (consp local)
+ (progn
+ (if (eq (cdr local) 'global)
+ ;; Copy the global value of the variable.
+ (setq global (symbol-value (car local)))
+ ;; Use the value from the list.
+ (setq global (eval (cdr local))))
+ (make-local-variable (car local))
+ (set (car local) global))
+ ;; Simple nil-valued local variable.
+ (make-local-variable local)
+ (set local nil)))))
+
(defun gnus-summary-make-display-table ()
;; Change the display table. Odd characters have a tendency to mess
;; up nicely formatted displays - we make all possible glyphs
(= mark gnus-dormant-mark)
(= mark gnus-expirable-mark))))
+;; Saving hidden threads.
+
+(put 'gnus-save-hidden-threads 'lisp-indent-function 0)
+(put 'gnus-save-hidden-threads 'lisp-indent-hook 0)
+(put 'gnus-save-hidden-threads 'edebug-form-spec '(body))
+
+(defmacro gnus-save-hidden-threads (&rest forms)
+ "Save hidden threads, eval FORMS, and restore the hidden threads."
+ (let ((config (make-symbol "config")))
+ `(let ((,config (gnus-hidden-threads-configuration)))
+ (unwind-protect
+ (progn
+ ,@forms)
+ (gnus-restore-hidden-threads-configuration ,config)))))
+
+(defun gnus-hidden-threads-configuration ()
+ "Return the current hidden threads configuration."
+ (save-excursion
+ (let (config)
+ (goto-char (point-min))
+ (while (search-forward "\r" nil t)
+ (push (1- (point)) config))
+ config)))
+
+(defun gnus-restore-hidden-threads-configuration (config)
+ "Restore hidden threads configuration from CONFIG."
+ (let (point buffer-read-only)
+ (while (setq point (pop config))
+ (when (and (< point (point-max))
+ (goto-char point)
+ (= (following-char) ?\n))
+ (subst-char-in-region point (1+ point) ?\n ?\r)))))
+
;; Various summary mode internalish functions.
(defun gnus-mouse-pick-article (e)
(article-buffer gnus-article-buffer)
(original gnus-original-article-buffer)
(gac gnus-article-current)
+ (reffed gnus-reffed-article-number)
(score-file gnus-current-score-file))
(save-excursion
(set-buffer gnus-group-buffer)
(setq gnus-summary-buffer summary)
(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)))))
(defun gnus-summary-last-article-p (&optional article)
(defun gnus-summary-insert-dummy-line (gnus-tmp-subject gnus-tmp-number)
"Insert a dummy root in the summary buffer."
(beginning-of-line)
- (add-text-properties
+ (gnus-add-text-properties
(point) (progn (eval gnus-summary-dummy-line-format-spec) (point))
(list 'gnus-number gnus-tmp-number 'gnus-intangible gnus-tmp-number)))
(when (string= gnus-tmp-name "")
(setq gnus-tmp-name gnus-tmp-from))
(or (numberp gnus-tmp-lines) (setq gnus-tmp-lines 0))
- (put-text-property
+ (gnus-put-text-property
(point)
(progn (eval gnus-summary-line-format-spec) (point))
'gnus-number gnus-tmp-number)
1)
((memq (mail-header-number (car thread)) gnus-newsgroup-limit)
1)
- (t 1))))
+ (t 0))))
(when (and level (zerop level) gnus-tmp-new-adopts)
(incf number
(apply '+ (mapcar
(cond (gnus-newsgroup-dormant
(gnus-summary-limit-include-dormant))
((and gnus-newsgroup-scored show-all)
- (gnus-summary-limit-include-expunged))))
+ (gnus-summary-limit-include-expunged t))))
;; Function `gnus-apply-kill-file' must be called in this hook.
(run-hooks 'gnus-apply-kill-hook)
(if (and (zerop (buffer-size))
(delq number gnus-newsgroup-unselected)))
(push number gnus-newsgroup-ancient)))))))
-(defun gnus-summary-update-article (article &optional header)
+(defun gnus-summary-update-article (article &optional iheader)
"Update ARTICLE in the summary buffer."
(set-buffer gnus-summary-buffer)
- (let* ((header (or header (gnus-summary-article-header article)))
+ (let* ((header (or iheader (gnus-summary-article-header article)))
(id (mail-header-id header))
(data (gnus-data-find article))
(thread (gnus-id-to-thread id))
+ (references (mail-header-references header))
(parent
- (gnus-id-to-thread (or (gnus-parent-id
- (mail-header-references header))
- "tull")))
+ (gnus-id-to-thread
+ (or (gnus-parent-id
+ (if (and references
+ (not (equal "" references)))
+ references))
+ "none")))
(buffer-read-only nil)
(old (car thread))
(number (mail-header-number header))
pos)
(when thread
- (setcar thread nil)
+ ;; !!! Should this be in or not?
+ (unless iheader
+ (setcar thread nil))
(when parent
(delq thread parent))
- (if (gnus-summary-insert-subject id header)
+ (if (gnus-summary-insert-subject id header iheader)
;; Set the (possibly) new article number in the data structure.
(gnus-data-set-number data (gnus-id-to-article id))
(setcar thread old)
(gnus-data-compute-positions)
(setq gnus-newsgroup-threads (nconc threads gnus-newsgroup-threads)))))
+(defun gnus-number-to-header (number)
+ "Return the header for article NUMBER."
+ (let ((headers gnus-newsgroup-headers))
+ (while (and headers
+ (not (= number (mail-header-number (car headers)))))
+ (pop headers))
+ (when headers
+ (car headers))))
+
(defun gnus-id-to-thread (id)
"Return the (sub-)thread where ID appears."
(gnus-gethash id gnus-newsgroup-dependencies))
((null level) nil)
((zerop level) t)
((null refs) t)
- ((null(gnus-parent-id refs)) t)
+ ((null (gnus-parent-id refs)) t)
((and (= 1 level)
(null (setq particle (gnus-id-to-article
(gnus-parent-id refs))))
(while threads
(setq sub (car threads))
(if (stringp (car sub))
- ;; This is a gathered threads, so we look at the roots
- ;; below it to find whether this article in in this
+ ;; This is a gathered thread, so we look at the roots
+ ;; below it to find whether this article is in this
;; gathered root.
(progn
(setq sub (cdr sub))
(defsubst gnus-article-sort-by-date (h1 h2)
"Sort articles by root article date."
(string-lessp
- (gnus-sortable-date (mail-header-date h1))
- (gnus-sortable-date (mail-header-date h2))))
+ (inline (gnus-sortable-date (mail-header-date h1)))
+ (inline (gnus-sortable-date (mail-header-date h2)))))
(defun gnus-thread-sort-by-date (h1 h2)
"Sort threads by root article date."
(defun gnus-thread-total-score (thread)
;; This function find the total score of THREAD.
- (if (consp thread)
- (if (stringp (car thread))
- (apply gnus-thread-score-function 0
- (mapcar 'gnus-thread-total-score-1 (cdr thread)))
- (gnus-thread-total-score-1 thread))
- (gnus-thread-total-score-1 (list thread))))
+ (cond ((null thread)
+ 0)
+ ((consp thread)
+ (if (stringp (car thread))
+ (apply gnus-thread-score-function 0
+ (mapcar 'gnus-thread-total-score-1 (cdr thread)))
+ (gnus-thread-total-score-1 thread)))
+ (t
+ (gnus-thread-total-score-1 (list thread)))))
(defun gnus-thread-total-score-1 (root)
;; This function find the total score of the thread below ROOT.
(setq root (car root))
(apply gnus-thread-score-function
- (or (cdr (assq (mail-header-number root) gnus-newsgroup-scored))
- gnus-summary-default-score 0)
- (mapcar 'gnus-thread-total-score
- (cdr (gnus-gethash (mail-header-id root)
- gnus-newsgroup-dependencies)))))
+ (or (append
+ (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))))
+ (list gnus-summary-default-score)
+ '(0))))
;; Added by Per Abrahamsen <amanda@iesd.auc.dk>.
(defvar gnus-tmp-prev-subject nil)
default-score)
gnus-summary-mark-below)
;; Don't touch sparse articles.
- (not (memq number gnus-newsgroup-sparse)))
+ (not (memq number gnus-newsgroup-sparse))
+ (not (memq number gnus-newsgroup-ancient)))
(setq gnus-newsgroup-unreads
(delq number gnus-newsgroup-unreads))
(if gnus-newsgroup-auto-expire
gnus-cached-mark)
((memq number gnus-newsgroup-replied)
gnus-replied-mark)
+ ((memq number gnus-newsgroup-saved)
+ gnus-saved-mark)
(t gnus-unread-mark))
gnus-tmp-from (mail-header-from gnus-tmp-header)
gnus-tmp-name
(when (string= gnus-tmp-name "")
(setq gnus-tmp-name gnus-tmp-from))
(or (numberp gnus-tmp-lines) (setq gnus-tmp-lines 0))
- (put-text-property
+ (gnus-put-text-property
(point)
(progn (eval gnus-summary-line-format-spec) (point))
'gnus-number number)
(when (and gnus-summary-mark-below
(< (or (cdr (assq number gnus-newsgroup-scored))
gnus-summary-default-score 0)
- gnus-summary-mark-below))
+ gnus-summary-mark-below)
+ (not (memq number gnus-newsgroup-ancient)))
(setq gnus-newsgroup-unreads
(delq number gnus-newsgroup-unreads))
(if gnus-newsgroup-auto-expire
(error "Couldn't open server"))
(or (and entry (not (eq (car entry) t))) ; Either it's active...
- (gnus-activate-group group) ; Or we can activate it...
- (progn ; Or we bug out.
+ (gnus-activate-group group) ; Or we can activate it...
+ (progn ; Or we bug out.
(when (equal major-mode 'gnus-summary-mode)
(kill-buffer (current-buffer)))
(error "Couldn't request group %s: %s"
group (gnus-status-message group))))
+ (unless (gnus-request-group group t)
+ (when (equal major-mode 'gnus-summary-mode)
+ (kill-buffer (current-buffer)))
+ (error "Couldn't request group %s: %s"
+ group (gnus-status-message group)))
+
(setq gnus-newsgroup-name group)
(setq gnus-newsgroup-unselected nil)
(setq gnus-newsgroup-unreads (gnus-list-of-unread-articles group))
(unless gnus-single-article-buffer
(gnus-article-setup-buffer))
;; First and last article in this newsgroup.
- (and gnus-newsgroup-headers
- (setq gnus-newsgroup-begin
- (mail-header-number (car gnus-newsgroup-headers)))
- (setq gnus-newsgroup-end
- (mail-header-number
- (gnus-last-element gnus-newsgroup-headers))))
- (setq gnus-reffed-article-number -1)
+ (when gnus-newsgroup-headers
+ (setq gnus-newsgroup-begin
+ (mail-header-number (car gnus-newsgroup-headers))
+ gnus-newsgroup-end
+ (mail-header-number
+ (gnus-last-element gnus-newsgroup-headers))))
;; GROUP is successfully selected.
(or gnus-newsgroup-headers t)))))
"How many articles from %s (default %d): "
gnus-newsgroup-name number))))
(if (string-match "^[ \t]*$" input) number input)))
- ((and (> scored marked) (< scored number))
+ ((and (> scored marked) (< scored number)
+ (> (- scored number) 20))
(let ((input
(read-string
(format "%s %s (%d scored, %d total): "
(min (car active))
(max (cdr active))
(types gnus-article-mark-lists)
- (uncompressed '(score bookmark))
+ (uncompressed '(score bookmark killed))
marks var articles article mark)
(while marked-lists
;; All articles have to be subsets of the active articles.
(cond
;; Adjust "simple" lists.
- ((memq mark '(tick dormant expirable reply killed save))
+ ((memq mark '(tick dormant expirable reply save))
(while articles
(when (or (< (setq article (pop articles)) min) (> article max))
(set var (delq article (symbol-value var))))))
;; Adjust assocs.
- ((memq mark '(score bookmark))
+ ((memq mark uncompressed)
(while articles
- (when (or (< (car (setq article (pop articles))) min)
+ (when (or (not (consp (setq article (pop articles))))
+ (< (car article) min)
(> (car article) max))
(set var (delq article (symbol-value var))))))))))
(car type))))))
(push (cons (cdr type)
(if (memq (cdr type) uncompressed) list
- (gnus-compress-sequence (set symbol (sort list '<)) t)))
+ (gnus-compress-sequence
+ (set symbol (sort list '<)) t)))
newmarked)))
;; Enter these new marks into the info of the group.
(gnus-tmp-subject
(if (and gnus-current-headers
(vectorp gnus-current-headers))
- (mail-header-subject gnus-current-headers) ""))
+ (gnus-mode-string-quote
+ (mail-header-subject gnus-current-headers)) ""))
max-len
gnus-tmp-header);; passed as argument to any user-format-funcs
(setq mode-string (eval mformat))
;; 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 (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)
(progn
(goto-char p)
(if (search-forward "\nreferences: " nil t)
- (prog1
- (gnus-header-value)
- (setq end (match-end 0))
- (save-excursion
+ (progn
+ (setq end (point))
+ (prog1
+ (gnus-header-value)
(setq ref
(buffer-substring
(progn
(setq header nil))
(setcar (symbol-value id-dep) header))
(set id-dep (list header))))
- (if header
- (progn
- (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 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))
(defun gnus-article-get-xrefs ()
(progn (end-of-line) (point))))
(mail-header-set-xref headers xref))))))))
-(defun gnus-summary-insert-subject (id &optional old-header)
+(defun gnus-summary-insert-subject (id &optional old-header use-old-header)
"Find article ID and insert the summary line for that article."
- (let ((header (gnus-read-header id))
+ (let ((header (if (and old-header use-old-header)
+ old-header (gnus-read-header id)))
(number (and (numberp id) id))
pos)
(when header
;; Rebuild the thread that this article is part of and go to the
;; article we have fetched.
- (when old-header
+ (when (and (not gnus-show-threads)
+ old-header)
(when (setq pos (text-property-any
(point-min) (point-max) 'gnus-number
(mail-header-number old-header)))
(when old-header
(mail-header-set-number header (mail-header-number old-header)))
(setq gnus-newsgroup-sparse
- (delq (mail-header-number header) gnus-newsgroup-sparse))
+ (delq (setq number (mail-header-number header))
+ gnus-newsgroup-sparse))
+ (setq gnus-newsgroup-ancient (delq number gnus-newsgroup-ancient))
(gnus-rebuild-thread (mail-header-id header))
- (gnus-summary-goto-subject (setq number (mail-header-number header))
- nil t))
+ (gnus-summary-goto-subject number nil t))
(when (and (numberp number)
(> number 0))
;; We have to update the boundaries even if we can't fetch the
the list of process marked articles, and the current article will be
taken into consideration."
(cond
- ((and n (numberp n))
+ (n
;; A numerical prefix has been given.
(let ((backward (< n 0))
- (n (abs n))
+ (n (abs (prefix-numeric-value n)))
articles article)
(save-excursion
(while
(gnus-data-number result)))))
(defun gnus-summary-find-prev (&optional unread article)
- (let* ((article (or article (gnus-summary-article-number)))
+ (let* ((eobp (eobp))
+ (article (or article (gnus-summary-article-number)))
(arts (gnus-data-find-list article (gnus-data-list 'rev)))
result)
- (when (or (not gnus-summary-check-current)
- (not unread)
- (not (gnus-data-unread-p (car arts))))
+ (when (and (not eobp)
+ (or (not gnus-summary-check-current)
+ (not unread)
+ (not (gnus-data-unread-p (car arts)))))
(setq arts (cdr arts)))
(if (setq result
(if unread
The prefix argument ALL means to select all articles."
(interactive "P")
(gnus-set-global-variables)
+ (when (gnus-ephemeral-group-p gnus-newsgroup-name)
+ (error "Ephemeral groups can't be reselected"))
(let ((current-subject (gnus-summary-article-number))
(group gnus-newsgroup-name))
(setq gnus-newsgroup-begin nil)
(save-excursion
(gnus-group-get-new-news-this-group 1)))
(gnus-group-read-group all t)
- (gnus-summary-goto-subject current-subject)))
+ (gnus-summary-goto-subject current-subject nil t)))
(defun gnus-summary-rescan-group (&optional all)
"Exit the newsgroup, ask for new articles, and select the newsgroup."
;; Make sure where I was, and go to next newsgroup.
(set-buffer gnus-group-buffer)
(unless quit-config
- (gnus-group-jump-to-group group)
- (gnus-group-next-unread-group 1))
+ (gnus-group-jump-to-group group))
(run-hooks 'gnus-summary-exit-hook)
+ (unless quit-config
+ (gnus-group-next-unread-group 1))
(if temporary
nil ;Nothing to do.
;; If we have several article buffers, we kill them at exit.
;; We read in the article if we have to.
(and (not data)
force
- (gnus-summary-insert-subject article)
+ (gnus-summary-insert-subject article (and (vectorp force) force) t)
(setq data (gnus-data-find article)))
(goto-char b)
(if (not data)
;; If not, we try the first unread, if that is wanted.
((and subject
gnus-auto-select-same
- (or (gnus-summary-first-unread-article)
- (eq (gnus-summary-article-mark) gnus-canceled-mark)))
+ (gnus-summary-first-unread-article))
(gnus-summary-position-point)
(gnus-message 6 "Wrapped"))
;; Try to get next/previous article not displayed in this group.
(select-window (get-buffer-window (current-buffer)))
;; Select next unread newsgroup automagically.
(cond
- ((not gnus-auto-select-next)
+ ((or (not gnus-auto-select-next)
+ (not cmd))
(gnus-message 7 "No more%s articles" (if unread " unread" "")))
((or (eq gnus-auto-select-next 'quietly)
(and (eq gnus-auto-select-next 'slightly-quietly)
(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)))
+ (gnus-eval-in-buffer-window gnus-article-buffer
+ (setq endp (gnus-article-next-page lines)))
(if endp
(cond (circular
(gnus-summary-beginning-of-article))
(gnus-summary-display-article article)
(gnus-summary-recenter)
(gnus-eval-in-buffer-window gnus-article-buffer
- (gnus-article-prev-page lines))))
+ (gnus-article-prev-page lines))))
(gnus-summary-position-point))
(defun gnus-summary-scroll-up (lines)
(gnus-configure-windows 'article)
(gnus-summary-show-thread)
(when (eq (gnus-summary-select-article nil nil 'pseudo) 'old)
- (gnus-eval-in-buffer-window
- gnus-article-buffer
- (cond ((> lines 0)
- (if (gnus-article-next-page lines)
- (gnus-message 3 "End of message")))
- ((< lines 0)
- (gnus-article-prev-page (- lines))))))
+ (gnus-eval-in-buffer-window gnus-article-buffer
+ (cond ((> lines 0)
+ (if (gnus-article-next-page lines)
+ (gnus-message 3 "End of message")))
+ ((< lines 0)
+ (gnus-article-prev-page (- lines))))))
(gnus-summary-recenter)
(gnus-summary-position-point))
(setq gnus-newsgroup-limit articles)
(let ((total (length gnus-newsgroup-data))
(data (gnus-data-find-list (gnus-summary-article-number)))
+ (gnus-summary-mark-below nil) ; Inhibit this.
found)
;; This will do all the work of generating the new summary buffer
;; according to the new limit.
;; buffer as a result of the new limit.
(- total (length gnus-newsgroup-data))))
+(defsubst gnus-invisible-cut-children (threads)
+ (let ((num 0))
+ (while threads
+ (when (memq (mail-header-number (caar threads)) gnus-newsgroup-limit)
+ (incf num))
+ (pop threads))
+ (< num 2)))
+
(defsubst gnus-cut-thread (thread)
"Go forwards in the thread until we find an article that we want to display."
- (when (eq gnus-fetch-old-headers 'some)
- ;; Deal with old-fetched headers.
- (while (and thread
- (memq (mail-header-number (car thread))
- gnus-newsgroup-ancient)
- (<= (length (cdr thread)) 1))
- (setq thread (cadr thread))))
- ;; Deal with sparse threads.
- (when (or (eq gnus-build-sparse-threads 'some)
+ (when (or (eq gnus-fetch-old-headers 'some)
+ (eq gnus-build-sparse-threads 'some)
(eq gnus-build-sparse-threads 'more))
- (while (and thread
- (memq (mail-header-number (car thread)) gnus-newsgroup-sparse)
- (= (length (cdr thread)) 1))
+ ;; Deal with old-fetched headers and sparse threads.
+ (while (and
+ thread
+ (or
+ (memq (mail-header-number (car thread)) gnus-newsgroup-sparse)
+ (memq (mail-header-number (car thread)) gnus-newsgroup-ancient))
+ (or (<= (length (cdr thread)) 1)
+ (gnus-invisible-cut-children (cdr thread))))
(setq thread (cadr thread))))
thread)
;; children, then this article isn't visible.
(and (memq number gnus-newsgroup-dormant)
(= children 0))
- ;; If this is a "fetch-old-headered" and there is only one
+ ;; 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)
(set-buffer gnus-original-article-buffer)
(nnheader-narrow-to-headers)
(prog1
- (mail-fetch-field "references")
+ (message-fetch-field "references")
(widen)))
;; It's not the current article, so we take a bet on
;; the value we got from the server.
(setq message-id (concat "<" message-id)))
(unless (string-match ">$" message-id)
(setq message-id (concat message-id ">")))
- (let ((header (car (gnus-gethash message-id
- gnus-newsgroup-dependencies))))
+ (let* ((header (gnus-id-to-header message-id))
+ (sparse (and header
+ (memq (mail-header-number header)
+ gnus-newsgroup-sparse))))
(if header
- ;; The article is present in the buffer, to we just go to it.
- (gnus-summary-goto-article (mail-header-number header) nil t)
+ (prog1
+ ;; The article is present in the buffer, to we just go to it.
+ (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))
number)
;; Start the special refer-article method, if necessary.
- (when gnus-refer-article-method
+ (when (and gnus-refer-article-method
+ (gnus-news-group-p gnus-newsgroup-name))
(gnus-check-server gnus-refer-article-method))
;; Fetch the header, and display the article.
(if (setq number (gnus-summary-insert-subject message-id))
(gnus-set-global-variables)
(gnus-summary-select-article)
(gnus-configure-windows 'article)
- (gnus-eval-in-buffer-window
- gnus-article-buffer
- (goto-char (point-min))
- (isearch-forward regexp-p)))
+ (gnus-eval-in-buffer-window gnus-article-buffer
+ ;;(goto-char (point-min))
+ (isearch-forward regexp-p)))
(defun gnus-summary-search-article-forward (regexp &optional backward)
"Search for an article containing REGEXP forward.
(if (string-equal regexp "")
(setq regexp (or gnus-last-search-regexp ""))
(setq gnus-last-search-regexp regexp))
- (if (gnus-summary-search-article regexp backward)
- (gnus-article-set-window-start
- (cdr (assq (gnus-summary-article-number) gnus-newsgroup-bookmarks)))
+ (unless (gnus-summary-search-article regexp backward)
(error "Search failed: \"%s\"" regexp)))
(defun gnus-summary-search-article-backward (regexp)
(defun gnus-summary-search-article (regexp &optional backward)
"Search for an article containing REGEXP.
Optional argument BACKWARD means do search for backward.
-gnus-select-article-hook is not called during the search."
+`gnus-select-article-hook' is not called during the search."
(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
- (function re-search-backward) (function re-search-forward)))
- (found nil)
- (last nil))
- ;; Hidden thread subtrees must be searched for ,too.
- (gnus-summary-show-all-threads)
- ;; First of all, search current article.
- ;; We don't want to read article again from NNTP server nor reset
- ;; current point.
- (gnus-summary-select-article)
- (gnus-message 9 "Searching article: %d..." gnus-current-article)
- (setq last gnus-current-article)
- (gnus-eval-in-buffer-window
- gnus-article-buffer
- (save-restriction
- (widen)
- ;; Begin search from current point.
- (setq found (funcall re-search regexp nil t))))
- ;; Then search next articles.
- (while (and (not found)
- (gnus-summary-display-article
- (if backward (gnus-summary-find-prev)
- (gnus-summary-find-next))))
- (gnus-message 9 "Searching article: %d..." gnus-current-article)
- (gnus-eval-in-buffer-window
- gnus-article-buffer
- (save-restriction
- (widen)
- (goto-char (if backward (point-max) (point-min)))
- (setq found (funcall re-search regexp nil t)))))
- (message "")
- ;; Adjust article pointer.
- (or (eq last gnus-current-article)
- (setq gnus-last-article last))
- ;; Return T if found such article.
- found))
+ 're-search-backward 're-search-forward))
+ (sum (current-buffer))
+ (found nil))
+ (gnus-save-hidden-threads
+ (gnus-summary-select-article)
+ (set-buffer gnus-article-buffer)
+ (when backward
+ (forward-line -1))
+ (while (not found)
+ (gnus-message 7 "Searching article: %d..." (cdr gnus-article-current))
+ (if (if backward
+ (re-search-backward regexp nil t)
+ (re-search-forward regexp nil t))
+ ;; We found the regexp.
+ (progn
+ (setq found 'found)
+ (beginning-of-line)
+ (set-window-start
+ (get-buffer-window (current-buffer))
+ (point))
+ (forward-line 1)
+ (set-buffer sum))
+ ;; We didn't find it, so we go to the next article.
+ (set-buffer sum)
+ (if (not (if backward (gnus-summary-find-prev)
+ (gnus-summary-find-next)))
+ ;; No more articles.
+ (setq found t)
+ ;; Select the next article and adjust point.
+ (gnus-summary-select-article)
+ (set-buffer gnus-article-buffer)
+ (widen)
+ (goto-char (if backward (point-max) (point-min))))))
+ (gnus-message 7 ""))
+ ;; Return whether we found the regexp.
+ (when (eq found 'found)
+ (gnus-summary-show-thread)
+ (gnus-summary-goto-subject gnus-current-article)
+ (gnus-summary-position-point)
+ t)))
(defun gnus-summary-find-matching (header regexp &optional backward unread
not-case-fold)
(gnus-set-global-variables)
(gnus-summary-select-article)
(gnus-configure-windows 'article)
- (gnus-eval-in-buffer-window
- gnus-article-buffer
- (widen)
- (goto-char (point-min))
- (and gnus-break-pages (gnus-narrow-to-page))))
+ (gnus-eval-in-buffer-window gnus-article-buffer
+ (widen)
+ (goto-char (point-min))
+ (and gnus-break-pages (gnus-narrow-to-page))))
(defun gnus-summary-end-of-article ()
"Scroll to the end of the article."
(gnus-set-global-variables)
(gnus-summary-select-article)
(gnus-configure-windows 'article)
- (gnus-eval-in-buffer-window
- gnus-article-buffer
- (widen)
- (goto-char (point-max))
- (recenter -3)
- (and gnus-break-pages (gnus-narrow-to-page))))
+ (gnus-eval-in-buffer-window gnus-article-buffer
+ (widen)
+ (goto-char (point-max))
+ (recenter -3)
+ (and gnus-break-pages (gnus-narrow-to-page))))
(defun gnus-summary-show-article (&optional arg)
"Force re-fetching of the current article.
(gnus-set-global-variables)
(gnus-summary-select-article)
(let ((mail-header-separator ""))
- (gnus-eval-in-buffer-window
- gnus-article-buffer
- (save-restriction
- (widen)
- (let ((start (window-start)))
- (news-caesar-buffer-body arg)
- (set-window-start (get-buffer-window (current-buffer)) start))))))
+ (gnus-eval-in-buffer-window gnus-article-buffer
+ (save-restriction
+ (widen)
+ (let ((start (window-start))
+ buffer-read-only)
+ (message-caesar-buffer-body arg)
+ (set-window-start (get-buffer-window (current-buffer)) start))))))
(defun gnus-summary-stop-page-breaking ()
"Stop page breaking in the current article."
(interactive)
(gnus-set-global-variables)
(gnus-summary-select-article)
- (gnus-eval-in-buffer-window gnus-article-buffer (widen)))
+ (gnus-eval-in-buffer-window gnus-article-buffer
+ (widen)))
(defun gnus-summary-move-article (&optional n to-newsgroup select-method action)
"Move the current article to a different newsgroup.
articles prefix))
(set (intern (format "gnus-current-%s-group" action)) to-newsgroup))
(setq to-method (or select-method
- (gnus-find-method-for-group to-newsgroup)))
+ (gnus-group-name-to-method to-newsgroup)))
;; Check the method we are to move this article to...
(or (gnus-check-backend-function 'request-accept-article (car to-method))
(error "%s does not support article copying" (car to-method)))
gnus-newsgroup-name)))))
(method
(gnus-completing-read
- methname "What backend do you want to use when? "
+ methname "What backend do you want to use when respooling?"
methods nil t nil 'gnus-method-history))
ms)
(cond
(current-time-string (nth 5 atts))
(current-time-zone now)
(current-time-zone now)) "\n"
- "Message-ID: " (gnus-inews-message-id) "\n"
+ "Message-ID: " (message-make-message-id) "\n"
"Lines: " (int-to-string lines) "\n"
"Chars: " (int-to-string (nth 7 atts)) "\n\n"))
(gnus-request-accept-article group nil t)
(kill-buffer (current-buffer)))))
-(defun gnus-summary-expire-articles ()
+(defun gnus-summary-expire-articles (&optional now)
"Expire all articles that are marked as expirable in the current group."
(interactive)
(gnus-set-global-variables)
(gnus-list-of-read-articles gnus-newsgroup-name)
(setq gnus-newsgroup-expirable
(sort gnus-newsgroup-expirable '<))))
- (expiry-wait (gnus-group-get-parameter
- gnus-newsgroup-name 'expiry-wait))
+ (expiry-wait (if now 'immediate
+ (gnus-group-get-parameter
+ gnus-newsgroup-name 'expiry-wait)))
es)
(when expirable
;; There are expirable articles in this group, so we run them
(gnus-y-or-n-p
"Are you really, really, really sure you want to delete all these messages? ")
(error "Phew!"))
- (let ((nnmail-expiry-wait 'immediate)
- (nnmail-expiry-wait-function nil))
- (gnus-summary-expire-articles)))
+ (gnus-summary-expire-articles t))
;; Suggested by Jack Vinson <vinson@unagi.cis.upenn.edu>.
(defun gnus-summary-delete-article (&optional n)
(if (and gnus-novice-user
(not (gnus-y-or-n-p
(format "Do you really want to delete %s forever? "
- (if (> (length articles) 1) "these articles"
+ (if (> (length articles) 1)
+ (format "these %s articles" (length articles))
"this article")))))
()
;; Delete the articles.
(interactive)
(if (gnus-group-read-only-p)
(progn
- (gnus-summary-edit-article-postpone)
- (gnus-error
- 1 "The current newsgroup does not support article editing."))
+ (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)
(gnus-configure-windows 'summary)
(gnus-summary-update-article (cdr gnus-article-current))
(when gnus-use-cache
- (gnus-cache-update-article
- (cdr gnus-article-current) (car gnus-article-current))))
+ (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)
(pp-eval-expression
(list 'quote (mapcar 'car (nnmail-article-group 'identity)))))))
-;; Summary score commands.
-
-;; Suggested by boubaker@cenatls.cena.dgac.fr.
-
-(defun gnus-summary-raise-score (n)
- "Raise the score of the current article by N."
- (interactive "p")
- (gnus-set-global-variables)
- (gnus-summary-set-score (+ (gnus-summary-article-score) n)))
-
-(defun gnus-summary-set-score (n)
- "Set the score of the current article to N."
- (interactive "p")
- (gnus-set-global-variables)
- (save-excursion
- (gnus-summary-show-thread)
- (let ((buffer-read-only nil))
- ;; Set score.
- (gnus-summary-update-mark
- (if (= n (or gnus-summary-default-score 0)) ?
- (if (< n (or gnus-summary-default-score 0))
- gnus-score-below-mark gnus-score-over-mark)) 'score))
- (let* ((article (gnus-summary-article-number))
- (score (assq article gnus-newsgroup-scored)))
- (if score (setcdr score n)
- (setq gnus-newsgroup-scored
- (cons (cons article n) gnus-newsgroup-scored))))
- (gnus-summary-update-line)))
-
-(defun gnus-summary-current-score ()
- "Return the score of the current article."
- (interactive)
- (gnus-set-global-variables)
- (gnus-message 1 "%s" (gnus-summary-article-score)))
-
;; Summary marking commands.
(defun gnus-summary-kill-same-subject-and-select (&optional unmark)
(defun gnus-summary-mark-forward (n &optional mark no-expire)
"Mark N articles as read forwards.
-If N is negative, mark backwards instead.
-Mark with MARK. If MARK is ? , ?! or ??, articles will be
-marked as unread.
+If N is negative, mark backwards instead. Mark with MARK, ?r by default.
The difference between N and the actual number of articles marked is
returned."
(interactive "p")
(defun gnus-summary-mark-article-as-unread (mark)
"Mark the current article quickly as unread with MARK."
(let ((article (gnus-summary-article-number)))
- (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-reads (delq article gnus-newsgroup-reads))
- (cond ((= mark gnus-ticked-mark)
- (push article gnus-newsgroup-marked))
- ((= mark gnus-dormant-mark)
- (push article gnus-newsgroup-dormant))
- (t
- (push article gnus-newsgroup-unreads)))
- (setq gnus-newsgroup-reads
- (delq (assq article gnus-newsgroup-reads)
- gnus-newsgroup-reads))
-
- ;; See whether the article is to be put in the cache.
- (and gnus-use-cache
- (vectorp (gnus-summary-article-header article))
- (save-excursion
- (gnus-cache-possibly-enter-article
- gnus-newsgroup-name article
- (gnus-summary-article-header article)
- (= mark gnus-ticked-mark)
- (= mark gnus-dormant-mark) (= mark gnus-unread-mark))))
-
- ;; Fix the mark.
- (gnus-summary-update-mark mark 'unread)
+ (if (< article 0)
+ (gnus-error 1 "Unmarkable article")
+ (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-reads (delq article gnus-newsgroup-reads))
+ (cond ((= mark gnus-ticked-mark)
+ (push article gnus-newsgroup-marked))
+ ((= mark gnus-dormant-mark)
+ (push article gnus-newsgroup-dormant))
+ (t
+ (push article gnus-newsgroup-unreads)))
+ (setq gnus-newsgroup-reads
+ (delq (assq article gnus-newsgroup-reads)
+ gnus-newsgroup-reads))
+
+ ;; See whether the article is to be put in the cache.
+ (and gnus-use-cache
+ (vectorp (gnus-summary-article-header article))
+ (save-excursion
+ (gnus-cache-possibly-enter-article
+ gnus-newsgroup-name article
+ (gnus-summary-article-header article)
+ (= mark gnus-ticked-mark)
+ (= mark gnus-dormant-mark) (= mark gnus-unread-mark))))
+
+ ;; Fix the mark.
+ (gnus-summary-update-mark mark 'unread))
t))
(defun gnus-summary-mark-article (&optional article mark no-expire)
;; Suggested by Daniel Quinlan <quinlan@best.com>.
(defalias 'gnus-summary-show-all-expunged 'gnus-summary-limit-include-expunged)
-(defun gnus-summary-limit-include-expunged ()
+(defun gnus-summary-limit-include-expunged (&optional no-error)
"Display all the hidden articles that were expunged for low scores."
(interactive)
(gnus-set-global-variables)
(< (cdar scored) gnus-summary-expunge-below)
(setq headers (cons h headers))))
(setq scored (cdr scored)))
- (or headers (error "No expunged articles hidden."))
- (goto-char (point-min))
- (gnus-summary-prepare-unthreaded (nreverse headers)))
- (goto-char (point-min))
- (gnus-summary-position-point)))
+ (if (not headers)
+ (when (not no-error)
+ (error "No expunged articles hidden."))
+ (goto-char (point-min))
+ (gnus-summary-prepare-unthreaded (nreverse headers))
+ (goto-char (point-min))
+ (gnus-summary-position-point)
+ t))))
(defun gnus-summary-catchup (&optional all quietly to-here not-mark)
"Mark all articles not marked as unread in this newsgroup as read.
(interactive "P")
(gnus-set-global-variables)
(save-excursion
- (let ((beg (point)))
- ;; We check that there are unread articles.
- (when (or all (gnus-summary-find-prev))
- (gnus-summary-catchup all t beg))))
+ (gnus-save-hidden-threads
+ (let ((beg (point)))
+ ;; We check that there are unread articles.
+ (when (or all (gnus-summary-find-prev))
+ (gnus-summary-catchup all t beg)))))
(gnus-summary-position-point))
(defun gnus-summary-catchup-all (&optional quietly)
(> (prefix-numeric-value arg) 0)))
(gnus-summary-prepare)
(gnus-summary-goto-subject current)
+ (gnus-message 6 "Threading is now %s" (if gnus-show-threads "on" "off"))
(gnus-summary-position-point)))
(defun gnus-summary-show-all-threads ()
If the prefix argument is negative, tick articles instead."
(interactive "P")
(gnus-set-global-variables)
- (if unmark
- (setq unmark (prefix-numeric-value unmark)))
+ (when unmark
+ (setq unmark (prefix-numeric-value unmark)))
(let ((articles (gnus-summary-articles-in-thread)))
(save-excursion
;; Expand the thread.
(defun gnus-sortable-date (date)
"Make sortable string by string-lessp from DATE.
Timezone package is used."
- (let* ((date (timezone-fix-time date nil nil)) ;[Y M D H M S]
- (year (aref date 0))
- (month (aref date 1))
- (day (aref date 2)))
- (timezone-make-sortable-date
- year month day
- (timezone-make-time-string
- (aref date 3) (aref date 4) (aref date 5)))))
-
+ (condition-case ()
+ (progn
+ (setq date (inline (timezone-fix-time
+ date nil
+ (aref (inline (timezone-parse-date date)) 4))))
+ (inline
+ (timezone-make-sortable-date
+ (aref date 0) (aref date 1) (aref date 2)
+ (inline
+ (timezone-make-time-string
+ (aref date 3) (aref date 4) (aref date 5))))))
+ (error "")))
+
;; Summary saving commands.
(defun gnus-summary-save-article (&optional n not-saved)
(interactive "P")
(gnus-set-global-variables)
(let ((articles (gnus-summary-work-articles n))
+ (save-buffer (save-excursion
+ (nnheader-set-temp-buffer " *Gnus Save*")))
file header article)
(while articles
(setq header (gnus-summary-article-header
;; This is a real article.
(save-window-excursion
(gnus-summary-select-article t nil nil article))
+ (save-excursion
+ (set-buffer save-buffer)
+ (erase-buffer)
+ (insert-buffer-substring gnus-original-article-buffer))
(unless gnus-save-all-headers
;; Remove headers accoring to `gnus-saved-headers'.
(let ((gnus-visible-headers
- (or gnus-saved-headers gnus-visible-headers)))
- (gnus-article-hide-headers nil t)))
- ;; Remove any X-Gnus lines.
- (save-excursion
- (set-buffer gnus-article-buffer)
- (save-restriction
- (let ((buffer-read-only nil))
- (nnheader-narrow-to-headers)
- (while (re-search-forward "^X-Gnus" nil t)
- (gnus-delete-line)))))
+ (or gnus-saved-headers gnus-visible-headers))
+ (gnus-article-buffer save-buffer))
+ (gnus-article-hide-headers 1 t)))
(save-window-excursion
(if (not gnus-default-article-saver)
(error "No default saver is defined.")
- (setq file (funcall
- gnus-default-article-saver
- (cond
- ((not gnus-prompt-before-saving)
- 'default)
- ((eq gnus-prompt-before-saving 'always)
- nil)
- (t file))))))
+ ;; !!! Magic! The saving functions all save
+ ;; `gnus-original-article-buffer' (or so they think),
+ ;; but we bind that variable to our save-buffer.
+ (set-buffer gnus-article-buffer)
+ (let ((gnus-original-article-buffer save-buffer))
+ (set-buffer gnus-summary-buffer)
+ (setq file (funcall
+ gnus-default-article-saver
+ (cond
+ ((not gnus-prompt-before-saving)
+ 'default)
+ ((eq gnus-prompt-before-saving 'always)
+ nil)
+ (t file)))))))
(gnus-summary-remove-process-mark article)
(unless not-saved
(gnus-summary-set-saved-mark article))))
+ (gnus-kill-buffer save-buffer)
(gnus-summary-position-point)
n))
(defun gnus-read-move-group-name (prompt default articles prefix)
"Read a group name."
(let* ((split-name (gnus-get-split-value gnus-move-split-methods))
+ (minibuffer-confirm-incomplete nil) ; XEmacs
group-map
(dum (mapatoms
(lambda (g)
(setq to-newsgroup (or default "")))
(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
+ to-newsgroup (gnus-group-name-to-method to-newsgroup))
+ (gnus-activate-group to-newsgroup nil nil
+ (gnus-group-name-to-method
+ to-newsgroup)))
+ (error "Couldn't create group %s" to-newsgroup)))
(error "No such group: %s" to-newsgroup)))
to-newsgroup))
default-name))
;; A single split name was found
((= 1 (length split-name))
- (read-file-name
- (concat prompt " (default " (car split-name) ") ")
- gnus-article-save-directory
- (concat gnus-article-save-directory (car split-name))))
+ (let* ((name (car split-name))
+ (dir (cond ((file-directory-p name)
+ (file-name-as-directory name))
+ ((file-exists-p name) name)
+ (t gnus-article-save-directory))))
+ (read-file-name
+ (concat prompt " (default " name ") ")
+ dir name)))
;; A list of splits was found.
(t
(setq split-name (nreverse split-name))
(defun gnus-summary-save-in-rmail (&optional filename)
"Append this article to Rmail file.
Optional argument FILENAME specifies file name.
-Directory to save to is default to `gnus-article-save-directory' which
-is initialized from the SAVEDIR environment variable."
+Directory to save to is default to `gnus-article-save-directory'."
(interactive)
(gnus-set-global-variables)
(let ((default-name
(t (gnus-read-save-file-name
"Save in rmail file:" default-name))))
(gnus-make-directory (file-name-directory filename))
- (gnus-eval-in-buffer-window
- gnus-original-article-buffer
- (save-excursion
- (save-restriction
- (widen)
- (gnus-output-to-rmail filename))))
+ (gnus-eval-in-buffer-window gnus-original-article-buffer
+ (save-excursion
+ (save-restriction
+ (widen)
+ (gnus-output-to-rmail filename))))
;; Remember the directory name to save articles
(setq gnus-newsgroup-last-rmail filename)))
(defun gnus-summary-save-in-mail (&optional filename)
"Append this article to Unix mail file.
Optional argument FILENAME specifies file name.
-Directory to save to is default to `gnus-article-save-directory' which
-is initialized from the SAVEDIR environment variable."
+Directory to save to is default to `gnus-article-save-directory'."
(interactive)
(gnus-set-global-variables)
(let ((default-name
(and default-name
(file-name-directory default-name))))
(gnus-make-directory (file-name-directory filename))
- (gnus-eval-in-buffer-window
- gnus-original-article-buffer
- (save-excursion
- (save-restriction
- (widen)
- (if (and (file-readable-p filename) (mail-file-babyl-p filename))
- (gnus-output-to-rmail filename)
- (let ((mail-use-rfc822 t))
- (rmail-output filename 1 t t))))))
+ (gnus-eval-in-buffer-window gnus-original-article-buffer
+ (save-excursion
+ (save-restriction
+ (widen)
+ (if (and (file-readable-p filename) (mail-file-babyl-p filename))
+ (gnus-output-to-rmail filename)
+ (let ((mail-use-rfc822 t))
+ (rmail-output filename 1 t t))))))
;; Remember the directory name to save articles.
(setq gnus-newsgroup-last-mail filename)))
(defun gnus-summary-save-in-file (&optional filename)
"Append this article to file.
Optional argument FILENAME specifies file name.
-Directory to save to is default to `gnus-article-save-directory' which
-is initialized from the SAVEDIR environment variable."
+Directory to save to is default to `gnus-article-save-directory'."
(interactive)
(gnus-set-global-variables)
(let ((default-name
(t (gnus-read-save-file-name
"Save in file:" default-name))))
(gnus-make-directory (file-name-directory filename))
- (gnus-eval-in-buffer-window
- gnus-original-article-buffer
- (save-excursion
- (save-restriction
- (widen)
- (gnus-output-to-file filename))))
+ (gnus-eval-in-buffer-window gnus-original-article-buffer
+ (save-excursion
+ (save-restriction
+ (widen)
+ (gnus-output-to-file filename))))
;; Remember the directory name to save articles.
(setq gnus-newsgroup-last-file filename)))
(defun gnus-summary-save-body-in-file (&optional filename)
"Append this article body to a file.
Optional argument FILENAME specifies file name.
-The directory to save in defaults to `gnus-article-save-directory' which
-is initialized from the SAVEDIR environment variable."
+The directory to save in defaults to `gnus-article-save-directory'."
(interactive)
(gnus-set-global-variables)
(let ((default-name
(t (gnus-read-save-file-name
"Save body in file:" default-name))))
(gnus-make-directory (file-name-directory filename))
- (gnus-eval-in-buffer-window
- gnus-article-buffer
- (save-excursion
- (save-restriction
- (widen)
- (goto-char (point-min))
- (and (search-forward "\n\n" nil t)
- (narrow-to-region (point) (point-max)))
- (gnus-output-to-file filename))))
+ (gnus-eval-in-buffer-window gnus-original-article-buffer
+ (save-excursion
+ (save-restriction
+ (widen)
+ (goto-char (point-min))
+ (and (search-forward "\n\n" nil t)
+ (narrow-to-region (point) (point-max)))
+ (gnus-output-to-file filename))))
;; Remember the directory name to save articles.
(setq gnus-newsgroup-last-file filename)))
gnus-last-shell-command))))
(if (string-equal command "")
(setq command gnus-last-shell-command))
- (gnus-eval-in-buffer-window
- gnus-article-buffer
- (save-restriction
- (widen)
- (shell-command-on-region (point-min) (point-max) command nil)))
+ (gnus-eval-in-buffer-window gnus-article-buffer
+ (save-restriction
+ (widen)
+ (shell-command-on-region (point-min) (point-max) command nil)))
(setq gnus-last-shell-command command))
;; Summary extract commands
": " (or (cdr (assq 'execute (car pslist))) "") "\n")
(setq e (point))
(forward-line -1) ; back to `b'
- (add-text-properties
- b e (list 'gnus-number gnus-reffed-article-number
- gnus-mouse-face-prop gnus-mouse-face))
+ (gnus-add-text-properties
+ b (1- e) (list 'gnus-number gnus-reffed-article-number
+ gnus-mouse-face-prop gnus-mouse-face))
(gnus-data-enter
after-article gnus-reffed-article-number
gnus-unread-mark b (car pslist) 0 (- e b))
(erase-buffer)
(insert "$ " command "\n\n")
(if gnus-view-pseudo-asynchronously
- (start-process "gnus-execute" nil "sh" "-c" command)
- (call-process "sh" nil t nil "-c" command)))))
+ (start-process "gnus-execute" nil shell-file-name
+ shell-command-switch command)
+ (call-process shell-file-name nil t nil
+ shell-command-switch command)))))
(defun gnus-copy-file (file &optional to)
"Copy FILE to TO."
"\r" gnus-article-press-button
"\t" gnus-article-next-button
"\M-\t" gnus-article-prev-button
+ "<" beginning-of-buffer
+ ">" end-of-buffer
+ "\C-c\C-i" gnus-info-find-node
"\C-c\C-b" gnus-bug)
(substitute-key-definition
(set-buffer (get-buffer-create gnus-original-article-buffer))
(buffer-disable-undo (current-buffer))
(setq major-mode 'gnus-original-article-mode)
+ (gnus-add-current-to-buffer-list)
(make-local-variable 'gnus-original-article))
(if (get-buffer name)
(save-excursion
;; from the head of the article.
(defun gnus-article-set-window-start (&optional line)
(set-window-start
- (get-buffer-window gnus-article-buffer)
+ (get-buffer-window gnus-article-buffer t)
(save-excursion
(set-buffer gnus-article-buffer)
(goto-char (point-min))
;; Take the article from the original article buffer
;; and place it in the buffer it's supposed to be in.
(when (and (get-buffer gnus-article-buffer)
- (numberp article)
+ ;;(numberp article)
(equal (buffer-name (current-buffer))
(buffer-name (get-buffer gnus-article-buffer))))
(save-excursion
;; We have found the header.
header
;; We have to really fetch the header to this article.
- (when (setq where
- (if (gnus-check-backend-function 'request-head group)
- (gnus-request-head id group)
- (gnus-request-article id group)))
+ (when (setq where (gnus-request-head id group))
(save-excursion
(set-buffer nntp-server-buffer)
- (and (search-forward "\n\n" nil t)
- (delete-region (1- (point)) (point-max)))
(goto-char (point-max))
(insert ".\n")
(goto-char (point-min))
;; numbers for this article.
(mail-header-set-number header gnus-reffed-article-number))
(decf gnus-reffed-article-number)
+ (gnus-remove-header (mail-header-number header))
(push header gnus-newsgroup-headers)
(setq gnus-current-headers header)
(push (mail-header-number header) gnus-newsgroup-limit))
header)))))
+(defun gnus-remove-header (number)
+ "Remove header NUMBER from `gnus-newsgroup-headers'."
+ (if (and gnus-newsgroup-headers
+ (= number (mail-header-number (car gnus-newsgroup-headers))))
+ (pop gnus-newsgroup-headers)
+ (let ((headers gnus-newsgroup-headers))
+ (while (and (cdr headers)
+ (not (= number (mail-header-number (cadr headers)))))
+ (pop headers))
+ (when (cdr headers)
+ (setcdr headers (cddr headers))))))
+
(defun gnus-article-prepare (article &optional all-headers header)
"Prepare ARTICLE in article mode buffer.
ARTICLE should either be an article number or a Message-ID.
"Toggle whether to hide unwanted headers and possibly sort them as well.
If given a negative prefix, always show; if given a positive prefix,
always hide."
- (interactive "P")
- (unless (gnus-article-check-hidden-text 'headers arg)
+ (interactive (gnus-hidden-arg))
+ (if (gnus-article-check-hidden-text 'headers arg)
+ ;; Show boring headers as well.
+ (gnus-article-show-hidden-text 'boring-headers)
;; This function might be inhibited.
(unless gnus-inhibit-hiding
(save-excursion
((and gnus-visible-headers
(listp gnus-visible-headers))
(mapconcat 'identity gnus-visible-headers "\\|"))))
+ (inhibit-point-motion-hooks t)
want-list beg)
;; First we narrow to just the headers.
(widen)
(while (looking-at "From ")
(forward-line 1))
(unless (bobp)
- (gnus-hide-text (point-min) (point) props))
+ (if delete
+ (delete-region (point-min) (point))
+ (gnus-hide-text (point-min) (point) props)))
;; Then treat the rest of the header lines.
(narrow-to-region
(point)
(beginning-of-line)
;; We add the headers we want to keep to a list and delete
;; them from the buffer.
- (put-text-property
+ (gnus-put-text-property
(point) (1+ (point)) 'message-rank
(if (or (and visible (looking-at visible))
(and ignored
(if delete
(delete-region beg (point-max))
;; Suggested by Sudish Joseph <joseph@cis.ohio-state.edu>.
- (gnus-hide-text-type beg (point-max) 'headers)))))))))
+ (gnus-hide-text-type beg (point-max) 'headers))
+ ;; Work around XEmacs lossage.
+ (gnus-put-text-property (point-min) beg 'invisible nil))))))))
(defun gnus-article-hide-boring-headers (&optional arg)
"Toggle hiding of headers that aren't very interesting.
If given a negative prefix, always show; if given a positive prefix,
always hide."
- (interactive "P")
+ (interactive (gnus-hidden-arg))
(unless (gnus-article-check-hidden-text 'boring-headers arg)
(save-excursion
(set-buffer gnus-article-buffer)
'boring-headers)))
;; Hide boring Newsgroups header.
((eq elem 'newsgroups)
- (when (equal (mail-fetch-field "newsgroups")
+ (when (equal (message-fetch-field "newsgroups")
(gnus-group-real-name gnus-newsgroup-name))
(gnus-article-hide-header "newsgroups")))
((eq elem 'followup-to)
- (when (equal (mail-fetch-field "followup-to")
- (mail-fetch-field "newsgroups"))
+ (when (equal (message-fetch-field "followup-to")
+ (message-fetch-field "newsgroups"))
(gnus-article-hide-header "followup-to")))
((eq elem 'reply-to)
- (let ((from (mail-fetch-field "from"))
- (reply-to (mail-fetch-field "reply-to")))
+ (let ((from (message-fetch-field "from"))
+ (reply-to (message-fetch-field "reply-to")))
(when (and
from reply-to
(equal
reply-to))))
(gnus-article-hide-header "reply-to"))))
((eq elem 'date)
- (let ((date (mail-fetch-field "date")))
+ (let ((date (message-fetch-field "date")))
(when (and date
(< (gnus-days-between date (current-time-string))
4))
(while (search-forward "\b" nil t)
(let ((next (following-char))
(previous (char-after (- (point) 2))))
- (cond ((eq next previous)
- (put-text-property (- (point) 2) (point) 'invisible t)
- (put-text-property (point) (1+ (point)) 'face 'bold))
- ((eq next ?_)
- (put-text-property (1- (point)) (1+ (point)) 'invisible t)
- (put-text-property
- (- (point) 2) (1- (point)) 'face 'underline))
- ((eq previous ?_)
- (put-text-property (- (point) 2) (point) 'invisible t)
- (put-text-property
- (point) (1+ (point)) 'face 'underline))))))))
+ (cond
+ ((eq next previous)
+ (gnus-put-text-property (- (point) 2) (point) 'invisible t)
+ (gnus-put-text-property (point) (1+ (point)) 'face 'bold))
+ ((eq next ?_)
+ (gnus-put-text-property (1- (point)) (1+ (point)) 'invisible t)
+ (gnus-put-text-property
+ (- (point) 2) (1- (point)) 'face 'underline))
+ ((eq previous ?_)
+ (gnus-put-text-property (- (point) 2) (point) 'invisible t)
+ (gnus-put-text-property
+ (point) (1+ (point)) 'face 'underline))))))))
(defun gnus-article-word-wrap ()
"Format too long lines."
from)
(save-restriction
(nnheader-narrow-to-headers)
- (setq from (mail-fetch-field "from"))
+ (setq from (message-fetch-field "from"))
(goto-char (point-min))
(when (and gnus-article-x-face-command
(or force
(let ((process-connection-type nil))
(process-kill-without-query
(start-process
- "gnus-x-face" nil "sh" "-c" gnus-article-x-face-command))
+ "gnus-x-face" nil shell-file-name shell-command-switch
+ gnus-article-x-face-command))
(process-send-region "gnus-x-face" beg end)
(process-send-eof "gnus-x-face")))))))))
-(defun gnus-headers-decode-quoted-printable ()
+(defalias 'gnus-headers-decode-quoted-printable 'gnus-decode-rfc1522)
+(defun gnus-decode-rfc1522 ()
"Hack to remove QP encoding from headers."
(let ((case-fold-search t)
(inhibit-point-motion-hooks t)
(buffer-read-only nil)
string)
- (goto-char (point-min))
- (while (re-search-forward "=\\?iso-8859-1\\?q\\?\\([^?\t\n]*\\)\\?=" nil t)
- (setq string (match-string 1))
- (narrow-to-region (match-beginning 0) (match-end 0))
- (delete-region (point-min) (point-max))
- (insert string)
- (gnus-mime-decode-quoted-printable (goto-char (point-min)) (point-max))
- (subst-char-in-region (point-min) (point-max) ?_ ? )
- (widen)
- (goto-char (point-min)))))
+ (save-restriction
+ (narrow-to-region
+ (goto-char (point-min))
+ (or (search-forward "\n\n" nil t) (point-max)))
+
+ (goto-char (point-min))
+ (while (re-search-forward
+ "=\\?iso-8859-1\\?q\\?\\([^?\t\n]*\\)\\?=" nil t)
+ (setq string (match-string 1))
+ (narrow-to-region (match-beginning 0) (match-end 0))
+ (delete-region (point-min) (point-max))
+ (insert string)
+ (gnus-mime-decode-quoted-printable (goto-char (point-min)) (point-max))
+ (subst-char-in-region (point-min) (point-max) ?_ ? )
+ (widen)
+ (goto-char (point-min))))))
(defun gnus-article-de-quoted-unreadable (&optional force)
"Do a naive translation of a quoted-printable-encoded article.
(let ((case-fold-search t)
(buffer-read-only nil)
(type (gnus-fetch-field "content-transfer-encoding")))
- (gnus-headers-decode-quoted-printable)
+ (gnus-decode-rfc1522)
(when (or force
(and type (string-match "quoted-printable" (downcase type))))
(goto-char (point-min))
"Toggle hiding of any PGP headers and signatures in the current article.
If given a negative prefix, always show; if given a positive prefix,
always hide."
- (interactive "P")
+ (interactive (gnus-hidden-arg))
(unless (gnus-article-check-hidden-text 'pgp arg)
(save-excursion
(set-buffer gnus-article-buffer)
(gnus-hide-text (match-beginning 0) (match-end 0) props))
(widen))))))
+(defun gnus-article-hide-pem (&optional arg)
+ "Toggle hiding of any PEM headers and signatures in the current article.
+If given a negative prefix, always show; if given a positive prefix,
+always hide."
+ (interactive (gnus-hidden-arg))
+ (unless (gnus-article-check-hidden-text 'pem arg)
+ (save-excursion
+ (set-buffer gnus-article-buffer)
+ (let ((props (nconc (list 'gnus-type 'pem) gnus-hidden-properties))
+ buffer-read-only end)
+ (widen)
+ (goto-char (point-min))
+ ;; hide the horrendously ugly "header".
+ (and (search-forward "\n-----BEGIN PRIVACY-ENHANCED MESSAGE-----\n"
+ nil
+ t)
+ (setq end (1+ (match-beginning 0)))
+ (gnus-hide-text
+ end
+ (if (search-forward "\n\n" nil t)
+ (match-end 0)
+ (point-max))
+ props))
+ ;; hide the trailer as well
+ (and (search-forward "\n-----END PRIVACY-ENHANCED MESSAGE-----\n"
+ nil
+ t)
+ (gnus-hide-text (match-beginning 0) (match-end 0) props))))))
+
(defun gnus-article-hide-signature (&optional arg)
"Hide the signature in the current article.
If given a negative prefix, always show; if given a positive prefix,
always hide."
- (interactive "P")
+ (interactive (gnus-hidden-arg))
(unless (gnus-article-check-hidden-text 'signature arg)
(save-excursion
(set-buffer gnus-article-buffer)
(while (looking-at "[ \t]$")
(gnus-delete-line))))))
+(defvar mime::preview/content-list)
+(defvar mime::preview-content-info/point-min)
(defun gnus-narrow-to-signature ()
"Narrow to the signature."
(widen)
+ (if (and (boundp 'mime::preview/content-list)
+ mime::preview/content-list)
+ (let ((pcinfo (car (last mime::preview/content-list))))
+ (condition-case ()
+ (narrow-to-region
+ (funcall (intern "mime::preview-content-info/point-min") pcinfo)
+ (point-max))
+ (error nil))))
(goto-char (point-max))
(when (re-search-backward gnus-signature-separator nil t)
(forward-line 1)
(narrow-to-region (point) (point-max))
t)))
+(defun gnus-hidden-arg ()
+ "Return the current prefix arg as a number, or 0 if no prefix."
+ (list (if current-prefix-arg
+ (prefix-numeric-value current-prefix-arg)
+ 0)))
+
(defun gnus-article-check-hidden-text (type arg)
- "Return nil if hiding is necessary."
+ "Return nil if hiding is necessary.
+Arg can be nil or a number. Nil and positive means hide, negative
+means show, 0 means toggle."
(save-excursion
(set-buffer gnus-article-buffer)
(let ((hide (gnus-article-hidden-text-p type)))
- (cond ((or (and (null arg) (eq hide 'hidden))
- (and arg (< 0 (prefix-numeric-value arg))))
- (gnus-article-show-hidden-text type))
- ((eq hide 'shown)
- (gnus-article-show-hidden-text type t))
- (t nil)))))
+ (cond
+ ((or (null arg)
+ (> arg 0))
+ nil)
+ ((< arg 0)
+ (gnus-article-show-hidden-text type))
+ (t
+ (if (eq hide 'hidden)
+ (gnus-article-show-hidden-text type)
+ nil))))))
(defun gnus-article-hidden-text-p (type)
"Say whether the current buffer contains hidden text of type TYPE."
(message-remove-header date-regexp t)
(beginning-of-line))
(goto-char (point-max)))
- (insert
- (cond
- ;; Convert to the local timezone. We have to slap a
- ;; `condition-case' round the calls to the timezone
- ;; functions since they aren't particularly resistant to
- ;; buggy dates.
- ((eq type 'local)
- (concat "Date: " (condition-case ()
- (timezone-make-date-arpa-standard date)
- (error date))
- "\n"))
- ;; Convert to Universal Time.
- ((eq type 'ut)
- (concat "Date: "
- (condition-case ()
- (timezone-make-date-arpa-standard date nil "UT")
- (error date))
- "\n"))
- ;; Get the original date from the article.
- ((eq type 'original)
- (concat "Date: " date "\n"))
- ;; Do an X-Sent lapsed format.
- ((eq type 'lapsed)
- ;; If the date is seriously mangled, the timezone
- ;; functions are liable to bug out, so we condition-case
- ;; the entire thing.
- (let* ((real-time
- (condition-case ()
- (gnus-time-minus
- (gnus-encode-date
- (timezone-make-date-arpa-standard
- (current-time-string now)
- (current-time-zone now) "UT"))
- (gnus-encode-date
- (timezone-make-date-arpa-standard
- date nil "UT")))
- (error '(0 0))))
- (real-sec (+ (* (float (car real-time)) 65536)
- (cadr real-time)))
- (sec (abs real-sec))
- num prev)
- (if (zerop sec)
- "X-Sent: Now\n"
- (concat
- "X-Sent: "
- ;; This is a bit convoluted, but basically we go
- ;; through the time units for years, weeks, etc,
- ;; and divide things to see whether that results
- ;; in positive answers.
- (mapconcat
- (lambda (unit)
- (if (zerop (setq num (ffloor (/ sec (cdr unit)))))
- ;; The (remaining) seconds are too few to
- ;; be divided into this time unit.
- ""
- ;; It's big enough, so we output it.
- (setq sec (- sec (* num (cdr unit))))
- (prog1
- (concat (if prev ", " "") (int-to-string
- (floor num))
- " " (symbol-name (car unit))
- (if (> num 1) "s" ""))
- (setq prev t))))
- gnus-article-time-units "")
- ;; If dates are odd, then it might appear like the
- ;; article was sent in the future.
- (if (> real-sec 0)
- " ago\n"
- " in the future\n")))))
- (t
- (error "Unknown conversion type: %s" type))))
+ (insert (gnus-make-date-line date type))
;; Do highlighting.
(forward-line -1)
(when (and (gnus-visual-p 'article-highlight 'highlight)
(looking-at "\\([^:]+\\): *\\(.*\\)$"))
- (put-text-property (match-beginning 1) (match-end 1)
+ (gnus-put-text-property (match-beginning 1) (match-end 1)
'face bface)
- (put-text-property (match-beginning 2) (match-end 2)
+ (gnus-put-text-property (match-beginning 2) (match-end 2)
'face eface))))))))
+(defun gnus-make-date-line (date type)
+ "Return a DATE line of TYPE."
+ (cond
+ ;; Convert to the local timezone. We have to slap a
+ ;; `condition-case' round the calls to the timezone
+ ;; functions since they aren't particularly resistant to
+ ;; buggy dates.
+ ((eq type 'local)
+ (concat "Date: " (condition-case ()
+ (timezone-make-date-arpa-standard date)
+ (error date))
+ "\n"))
+ ;; Convert to Universal Time.
+ ((eq type 'ut)
+ (concat "Date: "
+ (condition-case ()
+ (timezone-make-date-arpa-standard date nil "UT")
+ (error date))
+ "\n"))
+ ;; Get the original date from the article.
+ ((eq type 'original)
+ (concat "Date: " date "\n"))
+ ;; Do an X-Sent lapsed format.
+ ((eq type 'lapsed)
+ ;; If the date is seriously mangled, the timezone
+ ;; functions are liable to bug out, so we condition-case
+ ;; the entire thing.
+ (let* ((now (current-time))
+ (real-time
+ (condition-case ()
+ (gnus-time-minus
+ (gnus-encode-date
+ (timezone-make-date-arpa-standard
+ (current-time-string now)
+ (current-time-zone now) "UT"))
+ (gnus-encode-date
+ (timezone-make-date-arpa-standard
+ date nil "UT")))
+ (error '(0 0))))
+ (real-sec (+ (* (float (car real-time)) 65536)
+ (cadr real-time)))
+ (sec (abs real-sec))
+ num prev)
+ (cond
+ ((equal real-time '(0 0))
+ "X-Sent: Unknown\n")
+ ((zerop sec)
+ "X-Sent: Now\n")
+ (t
+ (concat
+ "X-Sent: "
+ ;; This is a bit convoluted, but basically we go
+ ;; through the time units for years, weeks, etc,
+ ;; and divide things to see whether that results
+ ;; in positive answers.
+ (mapconcat
+ (lambda (unit)
+ (if (zerop (setq num (ffloor (/ sec (cdr unit)))))
+ ;; The (remaining) seconds are too few to
+ ;; be divided into this time unit.
+ ""
+ ;; It's big enough, so we output it.
+ (setq sec (- sec (* num (cdr unit))))
+ (prog1
+ (concat (if prev ", " "") (int-to-string
+ (floor num))
+ " " (symbol-name (car unit))
+ (if (> num 1) "s" ""))
+ (setq prev t))))
+ gnus-article-time-units "")
+ ;; If dates are odd, then it might appear like the
+ ;; article was sent in the future.
+ (if (> real-sec 0)
+ " ago\n"
+ " in the future\n"))))))
+ (t
+ (error "Unknown conversion type: %s" type))))
+
(defun gnus-article-date-local (&optional highlight)
"Convert the current article date to the local timezone."
(interactive (list t))
(if (gnus-visual-p 'article-highlight 'highlight)
(gnus-article-highlight-some)))
-;; Article savers.
+;;; Article savers.
(defun gnus-output-to-rmail (file-name)
"Append the current article to an Rmail file named FILE-NAME."
(defun gnus-output-to-file (file-name)
"Append the current article to a file named FILE-NAME."
- (setq file-name (expand-file-name file-name))
- (let ((artbuf (current-buffer))
- (tmpbuf (get-buffer-create " *Gnus-output*")))
- (save-excursion
- (set-buffer tmpbuf)
- (buffer-disable-undo (current-buffer))
- (erase-buffer)
+ (let ((artbuf (current-buffer)))
+ (nnheader-temp-write nil
(insert-buffer-substring artbuf)
;; Append newline at end of the buffer as separator, and then
;; save it to file.
(goto-char (point-max))
(insert "\n")
- (append-to-file (point-min) (point-max) file-name))
- (kill-buffer tmpbuf)))
+ (append-to-file (point-min) (point-max) file-name))))
(defun gnus-convert-article-to-rmail ()
"Convert article in current buffer to Rmail message format."
"Describe article mode commands briefly."
(interactive)
(gnus-message 6
- (substitute-command-keys "\\<gnus-article-mode-map>\\[gnus-article-next-page]:Next page \\[gnus-article-prev-page]:Prev page \\[gnus-article-show-summary]:Show summary \\[gnus-info-find-node]:Run Info \\[gnus-article-describe-briefly]:This help")))
+ (substitute-command-keys "\\<gnus-article-mode-map>\\[gnus-article-goto-next-page]:Next page \\[gnus-article-goto-prev-page]:Prev page \\[gnus-article-show-summary]:Show summary \\[gnus-info-find-node]:Run Info \\[gnus-article-describe-briefly]:This help")))
(defun gnus-article-summary-command ()
"Execute the last keystroke in the summary buffer."
(let ((nosaves
'("q" "Q" "c" "r" "R" "\C-c\C-f" "m" "a" "f" "F"
"Zc" "ZC" "ZE" "ZQ" "ZZ" "Zn" "ZR" "ZG" "ZN" "ZP"
- "=" "^" "\M-^"))
+ "=" "^" "\M-^" "|"))
+ (nosave-but-article
+ '("A\r"))
keys)
(save-excursion
(set-buffer gnus-summary-buffer)
(setq keys (read-key-sequence nil)))
(message "")
- (if (member keys nosaves)
+ (if (or (member keys nosaves)
+ (member keys nosave-but-article))
(let (func)
- (pop-to-buffer gnus-summary-buffer 'norecord)
- (if (setq func (lookup-key (current-local-map) keys))
- (call-interactively func)
- (ding)))
+ (save-window-excursion
+ (pop-to-buffer gnus-summary-buffer 'norecord)
+ (setq func (lookup-key (current-local-map) keys)))
+ (if (not func)
+ (ding)
+ (set-buffer gnus-summary-buffer)
+ (call-interactively func))
+ (when (member keys nosave-but-article)
+ (pop-to-buffer gnus-article-buffer 'norecord)))
(let ((obuf (current-buffer))
(owin (current-window-configuration))
(opoint (point))
((or (null newsgroup)
(string-equal newsgroup ""))
(expand-file-name gnus-kill-file-name
- (or gnus-kill-files-directory "~/News")))
+ gnus-kill-files-directory))
;; Append ".KILL" to newsgroup name.
((gnus-use-long-file-name 'not-kill)
(expand-file-name (concat (gnus-newsgroup-savable-name newsgroup)
"." gnus-kill-file-name)
- (or gnus-kill-files-directory "~/News")))
+ gnus-kill-files-directory))
;; Place "KILL" under the hierarchical directory.
(t
(expand-file-name (concat (gnus-newsgroup-directory-form newsgroup)
"/" gnus-kill-file-name)
- (or gnus-kill-files-directory "~/News")))))
+ gnus-kill-files-directory))))
\f
;;;
(set-buffer gnus-dribble-buffer)
(insert string "\n")
(set-window-point (get-buffer-window (current-buffer)) (point-max))
+ (bury-buffer gnus-dribble-buffer)
(set-buffer obuf))))
(defun gnus-dribble-read-file ()
(bury-buffer (current-buffer))
(set-buffer-modified-p nil)
(let ((auto (make-auto-save-file-name))
- (gnus-dribble-ignore t))
+ (gnus-dribble-ignore t)
+ modes)
(when (or (file-exists-p auto) (file-exists-p dribble-file))
;; Load whichever file is newest -- the auto save file
;; or the "real" file.
(set-buffer-modified-p t))
;; Set the file modes to reflect the .newsrc file modes.
(save-buffer)
- (when (file-exists-p gnus-current-startup-file)
- (set-file-modes dribble-file
- (file-modes gnus-current-startup-file)))
+ (when (and (file-exists-p gnus-current-startup-file)
+ (setq modes (file-modes gnus-current-startup-file)))
+ (set-file-modes dribble-file modes))
;; Possibly eval the file later.
(when (gnus-y-or-n-p
"Auto-save file exists. Do you want to read it? ")
(setq gnus-dribble-eval-file t)))))))
(defun gnus-dribble-eval-file ()
- (if (not gnus-dribble-eval-file)
- ()
+ (when gnus-dribble-eval-file
(setq gnus-dribble-eval-file nil)
(save-excursion
(let ((gnus-dribble-ignore t))
(eval-buffer (current-buffer))))))
(defun gnus-dribble-delete-file ()
- (if (file-exists-p (gnus-dribble-file-name))
- (delete-file (gnus-dribble-file-name)))
- (if gnus-dribble-buffer
- (save-excursion
- (set-buffer gnus-dribble-buffer)
- (let ((auto (make-auto-save-file-name)))
- (if (file-exists-p auto)
- (delete-file auto))
- (erase-buffer)
- (set-buffer-modified-p nil)))))
+ (when (file-exists-p (gnus-dribble-file-name))
+ (delete-file (gnus-dribble-file-name)))
+ (when gnus-dribble-buffer
+ (save-excursion
+ (set-buffer gnus-dribble-buffer)
+ (let ((auto (make-auto-save-file-name)))
+ (if (file-exists-p auto)
+ (delete-file auto))
+ (erase-buffer)
+ (set-buffer-modified-p nil)))))
(defun gnus-dribble-save ()
- (if (and gnus-dribble-buffer
- (buffer-name gnus-dribble-buffer))
- (save-excursion
- (set-buffer gnus-dribble-buffer)
- (save-buffer))))
+ (when (and gnus-dribble-buffer
+ (buffer-name gnus-dribble-buffer))
+ (save-excursion
+ (set-buffer gnus-dribble-buffer)
+ (save-buffer))))
(defun gnus-dribble-clear ()
- (save-excursion
- (if (gnus-buffer-exists-p gnus-dribble-buffer)
- (progn
- (set-buffer gnus-dribble-buffer)
- (erase-buffer)
- (set-buffer-modified-p nil)
- (setq buffer-saved-size (buffer-size))))))
+ (when (gnus-buffer-exists-p gnus-dribble-buffer)
+ (save-excursion
+ (set-buffer gnus-dribble-buffer)
+ (erase-buffer)
+ (set-buffer-modified-p nil)
+ (setq buffer-saved-size (buffer-size)))))
\f
;;;
(unless silent
(message ""))))))
-(defun gnus-get-function (method function)
+(defun gnus-get-function (method function &optional noerror)
"Return a function symbol based on METHOD and FUNCTION."
;; Translate server names into methods.
(unless method
;; question.
(unless (fboundp func)
(require (car method))
- (unless (fboundp func)
+ (when (and (not (fboundp func))
+ (not noerror))
;; This backend doesn't implement this function.
(error "No such function: %s" func)))
func))
(defun gnus-request-head (article group)
"Request the head of ARTICLE in GROUP."
- (let ((method (gnus-find-method-for-group group)))
- (funcall (gnus-get-function method 'request-head)
- article (gnus-group-real-name group) (nth 1 method))))
+ (let* ((method (gnus-find-method-for-group group))
+ (head (gnus-get-function method 'request-head t)))
+ (if (fboundp head)
+ (funcall head article (gnus-group-real-name group) (nth 1 method))
+ (let ((res (gnus-request-article article group)))
+ (when res
+ (save-excursion
+ (set-buffer nntp-server-buffer)
+ (goto-char (point-min))
+ (when (search-forward "\n\n" nil t)
+ (delete-region (1- (point)) (point-max)))
+ (nnheader-fold-continuation-lines)))
+ res))))
(defun gnus-request-body (article group)
"Request the body of ARTICLE in GROUP."
(setq method (gnus-server-to-method method)))
(when (and (not method)
(stringp group))
- (setq method (gnus-find-method-for-group group)))
+ (setq method (gnus-group-name-to-method group)))
(goto-char (point-max))
(unless (bolp)
(insert "\n"))
(setcar (cdr entry) (concat (nth 1 entry) "+" group))
(nconc entry (cdr method))))
+(defun gnus-server-status (method)
+ "Return the status of METHOD."
+ (nth 1 (assoc method gnus-opened-servers)))
+
+(defun gnus-group-name-to-method (group)
+ "Return a select method suitable for GROUP."
+ (if (string-match ":" group)
+ (let ((server (substring group 0 (match-beginning 0))))
+ (if (string-match "\\+" server)
+ (list (intern (substring server 0 (match-beginning 0)))
+ (substring server (match-end 0)))
+ (list (intern server) "")))
+ gnus-select-method))
+
(defun gnus-find-method-for-group (group &optional info)
"Find the select method that GROUP uses."
(or gnus-override-method
(gnus-read-newsrc-file rawfile))
(when (and (not (assoc "archive" gnus-server-alist))
- gnus-message-archive-method)
+ (gnus-archive-server-wanted-p))
(push (cons "archive" gnus-message-archive-method)
gnus-server-alist))
;; Possibly eval the dribble file.
(and init (or gnus-use-dribble-file gnus-slave) (gnus-dribble-eval-file))
+ ;; Slave Gnusii should then clear the dribble buffer.
+ (when (and init gnus-slave)
+ (gnus-dribble-clear))
+
(gnus-update-format-specifications)
;; See whether we need to read the description file.
(let* ((date (or gnus-newsrc-last-checked-date (current-time-string)))
(methods (cons gnus-select-method
(nconc
- (when gnus-message-archive-method
+ (when (gnus-archive-server-wanted-p)
(list "archive"))
(append
(and (consp gnus-check-new-newsgroups)
(gnus-group-change-level entry gnus-level-killed)
(setq gnus-killed-list (delete group gnus-killed-list))))
;; Then we remove all bogus groups from the list of killed and
- ;; zombie groups. They are are removed without confirmation.
+ ;; zombie groups. They are removed without confirmation.
(let ((dead-lists '(gnus-killed-list gnus-zombie-list))
killed)
(while dead-lists
(set (car dead-lists)
(delete group (symbol-value (car dead-lists))))))
(setq dead-lists (cdr dead-lists))))
+ (run-hooks 'gnus-check-bogus-groups-hook)
(gnus-message 5 "Checking bogus newsgroups...done"))))
(defun gnus-check-duplicate-killed-groups ()
;; We want to inline a function from gnus-cache, so we cheat here:
(eval-when-compile
(provide 'gnus)
+ (setq gnus-directory (or (getenv "SAVEDIR") "~/News/"))
(require 'gnus-cache))
(defun gnus-get-unread-articles-in-group (info active &optional update)
(when (<= (gnus-info-level info) foreign-level)
(setq active (gnus-activate-group group 'scan))
(unless (inline (gnus-virtual-group-p group))
- (inline (gnus-close-group group))))
-
+ (inline (gnus-close-group group)))
+ (when (fboundp (intern (concat (symbol-name (car method))
+ "-request-update-info")))
+ (inline (gnus-request-update-info info method))))
;; These groups are native or secondary.
(when (and (<= (gnus-info-level info) level)
(not gnus-read-active-file))
(setq active (gnus-activate-group group 'scan))
(inline (gnus-close-group group))))
+ ;; Get the number of unread articles in the group.
(if active
- (inline (gnus-get-unread-articles-in-group
- info active
- (and method
- (fboundp (intern (concat (symbol-name (car method))
- "-request-update-info"))))))
+ (inline (gnus-get-unread-articles-in-group info active))
;; The group couldn't be reached, so we nix out the number of
;; unread articles and stuff.
(gnus-set-active group nil)
(while list
(gnus-sethash (car list) (pop list) gnus-killed-hashtb)))))
-(defun gnus-activate-group (group &optional scan dont-check)
+(defun gnus-activate-group (group &optional scan dont-check method)
;; Check whether a group has been activated or not.
;; If SCAN, request a scan of that group as well.
- (let ((method (gnus-find-method-for-group group))
+ (let ((method (or method (gnus-find-method-for-group group)))
active)
(and (gnus-check-server method)
;; We escape all bugs and quit here to make it possible to
(gnus-request-scan group method))
t)
(condition-case ()
- (gnus-request-group group dont-check)
+ (gnus-request-group group dont-check method)
; (error nil)
(quit nil))
(save-excursion
(setq lists (cdr lists)))))
(defun gnus-get-killed-groups ()
- "Go through the active hashtb and all all unknown groups as killed."
+ "Go through the active hashtb and mark all unknown groups as killed."
;; First make sure active file has been read.
(unless (gnus-read-active-file-p)
(let ((gnus-read-active-file t))
;; secondary ones.
gnus-secondary-select-methods)
;; Also read from the archive server.
- (when gnus-message-archive-method
+ (when (gnus-archive-server-wanted-p)
(list "archive"))))
list-type)
(setq gnus-have-read-active-file nil)
(unless (equal method gnus-message-archive-method)
(gnus-error 1 "Cannot read active file from %s server."
(car method)))
+ (gnus-message 5 mesg)
(gnus-active-to-gnus-format method gnus-active-hashtb)
;; We mark this active file as read.
(push method gnus-have-read-active-file)
(defun gnus-continuum-version (version)
"Return VERSION as a floating point number."
- (when (string-match "^\\([^ ]+\\)? ?Gnus v?\\([0-9.]+\\)$" version)
+ (when (or (string-match "^\\([^ ]+\\)? ?Gnus v?\\([0-9.]+\\)$" version)
+ (string-match "^\\(.?\\)gnus-\\([0-9.]+\\)$" version))
(let* ((alpha (and (match-beginning 1) (match-string 1 version)))
(number (match-string 2 version))
major minor least)
(if (zerop major)
(format "%s00%02d%02d"
(cond
- ((string= alpha "(ding)") "4.99")
- ((string= alpha "September") "5.01")
- ((string= alpha "Red") "5.03"))
+ ((member alpha '("(ding)" "d")) "4.99")
+ ((member alpha '("September" "s")) "5.01")
+ ((member alpha '("Red" "r")) "5.03"))
minor least)
- (format "%d.%02d%20d" major minor least))))))
+ (format "%d.%02d%02d" major minor least))))))
(defun gnus-convert-old-newsrc ()
"Convert old newsrc into the new format, if needed."
killed gnus-killed-assoc
marked gnus-marked-assoc)))
(setq gnus-newsrc-alist nil)
- (while (setq info (gnus-get-info (setq group (pop newsrc))))
- (if info
+ (while (setq group (pop newsrc))
+ (if (setq info (gnus-get-info (car group)))
(progn
(gnus-info-set-read info (cddr group))
(gnus-info-set-level
(setq version-control 'never)
(setq buffer-file-name
(concat gnus-current-startup-file ".eld"))
+ (setq default-directory (file-name-directory buffer-file-name))
(gnus-add-current-to-buffer-list)
(buffer-disable-undo (current-buffer))
(erase-buffer)
(kill-buffer (current-buffer))
(gnus-message
5 "Saving %s.eld...done" gnus-current-startup-file))
- (gnus-dribble-delete-file)))))
+ (gnus-dribble-delete-file)
+ (gnus-group-set-mode-line)))))
(defun gnus-gnus-to-quick-newsrc-format ()
"Insert Gnus variables such as gnus-newsrc-alist in lisp format."
(standard-output (current-buffer))
info ranges range method)
(setq buffer-file-name gnus-current-startup-file)
+ (setq default-directory (file-name-directory buffer-file-name))
(buffer-disable-undo (current-buffer))
(erase-buffer)
;; Write options.
(defun gnus-read-all-descriptions-files ()
(let ((methods (cons gnus-select-method
(nconc
- (when gnus-message-archive-method
+ (when (gnus-archive-server-wanted-p)
(list "archive"))
gnus-secondary-select-methods))))
(while methods
t))
(defun gnus-read-descriptions-file (&optional method)
- (let ((method (or method gnus-select-method)))
+ (let ((method (or method gnus-select-method))
+ group)
(when (stringp method)
(setq method (gnus-server-to-method method)))
;; We create the hashtable whether we manage to read the desc file
(gnus-message 1 "Couldn't read newsgroups descriptions")
nil)
(t
- (let (group)
- (save-excursion
- (save-restriction
- (set-buffer nntp-server-buffer)
- (goto-char (point-min))
- (if (or (search-forward "\n.\n" nil t)
+ (save-excursion
+ (save-restriction
+ (set-buffer nntp-server-buffer)
+ (goto-char (point-min))
+ (when (or (search-forward "\n.\n" nil t)
(goto-char (point-max)))
- (progn
- (beginning-of-line)
- (narrow-to-region (point-min) (point))))
- (goto-char (point-min))
- (while (not (eobp))
- ;; If we get an error, we set group to 0, which is not a
- ;; symbol...
- (setq group
- (condition-case ()
- (let ((obarray gnus-description-hashtb))
- ;; Group is set to a symbol interned in this
- ;; hash table.
- (read nntp-server-buffer))
- (error 0)))
- (skip-chars-forward " \t")
- ;; ... which leads to this line being effectively ignored.
- (and (symbolp group)
- (set group (buffer-substring
- (point) (progn (end-of-line) (point)))))
- (forward-line 1))))
- (gnus-message 5 "Reading descriptions file...done")
- t)))))
+ (beginning-of-line)
+ (narrow-to-region (point-min) (point)))
+ ;; If these are groups from a foreign select method, we insert the
+ ;; group prefix in front of the group names.
+ (and method (not (gnus-server-equal
+ (gnus-server-get-method nil method)
+ (gnus-server-get-method nil gnus-select-method)))
+ (let ((prefix (gnus-group-prefixed-name "" method)))
+ (goto-char (point-min))
+ (while (and (not (eobp))
+ (progn (insert prefix)
+ (zerop (forward-line 1)))))))
+ (goto-char (point-min))
+ (while (not (eobp))
+ ;; If we get an error, we set group to 0, which is not a
+ ;; symbol...
+ (setq group
+ (condition-case ()
+ (let ((obarray gnus-description-hashtb))
+ ;; Group is set to a symbol interned in this
+ ;; hash table.
+ (read nntp-server-buffer))
+ (error 0)))
+ (skip-chars-forward " \t")
+ ;; ... which leads to this line being effectively ignored.
+ (and (symbolp group)
+ (set group (buffer-substring
+ (point) (progn (end-of-line) (point)))))
+ (forward-line 1))))
+ (gnus-message 5 "Reading descriptions file...done")
+ t))))
(defun gnus-group-get-description (group)
"Get the description of a group by sending XGTITLE to the server."
(setq b (point))
(insert-buffer-substring buffer)
;; Tag the beginning of the article with the ident.
- (put-text-property b (1+ b) 'gnus-backlog ident))))))
+ (gnus-put-text-property b (1+ b) 'gnus-backlog ident))))))
(defun gnus-backlog-remove-oldest-article ()
(save-excursion
(point) (next-single-property-change
(1+ (point)) 'gnus-backlog nil (point-max)))))))
+(defun gnus-backlog-remove-article (group number)
+ "Remove article NUMBER in GROUP from the backlog."
+ (when (numberp number)
+ (gnus-backlog-setup)
+ (let ((ident (intern (concat group ":" (int-to-string number))
+ gnus-backlog-hashtb))
+ beg end)
+ (when (memq ident gnus-backlog-articles)
+ ;; It was in the backlog.
+ (save-excursion
+ (set-buffer (gnus-backlog-buffer))
+ (let (buffer-read-only)
+ (when (setq beg (text-property-any
+ (point-min) (point-max) 'gnus-backlog
+ ident))
+ ;; Find the end (i. e., the beginning of the next article).
+ (setq end
+ (next-single-property-change
+ (1+ beg) 'gnus-backlog (current-buffer) (point-max)))
+ (delete-region beg end)
+ ;; Return success.
+ t)))))))
+
(defun gnus-backlog-request-article (group number buffer)
(when (numberp number)
(gnus-backlog-setup)
projects / gnus / blobdiff