;;; Commentary:
-;; Although (ding) Gnus looks suspiciously like GNUS, it isn't quite
-;; the same beast. Most internal structures have been changed. If you
-;; have written packages that depend on any of the hash tables,
+;; Although Gnus looks suspiciously like GNUS, it isn't quite the same
+;; beast. Most internal structures have been changed. If you have
+;; written packages that depend on any of the hash tables,
;; `gnus-newsrc-alist', `gnus-killed-assoc', marked lists, the .newsrc
;; buffer, or internal knowledge of the `nntp-header-' macros, or
;; dependence on the buffers having a certain format, your code will
;;; Code:
+(eval '(run-hooks 'gnus-load-hook))
+
(require 'mail-utils)
(require 'timezone)
(require 'nnheader)
;; Customization variables
+;; Don't touch this variable.
+(defvar gnus-nntp-service "nntp"
+ "*NNTP service name (\"nntp\" or 119).
+This is an obsolete variable, which is scarcely used. If you use an
+nntp server for your newsgroup and want to change the port number
+used to 899, you would say something along these lines:
+
+ (setq gnus-select-method '(nntp \"my.nntp.server\" (nntp-port-number 899)))")
+
(defvar gnus-select-method
- (list 'nntp (or (getenv "NNTPSERVER")
- (if (and gnus-default-nntp-server
- (not (string= gnus-default-nntp-server "")))
- gnus-default-nntp-server)
- (system-name)))
+ (nconc
+ (list 'nntp (or (getenv "NNTPSERVER")
+ (if (and gnus-default-nntp-server
+ (not (string= gnus-default-nntp-server "")))
+ gnus-default-nntp-server)
+ (system-name)))
+ (if (equal gnus-nntp-service "nntp") nil (list gnus-nntp-service)))
"*Default method for selecting a newsgroup.
This variable should be a list, where the first element is how the
news is to be fetched, the second is the address.
(defvar gnus-secondary-select-methods nil
"*A list of secondary methods that will be used for reading news.
-This is a list where each element is a complete select methdod (see
+This is a list where each element is a complete select method (see
`gnus-select-method').
If, for instance, you want to read your mail with the nnml backend,
you could set this variable:
-(setq gnus-secondary-select-methods '((nnml \"\"))")
+(setq gnus-secondary-select-methods '((nnml \"\")))")
(defvar gnus-secondary-servers nil
"*List of NNTP servers that the user can choose between interactively.
This variable is semi-obsolete. Use the `gnus-select-method'
variable instead.")
-(defvar gnus-nntp-service "nntp"
- "*NNTP service name (\"nntp\" or 119).
-This is an obsolete variable, which is scarcely used. If you use an
-nntp server for your newsgroup and want to change the port number
-used to 899, you would say something along these lines:
-
- (setq gnus-select-method '(nntp \"my.nntp.server\" (nntp-port-number 899)))")
-
(defvar gnus-startup-file "~/.newsrc"
"*Your `.newsrc' file.
`.newsrc-SERVER' will be used instead if that exists.")
instead.")
(defvar gnus-group-faq-directory
- "/anonymous@rtfm.mit.edu:/pub/usenet-by-group/"
+ "/ftp@mirrors.aol.com:/pub/rtfm/usenet/"
"*Directory where the group FAQs are stored.
This will most commonly be on a remote machine, and the file will be
-fetched by ange-ftp.")
+fetched by ange-ftp.
+
+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
+something of value back from them.
+
+If the default site is too slow, try one of these:
+
+ North America: ftp.uu.net /usenet/news.answers
+ mirrors.aol.com /pub/rtfm/usenet
+ ftp.seas.gwu.edu /pub/rtfm
+ rtfm.mit.edu /pub/usenet/news.answers
+ Europe: ftp.uni-paderborn.de /pub/FAQ
+ ftp.Germany.EU.net /pub/newsarchive/news.answers
+ ftp.sunet.se /pub/usenet
+ Asia: nctuccca.edu.tw /USENET/FAQ
+ hwarang.postech.ac.kr /pub/usenet/news.answers
+ ftp.hk.super.net /mirror/faqs")
(defvar gnus-group-archive-directory
- "/ftp@sina.tcamc.uh.edu:/pub/emacs/ding-list/"
+ "/ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list/"
"*The address of the (ding) archives.")
+(defvar gnus-group-recent-archive-directory
+ "/ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list-recent/"
+ "*The address of the most recent (ding) articles.")
+
(defvar gnus-default-subscribed-newsgroups nil
"*This variable lists what newsgroups should be subscribed the first time Gnus is used.
It should be a list of strings.
If the name of a group is matched by REGEXP, the corresponding scorefiles
will be used for that group.
The first match found is used, subsequent matching entries are ignored (to
-use mutliple matches, see gnus-score-file-multiple-match-alist).
+use multiple matches, see gnus-score-file-multiple-match-alist).
These score files are loaded in addition to any files returned by
gnus-score-find-score-files-function (which see).")
"*Suffix of the adaptive score files.")
(defvar gnus-score-find-score-files-function 'gnus-score-find-bnews
- "*Function used to find SCORE files.
+ "*Function used to find score files.
The function will be called with the group name as the argument, and
should return a list of score files to apply to that group. The score
files do not actually have to exist.
Predefined values are:
-gnus-score-find-single: Only apply the group's own SCORE file.
-gnus-score-find-hierarchical: Also apply SCORE files from parent groups.
-gnus-score-find-bnews: Apply SCORE files whose names matches.
+gnus-score-find-single: Only apply the group's own score file.
+gnus-score-find-hierarchical: Also apply score files from parent groups.
+gnus-score-find-bnews: Apply score files whose names matches.
See the documentation to these functions for more information.
The server has to support XOVER for any of this to work.")
-(defvar gnus-visual t
- "*If non-nil, will do various highlighting.
-If nil, no mouse highlights (or any other highlights) will be
-performed. This might speed up Gnus some when generating large group
-and summary buffers.")
+;see gnus-cus.el
+;(defvar gnus-visual t
+; "*If non-nil, will do various highlighting.
+;If nil, no mouse highlights (or any other highlights) will be
+;performed. This might speed up Gnus some when generating large group
+;and summary buffers.")
(defvar gnus-novice-user t
"*Non-nil means that you are a usenet novice.
unrelated articles that have subject that happen to begin with the
same few characters will be incorrectly gathered.
-If this variable is `fuzzy', Gnus will use a fuzzy algortihm when
+If this variable is `fuzzy', Gnus will use a fuzzy algorithm when
comparing subjects.")
;; Added by Per Abrahamsen <amanda@iesd.auc.dk>.
This variable will only be used if the value of
`gnus-summary-make-false-root' is `empty'.")
-(defvar gnus-summary-goto-unread nil
+(defvar gnus-summary-goto-unread t
"*If non-nil, marking commands will go to the next unread article.")
(defvar gnus-group-goto-unread t
(defvar gnus-level-default-unsubscribed 6
"*New unsubscribed groups will be unsubscribed at this level.")
-(defvar gnus-activate-foreign-newsgroups nil
+(defvar gnus-activate-foreign-newsgroups 4
"*If nil, Gnus will not check foreign newsgroups at startup.
If it is non-nil, it should be a number between one and nine. Foreign
newsgroups that have a level lower or equal to this number will be
(defvar gnus-interactive-exit t
"*If non-nil, require your confirmation when exiting Gnus.")
-(defvar gnus-kill-killed nil
+(defvar gnus-kill-killed t
"*If non-nil, Gnus will apply kill files to already killed articles.
If it is nil, Gnus will never apply kill files to articles that have
already been through the scoring process, which might very well save lots
"*Default article score level.
If this variable is nil, scoring will be disabled.")
+(defvar gnus-summary-zcore-fuzz 0
+ "*Fuzziness factor for the zcore in the summary buffer.
+Articles with scores closer than this to `gnus-summary-default-score'
+will not be marked.")
+
+(defvar gnus-simplify-subject-fuzzy-regexp nil
+ "*Regular expression that will be removed from subject strings if
+fuzzy subject simplification is selected.")
+
(defvar gnus-group-default-list-level gnus-level-subscribed
"*Default listing level.
-Ignored if `gnus-group-use-permanent-levels' is nil.")
+Ignored if `gnus-group-use-permanent-levels' is non-nil.")
(defvar gnus-group-use-permanent-levels nil
"*If non-nil, once you set a level, Gnus will use this level.")
(defvar gnus-show-mime nil
- "*If non-ni, do mime processing of articles.
+ "*If non-nil, do mime processing of articles.
The articles will simply be fed to the function given by
`gnus-show-mime-method'.")
+(defvar gnus-strict-mime t
+ "*If nil, decode MIME header even if there is not Mime-Version field.")
+
(defvar gnus-show-mime-method (function metamail-buffer)
"*Function to process a MIME message.
The function is called from the article buffer.")
(defvar gnus-thread-indent-level 4
"*Number that says how much each sub-thread should be indented.")
-(defvar gnus-ignored-newsgroups ""
+(defvar gnus-ignored-newsgroups
+ (purecopy (mapconcat 'identity
+ '("^to\\." ; not "real" groups
+ "^[0-9. \t]+ " ; all digits in name
+ "[][\"#'()]" ; bogus characters
+ )
+ "\\|"))
"*A regexp to match uninteresting newsgroups in the active file.
Any lines in the active file matching this regular expression are
removed from the newsgroup list before anything else is done to it,
-thus making them effectively non-existant.")
+thus making them effectively non-existent.")
(defvar gnus-ignored-headers
"^Path:\\|^Posting-Version:\\|^Article-I.D.:\\|^Expires:\\|^Date-Received:\\|^References:\\|^Control:\\|^Xref:\\|^Lines:\\|^Posted:\\|^Relay-Version:\\|^Message-ID:\\|^Nf-ID:\\|^Nf-From:\\|^Approved:\\|^Sender:\\|^Received:\\|^Mail-from:"
"*All headers that match this regexp will be hidden.
-Also see `gnus-visible-headers'.")
+If `gnus-visible-headers' is non-nil, this variable will be ignored.")
(defvar gnus-visible-headers "^From:\\|^Newsgroups:\\|^Subject:\\|^Date:\\|^Followup-To:\\|^Reply-To:\\|^Organization:\\|^Summary:\\|^Keywords:\\|^To:\\|^Cc:"
"*All headers that do not match this regexp will be hidden.
-Also see `gnus-ignored-headers'.")
+If this variable is non-nil, `gnus-ignored-headers' will be ignored.")
(defvar gnus-sorted-header-list
'("^From:" "^Subject:" "^Summary:" "^Keywords:" "^Newsgroups:" "^To:"
[mail 1.0 point]))
(info ([nil 1.0 point]))
(summary-faq ([summary 0.25]
- [article 1.0 point]))
+ [faq 1.0 point]))
(edit-group ([group 0.5]
[edit-group 1.0 point]))
(edit-server ([server 0.5]
[edit-server 1.0 point]))
+ (edit-score ([summary 0.25]
+ [edit-score 1.0 point]))
(post ([post 1.0 point]))
(reply ([article 0.5]
[mail 1.0 point]))
(summary-carpal . gnus-carpal-summary-buffer)
(server-carpal . gnus-carpal-server-buffer)
(browse-carpal . gnus-carpal-browse-buffer)
- (mail . "*mail*")
- (post . gnus-post-news-buffer))
+ (edit-score . gnus-score-edit-buffer)
+ (mail . gnus-mail-buffer)
+ (post . gnus-post-news-buffer)
+ (faq . gnus-faq-buffer))
"Mapping from short symbols to buffer names or buffer variables.")
(defvar gnus-carpal nil
"*Function used for sorting the group buffer.
This function will be called with group info entries as the arguments
for the groups to be sorted. Pre-made functions include
-`gnus-sort-by-alphabet', `gnus-sort-by-unread' and
-`gnus-sort-by-level'")
+`gnus-group-sort-by-alphabet', `gnus-group-sort-by-unread' and
+`gnus-group-sort-by-level'")
;; Mark variables suggested by Thomas Michanek
;; <Thomas.Michanek@telelogic.se>.
"*Mark used for ticked articles.")
(defvar gnus-dormant-mark ??
"*Mark used for dormant articles.")
-(defvar gnus-del-mark ?D
+(defvar gnus-del-mark ?r
"*Mark used for del'd articles.")
-(defvar gnus-read-mark ?d
+(defvar gnus-read-mark ?R
"*Mark used for read articles.")
(defvar gnus-expirable-mark ?E
"*Mark used for expirable articles.")
"*Mark used for articles with a low score.")
(defvar gnus-catchup-mark ?C
"*Mark used for articles that are caught up.")
-(defvar gnus-replied-mark ?R
+(defvar gnus-replied-mark ?A
"*Mark used for articles that have been replied to.")
(defvar gnus-process-mark ?#
"*Process mark.")
-(defvar gnus-ancient-mark ?A
+(defvar gnus-ancient-mark ?O
"*Mark used for ancient articles.")
(defvar gnus-canceled-mark ?G
- "*Mark used for cancelled articles.")
+ "*Mark used for canceled articles.")
(defvar gnus-score-over-mark ?+
"*Score mark used for articles with high scores.")
(defvar gnus-score-below-mark ?-
If nil, all files that use the same viewing command will be given as a
list of parameters to that command.")
-(defvar gnus-group-line-format "%M%S%5y: %(%g%)\n"
+(defvar gnus-group-line-format "%M%S%p%5y: %(%g%)\n"
"*Format of group lines.
It works along the same lines as a normal formatting string,
with some simple extensions.
%D Group description (string)
%s Select method (string)
%o Moderated group (char, \"m\")
+%p Process mark (char)
%O Moderated group (string, \"(m)\" or \"\")
%n Select from where (string)
%z A string that look like `<%s:%n>' if a foreign select method is used
%S Subject (string)
%s Subject if it is at the root of a thread, and \"\" otherwise (string)
%n Name of the poster (string)
-%A Address of the poster (string)
+%a Extracted name of the poster (string)
+%A Extracted address of the poster (string)
%F Contents of the From: header (string)
%x Contents of the Xref: header (string)
%D Date of the article (string)
%S The subject")
-(defvar gnus-summary-mode-line-format "(ding) %G/%A %Z"
+(defvar gnus-summary-mode-line-format "Gnus %G/%A %Z"
"*The format specification for the summary mode line.")
-(defvar gnus-article-mode-line-format "(ding) %G/%A %S"
+(defvar gnus-article-mode-line-format "Gnus %G/%A %S"
"*The format specification for the article mode line.")
-(defvar gnus-group-mode-line-format "(ding) List of groups {%M:%S} "
+(defvar gnus-group-mode-line-format "Gnus List of groups {%M:%S} "
"*The format specification for the group mode line.")
(defvar gnus-valid-select-methods
("nndigest" none)
("nndoc" none prompt-address)
("nnbabyl" mail respool)
- ("nnkiboze" none virtual)
+ ("nnkiboze" post virtual)
+ ;;("nnsoup" post)
("nnfolder" mail respool))
"An alist of valid select methods.
The first element of each list lists should be a string with the name
If this is nil, Gnus will take space as is needed, leaving the rest
of the modeline intact.")
-;; Added by Per Abrahamsen <amanda@iesd.auc.dk>.
-(defvar gnus-mouse-face 'highlight
- "*Face used for mouse highlighting in Gnus.
-No mouse highlights will be done if `gnus-visual' is nil.")
+;see gnus-cus.el
+;(defvar gnus-mouse-face 'highlight
+; "*Face used for mouse highlighting in Gnus.
+;No mouse highlights will be done if `gnus-visual' is nil.")
(defvar gnus-summary-mark-below nil
"*Mark all articles with a score below this variable as read.
(defvar gnus-hidden-properties '(invisible t intangible t)
"Property list to use for hiding text.")
+(defvar gnus-modtime-botch nil
+ "*Non-nil means .newsrc should be deleted prior to save. Its use is
+due to the bogus appearance that .newsrc was modified on disc.")
+
;; Hooks.
(defvar gnus-group-mode-hook nil
"*A hook for Gnus group mode.")
(defvar gnus-summary-mode-hook nil
- "*A hook for Gnus summary mode.")
+ "*A hook for Gnus summary mode.
+This hook is run before any variables are set in the summary buffer.")
(defvar gnus-article-mode-hook nil
"*A hook for Gnus article mode.")
+(defun gnus-summary-prepare-exit-hook nil
+ "*A hook called when preparing to exit from the summary buffer.
+It calls `gnus-summary-expire-articles' by default.")
+(add-hook 'gnus-summary-prepare-exit-hook 'gnus-summary-expire-articles)
+
+(defun gnus-summary-exit-hook nil
+ "*A hook called on exit from the summary buffer.")
+
(defvar gnus-open-server-hook nil
"*A hook called just before opening connection to the news server.")
+(defvar gnus-load-hook nil
+ "*A hook run while Gnus is loaded.")
+
(defvar gnus-startup-hook nil
"*A hook called at startup.
This hook is called after Gnus is connected to the NNTP server.")
"*A hook called after an article has been prepared in the article buffer.
If you want to run a special decoding program like nkf, use this hook.")
-(defvar gnus-article-display-hook nil
- "*A hook called after the article is displayed in the article buffer.
-The hook is designed to change the contents of the article
-buffer. Typical functions that this hook may contain are
-`gnus-article-hide-headers' (hide selected headers),
-`gnus-article-maybe-highlight' (perform fancy article highlighting),
-`gnus-article-hide-signature' (hide signature) and
-`gnus-article-treat-overstrike' (turn \"^H_\" into bold characters).")
-(add-hook 'gnus-article-display-hook 'gnus-article-hide-headers-if-wanted)
-(add-hook 'gnus-article-display-hook 'gnus-article-treat-overstrike)
+;(defvar gnus-article-display-hook nil
+; "*A hook called after the article is displayed in the article buffer.
+;The hook is designed to change the contents of the article
+;buffer. Typical functions that this hook may contain are
+;`gnus-article-hide-headers' (hide selected headers),
+;`gnus-article-maybe-highlight' (perform fancy article highlighting),
+;`gnus-article-hide-signature' (hide signature) and
+;`gnus-article-treat-overstrike' (turn \"^H_\" into bold characters).")
+;(add-hook 'gnus-article-display-hook 'gnus-article-hide-headers-if-wanted)
+;(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 -"
(list
(lambda ()
(mapcar (lambda (header)
- (header-set-subject
+ (mail-header-set-subject
header
(gnus-simplify-subject
- (header-subject header) 're-only)))
+ (mail-header-subject header) 're-only)))
gnus-newsgroup-headers))))")
(defvar gnus-select-article-hook
a string `rmgroup' in subject in newsgroup `control', you can use the
following hook:
-\(setq gnus-apply-kill-hook
+ (setq gnus-apply-kill-hook
(list
(lambda ()
(cond ((string-match \"control\" gnus-newsgroup-name)
The hook is intended to mark an article as read (or unread)
automatically when it is selected.")
+;; Remove any hilit infestation.
+(add-hook 'gnus-startup-hook
+ (lambda ()
+ (remove-hook 'gnus-summary-prepare-hook
+ 'hilit-rehighlight-buffer-quietly)
+ (remove-hook 'gnus-summary-prepare-hook 'hilit-install-line-hooks)
+ (setq gnus-mark-article-hook '(gnus-summary-mark-unread-as-read))
+ (remove-hook 'gnus-article-prepare-hook
+ 'hilit-rehighlight-buffer-quietly)))
+
+
\f
;; Internal variables
(defvar gnus-newsgroup-selected-overlay nil)
(defvar gnus-article-mode-map nil)
-(defvar caesar-translate-table nil)
(defvar gnus-dribble-buffer nil)
(defvar gnus-headers-retrieved-by nil)
(defvar gnus-article-reply nil)
(list ?D 'newsgroup-description ?s)
(list ?o 'moderated ?c)
(list ?O 'moderated-string ?s)
+ (list ?p 'process-marked ?c)
(list ?s 'news-server ?s)
(list ?n 'news-method ?s)
(list ?z 'news-method-string ?s)
(list ?S 'subject ?s)
(list ?s 'subject-or-nil ?s)
(list ?n 'name ?s)
- (list ?A 'address ?s)
+ (list ?A '(car (cdr (funcall gnus-extract-address-components from)))
+ ?s)
+ (list ?a '(or (car (funcall gnus-extract-address-components from))
+ from) ?s)
(list ?F 'from ?s)
- (list ?x (macroexpand '(header-xref header)) ?s)
- (list ?D (macroexpand '(header-date header)) ?s)
- (list ?d '(gnus-dd-mmm (header-date header)) ?s)
- (list ?M (macroexpand '(header-id header)) ?s)
- (list ?r (macroexpand '(header-references header)) ?s)
- (list ?c '(or (header-chars header) 0) ?d)
+ (list ?x (macroexpand '(mail-header-xref header)) ?s)
+ (list ?D (macroexpand '(mail-header-date header)) ?s)
+ (list ?d '(gnus-dd-mmm (mail-header-date header)) ?s)
+ (list ?M (macroexpand '(mail-header-id header)) ?s)
+ (list ?r (macroexpand '(mail-header-references header)) ?s)
+ (list ?c '(or (mail-header-chars header) 0) ?d)
(list ?L 'lines ?d)
(list ?I 'indentation ?s)
(list ?T '(if (= level 0) "" (make-string (frame-width) ? )) ?s)
(list ?z 'score-char ?c)
(list ?U 'unread ?c)
(list ?t '(gnus-summary-number-of-articles-in-thread
- (or (prog1 gnus-tmp-adopt-thread
- (setq gnus-tmp-adopt-thread nil))
- (if (boundp 'thread) (symbol-value 'thread)
- thread nil)))
- ?d)
+ (and (boundp 'thread) (car thread)))
+ ?d)
(list ?e '(gnus-summary-number-of-articles-in-thread
- (or gnus-tmp-adopt-thread
- (if (boundp 'thread) (symbol-value 'thread)
- thread nil)) t)
- ?d)
+ (and (boundp 'thread) (car thread)) t)
+ ?c)
(list ?u 'user-defined ?s))
"An alist of format specifications that can appear in summary lines,
and what variables they correspond with, along with the type of the
(defvar gnus-have-read-active-file nil)
-(defconst gnus-maintainer "gnus-bug@ifi.uio.no (The Gnus Bugfixing Girls & Boys)"
- "The mail address of the Gnus maintainer.")
+(defconst gnus-maintainer
+ "gnus-bug@ifi.uio.no (The Gnus Bugfixing Girls + Boys)"
+ "The mail address of the Gnus maintainers.")
-(defconst gnus-version "(ding) Gnus v0.77"
+(defconst gnus-version "Gnus v5.0.1"
"Version number for this version of Gnus.")
(defvar gnus-info-nodes
"Assoc list of major modes and related Info nodes.")
(defvar gnus-documentation-group-file "~/dgnus/lisp/doc.txt"
- "The location of the (ding) Gnus documentation group.")
+ "The location of the Gnus documentation group.")
(defvar gnus-group-buffer "*Group*")
(defvar gnus-summary-buffer "*Summary*")
"Gnus variables saved in the quick startup file.")
(defvar gnus-overload-functions
- '((news-inews gnus-inews-news "rnewspost")
- (caesar-region gnus-caesar-region "rnews"))
+ '((news-inews gnus-inews-news "rnewspost"))
"Functions overloaded by gnus.
It is a list of `(original overload &optional file)'.")
(defvar gnus-current-select-method nil
"The current method for selecting a newsgroup.")
-(defvar gnus-have-all-newsgroups nil)
+(defvar gnus-group-list-mode nil)
(defvar gnus-article-internal-prepare-hook nil)
(defvar gnus-newsgroup-unselected nil
"List of unselected unread articles in the current newsgroup.")
+(defvar gnus-newsgroup-reads nil
+ "Alist of read articles and article marks in the current newsgroup.")
+
(defvar gnus-newsgroup-marked nil
"List of ticked articles in the current newsgroup (a subset of unread art).")
(defvar gnus-article-mode-line-format-spec nil)
(defvar gnus-group-mode-line-format-spec nil)
(defvar gnus-summary-mark-positions nil)
+(defvar gnus-group-mark-positions nil)
(defvar gnus-summary-expunge-below nil)
(defvar gnus-reffed-article-number nil)
-(defvar rmail-default-file (expand-file-name "~/XMBOX"))
-(defvar rmail-default-rmail-file (expand-file-name "~/XNEWS"))
+; Let the byte-compiler know that we know about this variable.
+(defvar rmail-default-rmail-file)
+
+(defvar gnus-cache-removeable-articles nil)
(defconst gnus-summary-local-variables
'(gnus-newsgroup-name
gnus-newsgroup-last-folder gnus-newsgroup-last-file
gnus-newsgroup-auto-expire gnus-newsgroup-unreads
gnus-newsgroup-unselected gnus-newsgroup-marked
+ gnus-newsgroup-reads
gnus-newsgroup-replied gnus-newsgroup-expirable
gnus-newsgroup-processable gnus-newsgroup-killed
gnus-newsgroup-bookmarks gnus-newsgroup-dormant
gnus-score-alist gnus-current-score-file gnus-summary-expunge-below
gnus-summary-mark-below gnus-newsgroup-active gnus-scores-exclude-files
gnus-newsgroup-history gnus-newsgroup-ancient
- gnus-newsgroup-adaptive)
+ (gnus-newsgroup-adaptive . gnus-use-adaptive-scoring)
+ gnus-cache-removeable-articles)
"Variables that are buffer-local to the summary buffers.")
(defconst gnus-bug-message
(autoload 'mail-extract-address-components "mail-extr")
(autoload 'nnmail-split-fancy "nnmail")
+ (autoload 'nnvirtual-catchup-group "nnvirtual")
;; timezone
(autoload 'timezone-make-date-arpa-standard "timezone")
(autoload 'rmail-count-new-messages "rmail")
(autoload 'rmail-show-message "rmail")
+ ;; gnus-soup
+ ;;(autoload 'gnus-group-brew-soup "gnus-soup" nil t)
+ ;;(autoload 'gnus-brew-soup "gnus-soup" nil t)
+ ;;(autoload 'gnus-soup-add-article "gnus-soup" nil t)
+ ;;(autoload 'gnus-soup-send-replies "gnus-soup" nil t)
+ ;;(autoload 'gnus-soup-save-areas "gnus-soup" nil t)
+ ;;(autoload 'gnus-soup-pack-packet "gnus-soup" nil t)
+ ;;(autoload 'nnsoup-pack-replies "nnsoup" nil t)
+
;; gnus-mh
(autoload 'gnus-mail-reply-using-mhe "gnus-mh")
(autoload 'gnus-mail-forward-using-mhe "gnus-mh")
(autoload 'gnus-article-push-button "gnus-vis" nil t)
(autoload 'gnus-article-press-button "gnus-vis" nil t)
(autoload 'gnus-article-highlight "gnus-vis" nil t)
+ (autoload 'gnus-article-highlight-some "gnus-vis" nil t)
(autoload 'gnus-article-hide "gnus-vis" nil t)
(autoload 'gnus-article-hide-signature "gnus-vis" nil t)
(autoload 'gnus-article-highlight-headers "gnus-vis" nil t)
;; gnus-cache
(autoload 'gnus-cache-possibly-enter-article "gnus-cache")
(autoload 'gnus-cache-save-buffers "gnus-cache")
- (autoload 'gnus-cache-possibly-remove-article "gnus-cache")
+ (autoload 'gnus-cache-possibly-remove-articles "gnus-cache")
(autoload 'gnus-cache-request-article "gnus-cache")
(autoload 'gnus-cache-retrieve-headers "gnus-cache")
(autoload 'gnus-cache-possibly-alter-active "gnus-cache")
(autoload 'gnus-jog-cache "gnus-cache" nil t)
+ (autoload 'gnus-cache-enter-remove-article "gnus-cache")
;; gnus-score
(autoload 'gnus-summary-increase-score "gnus-score" nil t)
(autoload 'gnus-current-score-file-nondirectory "gnus-score")
(autoload 'gnus-score-adaptive "gnus-score")
(autoload 'gnus-score-remove-lines-adaptive "gnus-score")
- (autoload 'gnus-possibly-score-headers "gnus-score")
(autoload 'gnus-score-find-trace "gnus-score")
+ ;; gnus-edit
+ (autoload 'gnus-score-customize "gnus-edit" nil t)
+
;; gnus-uu
(autoload 'gnus-uu-extract-map "gnus-uu" nil nil 'keymap)
(autoload 'gnus-uu-mark-map "gnus-uu" nil nil 'keymap)
(autoload 'gnus-mail-other-window-using-mail "gnus-msg")
(autoload 'gnus-article-mail-with-original "gnus-msg")
(autoload 'gnus-article-mail "gnus-msg")
+ (autoload 'gnus-bug "gnus-msg" nil t)
;; gnus-vm
(autoload 'gnus-summary-save-in-vm "gnus-vm" nil t)
(defsubst gnus-buffer-substring (beg end)
(buffer-substring (match-beginning beg) (match-end end)))
+;; modified by MORIOKA Tomohiko <morioka@jaist.ac.jp>
+;; function `substring' might cut on a middle of multi-octet
+;; character.
+(defun gnus-truncate-string (str width)
+ (substring str 0 width))
+
+;; Added by Geoffrey T. Dairiki <dairiki@u.washington.edu>. A safe way
+;; to limit the length of a string. This function is necessary since
+;; `(substr "abc" 0 30)' pukes with "Args out of range".
+(defsubst gnus-limit-string (str width)
+ (if (> (length str) width)
+ (substring str 0 width)
+ str))
+
(defsubst gnus-simplify-subject-re (subject)
"Remove \"Re:\" from subject lines."
(let ((case-fold-search t))
(` (delete-region (progn (beginning-of-line) (point))
(progn (forward-line (, (or n 1))) (point)))))
+;; Suggested by Brian Edmonds <edmonds@cs.ubc.ca>.
+(defvar gnus-init-inhibit nil)
+(defun gnus-read-init-file (&optional inhibit-next)
+ (if gnus-init-inhibit
+ (setq gnus-init-inhibit nil)
+ (setq gnus-init-inhibit inhibit-next)
+ (and gnus-init-file
+ (or (and (file-exists-p gnus-init-file)
+ ;; Don't try to load a directory.
+ (not (file-directory-p gnus-init-file)))
+ (file-exists-p (concat gnus-init-file ".el"))
+ (file-exists-p (concat gnus-init-file ".elc")))
+ (load gnus-init-file nil t))))
+
+;;; Load the user startup file.
+;; (eval '(gnus-read-init-file 'inhibit))
+
;;; Load the compatability functions.
+(require 'gnus-cus)
(require 'gnus-ems)
\f
(defun gnus-extract-address-components (from)
(let (name address)
+ ;; First find the address - the thing with the @ in it. This may
+ ;; not be accurate in mail addresses, but does the trick most of
+ ;; the time in news messages.
(if (string-match "\\b[^@ \t<>]+[!@][^@ \t<>]+\\b" from)
(setq address (substring from (match-beginning 0) (match-end 0))))
+ ;; Then we check whether the "name <address>" format is used.
(and address
(string-match (concat "<" (regexp-quote address) ">") from)
- (setq name (substring from 0 (1- (match-beginning 0)))))
+ (and (setq name (substring from 0 (1- (match-beginning 0))))
+ ;; Strip any quotes from the name.
+ (string-match "\".*\"" name)
+ (setq name (substring name 1 (1- (match-end 0))))))
+ ;; If not, then "address (name)" is used.
(or name
(and (string-match "(.+)" from)
(setq name (substring from (1+ (match-beginning 0))
- (1- (match-end 0))))))
+ (1- (match-end 0)))))
+ (and (string-match "()" from)
+ (setq name address))
+ ;; Fix by MORIOKA Tomohiko <morioka@jaist.ac.jp>.
+ ;; XOVER might not support folded From headers.
+ (and (string-match "(.*" from)
+ (setq name (substring from (1+ (match-beginning 0))
+ (match-end 0)))))
;; Fix by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>.
(list (or name from) (or address from))))
(1- (point))
(point-max)))))
+(defvar gnus-old-specs nil)
+
(defun gnus-update-format-specifications ()
(gnus-make-thread-indent-array)
- (setq gnus-summary-line-format-spec
- (gnus-parse-format
- gnus-summary-line-format gnus-summary-line-format-alist))
+
+ (let ((formats '(summary summary-dummy group
+ summary-mode group-mode article-mode))
+ old-format new-format)
+ (while formats
+ (setq new-format (symbol-value
+ (intern (format "gnus-%s-line-format" (car formats)))))
+ (or (and (setq old-format (cdr (assq (car formats) gnus-old-specs)))
+ (equal old-format new-format))
+ (set (intern (format "gnus-%s-line-format-spec" (car formats)))
+ (gnus-parse-format
+ new-format
+ (symbol-value
+ (intern (format "gnus-%s-line-format-alist"
+ (if (eq (car formats) 'article-mode)
+ 'summary-mode (car formats))))))))
+ (setq gnus-old-specs (cons (cons (car formats) new-format)
+ (delq (car formats) gnus-old-specs)))
+ (setq formats (cdr formats))))
+
+ (gnus-update-group-mark-positions)
(gnus-update-summary-mark-positions)
- (setq gnus-summary-dummy-line-format-spec
- (gnus-parse-format gnus-summary-dummy-line-format
- gnus-summary-dummy-line-format-alist))
- (setq gnus-group-line-format-spec
- (gnus-parse-format
- gnus-group-line-format
- gnus-group-line-format-alist))
+
(if (and (string-match "%D" gnus-group-line-format)
(not gnus-description-hashtb)
gnus-read-active-file)
- (gnus-read-descriptions-file))
- (setq gnus-summary-mode-line-format-spec
- (gnus-parse-format gnus-summary-mode-line-format
- gnus-summary-mode-line-format-alist))
- (setq gnus-article-mode-line-format-spec
- (gnus-parse-format gnus-article-mode-line-format
- gnus-summary-mode-line-format-alist))
- (setq gnus-group-mode-line-format-spec
- (gnus-parse-format gnus-group-mode-line-format
- gnus-group-mode-line-format-alist)))
+ (gnus-read-all-descriptions-files)))
(defun gnus-update-summary-mark-positions ()
(save-excursion
(- (point) 2))) pos))
(setq gnus-summary-mark-positions pos))))
-(defun gnus-format-max-width (form length)
- (let* ((val (eval form))
- (valstr (if (numberp val) (int-to-string val) val)))
- (if (> (length valstr) length)
- (substring valstr 0 length)
- valstr)))
-
-(defun gnus-set-mouse-face (string)
- ;; Set mouse face property on STRING.
- (put-text-property 0 (length string) 'mouse-face gnus-mouse-face string)
- string)
+(defun gnus-update-group-mark-positions ()
+ (save-excursion
+ (let ((gnus-process-mark 128)
+ (gnus-group-marked '("dummy.group")))
+ (gnus-sethash "dummy.group" '(0 . 0) gnus-active-hashtb)
+ (gnus-set-work-buffer)
+ (gnus-group-insert-group-line nil "dummy.group" 0 nil 0 nil)
+ (goto-char (point-min))
+ (setq gnus-group-mark-positions
+ (list (cons 'process (and (search-forward "\200" nil t)
+ (- (point) 2))))))))
+
+(defun gnus-mouse-face-function (form)
+ (` (let ((string (, form)))
+ (put-text-property 0 (length string) 'mouse-face gnus-mouse-face string)
+ string)))
+
+(defun gnus-max-width-function (el max-width)
+ (or (numberp max-width) (signal 'wrong-type-argument '(numberp max-width)))
+ (` (let* ((val (eval (, el)))
+ (valstr (if (numberp val)
+ (int-to-string val) val)))
+ (if (> (length valstr) (, max-width))
+ (substring valstr 0 (, max-width))
+ valstr))))
(defun gnus-parse-format (format spec-alist)
;; This function parses the FORMAT string with the help of the
(post (substring format (match-beginning 3) (match-end 3))))
(list 'concat
(gnus-parse-simple-format pre spec-alist)
- (list 'gnus-set-mouse-face
- (gnus-parse-simple-format button spec-alist))
+ (gnus-mouse-face-function
+ (gnus-parse-simple-format button spec-alist))
(gnus-parse-simple-format post spec-alist)))
(gnus-parse-simple-format
(concat (substring format (match-beginning 1) (match-end 1))
;; specification string, and a list of forms depending on the
;; SPEC-ALIST.
(let ((max-width 0)
- spec flist fstring b newspec max-width elem beg)
+ spec flist fstring newspec elem beg)
(save-excursion
(gnus-set-work-buffer)
(insert format)
(setq el (list 'char-to-string el)))
((= (car (cdr elem)) ?d)
(numberp el) (setq el (list 'int-to-string el))))
- (setq flist (cons (list 'gnus-format-max-width el max-width)
+ (setq flist (cons (gnus-max-width-function el max-width)
flist))
(setq newspec ?s))
(setq flist (cons (car elem) flist))
(setq fstring (buffer-substring 1 (point-max))))
(cons 'format (cons fstring (nreverse flist)))))
-;; Suggested by Brian Edmonds <edmonds@cs.ubc.ca>.
-(defun gnus-read-init-file ()
- (and gnus-init-file
- (or (and (file-exists-p gnus-init-file)
- ;; Don't try to load a directory.
- (not (file-directory-p gnus-init-file)))
- (file-exists-p (concat gnus-init-file ".el"))
- (file-exists-p (concat gnus-init-file ".elc")))
- (load gnus-init-file nil t)))
-
(defun gnus-set-work-buffer ()
(if (get-buffer gnus-work-buffer)
(progn
(set-buffer gnus-work-buffer)
(erase-buffer))
(set-buffer (get-buffer-create gnus-work-buffer))
+ (kill-all-local-variables)
(buffer-disable-undo (current-buffer))
(gnus-add-current-to-buffer-list)))
(concat (if (gnus-use-long-file-name 'not-save)
(gnus-capitalize-newsgroup newsgroup)
(gnus-newsgroup-directory-form newsgroup))
- "/" (int-to-string (header-number headers)))
+ "/" (int-to-string (mail-header-number headers)))
(or gnus-article-save-directory "~/News"))))
(if (and last-file
(string-equal (file-name-directory default)
(defun gnus-numeric-save-name (newsgroup headers &optional last-file)
"Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
-If variable `gnus-use-long-file-name' is nil, it is ~/News/news.group/num.
-Otherwise, it is like ~/News/news/group/num."
+If variable `gnus-use-long-file-name' is non-nil, it is
+~/News/news.group/num. Otherwise, it is like ~/News/news/group/num."
(let ((default
(expand-file-name
(concat (if (gnus-use-long-file-name 'not-save)
newsgroup
(gnus-newsgroup-directory-form newsgroup))
- "/" (int-to-string (header-number headers)))
+ "/" (int-to-string (mail-header-number headers)))
(or gnus-article-save-directory "~/News"))))
(if (and last-file
(string-equal (file-name-directory default)
(defun gnus-Plain-save-name (newsgroup headers &optional last-file)
"Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
-If variable `gnus-use-long-file-name' is nil, it is ~/News/News.group.
-Otherwise, it is like ~/News/news/group/news."
+If variable `gnus-use-long-file-name' is non-nil, it is
+~/News/News.group. Otherwise, it is like ~/News/news/group/news."
(or last-file
(expand-file-name
(if (gnus-use-long-file-name 'not-save)
(defun gnus-plain-save-name (newsgroup headers &optional last-file)
"Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
-If variable `gnus-use-long-file-name' is nil, it is ~/News/news.group.
-Otherwise, it is like ~/News/news/group/news."
+If variable `gnus-use-long-file-name' is non-nil, it is
+~/News/news.group. Otherwise, it is like ~/News/news/group/news."
(or last-file
(expand-file-name
(if (gnus-use-long-file-name 'not-save)
(defun gnus-subscribe-hierarchical-interactive (groups)
(let ((groups (sort groups 'string<))
- prefixes prefix start rest ans group starts)
+ prefixes prefix start ans group starts)
(while groups
(setq prefixes (list "^"))
(while (and groups prefixes)
(defun gnus-newsgroup-directory-form (newsgroup)
"Make hierarchical directory name from NEWSGROUP name."
- (let ((newsgroup (substring newsgroup 0)) ;Copy string.
+ (let ((newsgroup (gnus-newsgroup-saveable-name newsgroup))
(len (length newsgroup))
idx)
;; If this is a foreign group, we don't want to translate the
(setq idx (1+ idx)))
newsgroup))
+(defun gnus-newsgroup-saveable-name (group)
+ ;; Replace any slashes in a group name (eg. an ange-ftp nndoc group)
+ ;; with dots.
+ (gnus-replace-chars-in-string group ?/ ?.))
+
(defun gnus-make-directory (dir)
"Make DIRECTORY recursively."
+ ;; Why don't we use `(make-directory dir 'parents)'? That's just one
+ ;; of the many mysteries of the universe.
(let* ((dir (expand-file-name dir default-directory))
- dirs)
+ dirs err)
(if (string-match "/$" dir)
(setq dir (substring dir 0 (match-beginning 0))))
+ ;; First go down the path until we find a directory that exists.
(while (not (file-exists-p dir))
(setq dirs (cons dir dirs))
(string-match "/[^/]+$" dir)
(setq dir (substring dir 0 (match-beginning 0))))
- (while dirs
- (make-directory (car dirs))
- (setq dirs (cdr dirs)))))
+ ;; Then create all the subdirs.
+ (while (and dirs (not err))
+ (condition-case ()
+ (make-directory (car dirs))
+ (error (setq err t)))
+ (setq dirs (cdr dirs)))
+ ;; We return whether we were successful or not.
+ (not dirs)))
(defun gnus-capitalize-newsgroup (newsgroup)
"Capitalize NEWSGROUP name."
(save-excursion
(gnus-set-work-buffer)
(insert subject)
- (gnus-simplify-buffer-fuzzy)
+ (inline (gnus-simplify-buffer-fuzzy))
(buffer-string))))
(defun gnus-simplify-buffer-fuzzy ()
(goto-char (point-min))
- (while (re-search-forward "^[ \t]*re:[ \t]*" nil t)
+ ;; Fix by Stainless Steel Rat <ratinox@ccs.neu.edu>.
+ (while (re-search-forward "^[ \t]*\\(re\\|fwd\\)[[{(^0-9]*[])}]?[:;][ \t]*"
+ nil t)
(replace-match "" t t))
(goto-char (point-min))
(while (re-search-forward "[ \t\n]*([^()]*)[ \t\n]*$" nil t)
(replace-match "" t t))
(goto-char (point-min))
(while (re-search-forward "^[ \t]+" nil t)
- (replace-match "" t t)))
+ (replace-match "" t t))
+ (if gnus-simplify-subject-fuzzy-regexp
+ (while (re-search-forward gnus-simplify-subject-fuzzy-regexp nil t)
+ (replace-match "" t t))))
;; Add the current buffer to the list of buffers to be killed on exit.
(defun gnus-add-current-to-buffer-list ()
- (setq gnus-buffer-list (cons (current-buffer) gnus-buffer-list)))
+ (or (memq (current-buffer) gnus-buffer-list)
+ (setq gnus-buffer-list (cons (current-buffer) gnus-buffer-list))))
(defun gnus-string> (s1 s2)
(not (or (string< s1 s2)
;; Functions are more convenient than macros in some cases.
(defun gnus-header-number (header)
- (header-number header))
+ (mail-header-number header))
(defun gnus-header-subject (header)
- (header-subject header))
+ (mail-header-subject header))
(defun gnus-header-from (header)
- (header-from header))
+ (mail-header-from header))
(defun gnus-header-xref (header)
- (header-xref header))
+ (mail-header-xref header))
(defun gnus-header-lines (header)
- (header-lines header))
+ (mail-header-lines header))
(defun gnus-header-date (header)
- (header-date header))
+ (mail-header-date header))
(defun gnus-header-id (header)
- (header-id header))
+ (mail-header-id header))
+
+(defun gnus-header-message-id (header)
+ (mail-header-id header))
+
+(defun gnus-header-chars (header)
+ (mail-header-chars header))
(defun gnus-header-references (header)
- (header-references header))
+ (mail-header-references header))
;;; General various misc type functions.
(setq i (1+ i)))
(list (nreverse out)))))
-(defun gnus-configure-windows (setting)
+(defun gnus-add-configuration (conf)
+ (setq gnus-buffer-configuration
+ (cons conf (delq (assq (car conf) gnus-buffer-configuration)
+ gnus-buffer-configuration))))
+
+(defun gnus-configure-windows (setting &optional force)
(setq setting (gnus-windows-old-to-new setting))
(let ((r (if (symbolp setting)
- (cdr (assq setting gnus-buffer-configuration))
- setting))
+ (cdr (assq setting gnus-buffer-configuration))
+ setting))
(in-buf (current-buffer))
- rule val window w height hor ohor heights sub jump-buffer
- rel total to-buf)
+ rule val w height hor ohor heights sub jump-buffer
+ rel total to-buf all-visible)
(or r (error "No such setting: %s" setting))
- ;; Either remove all windows or just remove all Gnus windows.
- (if gnus-use-full-window
- (delete-other-windows)
- (gnus-remove-some-windows)
- (switch-to-buffer nntp-server-buffer))
-
- (while r
- (setq hor (car r)
- ohor nil)
-
- ;; We have to do the (possible) horizontal splitting before the
- ;; vertical.
- (if (and (listp (car hor))
- (eq (car (car hor)) 'horizontal))
- (progn
- (split-window nil (- (frame-width)
- (floor (* (frame-width) (nth 1 (car hor)))))
- t)
- (setq hor (cdr hor))))
-
- ;; Go through the rules and eval the elements that are to be
- ;; evaled.
- (while hor
- (if (setq val (if (vectorp (car hor)) (car hor) (eval (car hor))))
+ (if (and (not force) (setq all-visible (gnus-all-windows-visible-p r)))
+ ;; All the windows mentioned are already visibe, so we just
+ ;; put point in the assigned buffer, and do not touch the
+ ;; winconf.
+ (select-window (get-buffer-window all-visible))
+
+ ;; Either remove all windows or just remove all Gnus windows.
+ (if gnus-use-full-window
+ (delete-other-windows)
+ (gnus-remove-some-windows)
+ (switch-to-buffer nntp-server-buffer))
+
+ (while r
+ (setq hor (car r)
+ ohor nil)
+
+ ;; We have to do the (possible) horizontal splitting before the
+ ;; vertical.
+ (if (and (listp (car hor))
+ (eq (car (car hor)) 'horizontal))
(progn
- ;; Expand short buffer name.
- (setq w (aref val 0))
- (and (setq w (cdr (assq w gnus-window-to-buffer)))
- (progn
- (setq val (apply 'vector (mapcar (lambda (v) v) val)))
- (aset val 0 w)))
- (setq ohor (cons val ohor))))
- (setq hor (cdr hor)))
- (setq rule (cons (nreverse ohor) rule))
- (setq r (cdr r)))
- (setq rule (nreverse rule))
-
- ;; We tally the window sizes.
- (setq total (window-height))
- (while rule
- (setq hor (car rule))
- (if (and (listp (car hor)) (eq (car (car hor)) 'horizontal))
+ (split-window
+ nil
+ (if (integerp (nth 1 (car hor)))
+ (nth 1 (car hor))
+ (- (frame-width) (floor (* (frame-width) (nth 1 (car hor))))))
+ t)
+ (setq hor (cdr hor))))
+
+ ;; Go through the rules and eval the elements that are to be
+ ;; evaled.
+ (while hor
+ (if (setq val (if (vectorp (car hor)) (car hor) (eval (car hor))))
+ (progn
+ ;; Expand short buffer name.
+ (setq w (aref val 0))
+ (and (setq w (cdr (assq w gnus-window-to-buffer)))
+ (progn
+ (setq val (apply 'vector (mapcar 'identity val)))
+ (aset val 0 w)))
+ (setq ohor (cons val ohor))))
+ (setq hor (cdr hor)))
+ (setq rule (cons (nreverse ohor) rule))
+ (setq r (cdr r)))
+ (setq rule (nreverse rule))
+
+ ;; We tally the window sizes.
+ (setq total (window-height))
+ (while rule
+ (setq hor (car rule))
+ (if (and (listp (car hor)) (eq (car (car hor)) 'horizontal))
+ (setq hor (cdr hor)))
+ (setq sub 0)
+ (while hor
+ (setq rel (aref (car hor) 1)
+ heights (cons
+ (cond ((and (floatp rel) (= 1.0 rel))
+ 'x)
+ ((integerp rel)
+ rel)
+ (t
+ (max (floor (* total rel)) 4)))
+ heights)
+ sub (+ sub (if (numberp (car heights)) (car heights) 0))
+ hor (cdr hor)))
+ (setq heights (nreverse heights)
+ hor (car rule))
+
+ ;; We then go through these heighs and create windows for them.
+ (while heights
+ (setq height (car heights)
+ heights (cdr heights))
+ (and (eq height 'x)
+ (setq height (- total sub)))
+ (and heights
+ (split-window nil height))
+ (setq to-buf (aref (car hor) 0))
+ (switch-to-buffer
+ (cond ((not to-buf)
+ in-buf)
+ ((symbolp to-buf)
+ (symbol-value (aref (car hor) 0)))
+ (t
+ (aref (car hor) 0))))
+ (and (> (length (car hor)) 2)
+ (eq (aref (car hor) 2) 'point)
+ (setq jump-buffer (current-buffer)))
+ (other-window 1)
(setq hor (cdr hor)))
- (setq sub 0)
- (while hor
- (setq rel (aref (car hor) 1)
- heights (cons
- (cond ((and (floatp rel) (= 1.0 rel))
- 'x)
- ((integerp rel)
- rel)
- (t
- (max (floor (* total rel)) 4)))
- heights)
- sub (+ sub (if (numberp (car heights)) (car heights) 0))
- hor (cdr hor)))
- (setq heights (nreverse heights)
- hor (car rule))
-
- ;; We then go through these heighs and create windows for them.
- (while heights
- (setq height (car heights)
- heights (cdr heights))
- (and (eq height 'x)
- (setq height (- total sub)))
- (and heights
- (split-window nil height))
- (setq to-buf (aref (car hor) 0))
- (switch-to-buffer
- (cond ((not to-buf)
- in-buf)
- ((symbolp to-buf)
- (symbol-value (aref (car hor) 0)))
- (t
- (aref (car hor) 0))))
- (and (> (length (car hor)) 2)
- (eq (aref (car hor) 2) 'point)
- (setq jump-buffer (current-buffer)))
- (other-window 1)
- (setq hor (cdr hor)))
- (setq rule (cdr rule)))
-
- ;; Finally, we pop to the buffer that's supposed to have point.
- (or jump-buffer (error "Missing `point' in spec for %s" setting))
+ (setq rule (cdr rule)))
+
+ ;; Finally, we pop to the buffer that's supposed to have point.
+ (or jump-buffer (error "Missing `point' in spec for %s" setting))
+
+ (select-window (get-buffer-window jump-buffer))
+ (set-buffer jump-buffer))))
+
+(defun gnus-all-windows-visible-p (rule)
+ (let (invisible hor jump-buffer val buffer)
+ ;; Go through the rules and eval the elements that are to be
+ ;; evaled.
+ (while (and rule (not invisible))
+ (setq hor (car rule)
+ rule (cdr rule))
+ (while (and hor (not invisible))
+ (if (setq val (if (vectorp (car hor))
+ (car hor)
+ (if (not (eq (car (car hor)) 'horizontal))
+ (eval (car hor)))))
+ (progn
+ ;; Expand short buffer name.
+ (setq buffer (or (cdr (assq (aref val 0) gnus-window-to-buffer))
+ (aref val 0)))
+ (setq buffer (if (symbolp buffer) (symbol-value buffer)
+ buffer))
+ (and (> (length val) 2) (eq 'point (aref val 2))
+ (setq jump-buffer buffer))
+ (setq invisible (not (and buffer (get-buffer-window buffer))))))
+ (setq hor (cdr hor))))
+ (and (not invisible) jump-buffer)))
+
+(defun gnus-window-top-edge (&optional window)
+ (nth 1 (window-edges window)))
- (pop-to-buffer jump-buffer)
- jump-buffer))
-
(defun gnus-remove-some-windows ()
(let ((buffers gnus-window-to-buffer)
- (first t)
- buf)
- (while buffers
- (setq buf (cdr (car buffers)))
- (if (symbolp buf)
- (setq buf (and (boundp buf) (symbol-value buf))))
- (and buf
- (get-buffer-window buf)
- (progn
- (set-buffer buf)
- (if first
+ buf bufs lowest-buf lowest)
+ (save-excursion
+ ;; Remove windows on all known Gnus buffers.
+ (while buffers
+ (setq buf (cdr (car buffers)))
+ (if (symbolp buf)
+ (setq buf (and (boundp buf) (symbol-value buf))))
+ (and buf
+ (get-buffer-window buf)
+ (progn
+ (setq bufs (cons buf bufs))
+ (pop-to-buffer buf)
+ (if (or (not lowest)
+ (< (gnus-window-top-edge) lowest))
+ (progn
+ (setq lowest (gnus-window-top-edge))
+ (setq lowest-buf buf)))))
+ (setq buffers (cdr buffers)))
+ ;; Remove windows on *all* summary buffers.
+ (let (wins)
+ (walk-windows
+ (lambda (win)
+ (let ((buf (window-buffer win)))
+ (if (string-match "^\\*Summary" (buffer-name buf))
(progn
- (switch-to-buffer nntp-server-buffer)
- (setq first nil))
- (delete-window (get-buffer-window buf)))))
- (setq buffers (cdr buffers)))
- (set-buffer nntp-server-buffer)))
-
+ (setq bufs (cons buf bufs))
+ (pop-to-buffer buf)
+ (if (or (not lowest)
+ (< (gnus-window-top-edge) lowest))
+ (progn
+ (setq lowest-buf buf)
+ (setq lowest (gnus-window-top-edge))))))))))
+ (and lowest-buf
+ (progn
+ (pop-to-buffer lowest-buf)
+ (switch-to-buffer nntp-server-buffer)))
+ (while bufs
+ (and (not (eq (car bufs) lowest-buf))
+ (delete-windows-on (car bufs)))
+ (setq bufs (cdr bufs))))))
+
(defun gnus-version ()
"Version numbers of this version of Gnus."
(interactive)
(gnus-configure-windows 'info)
(Info-goto-node (car (cdr (assq mode gnus-info-nodes))))))
-(defun gnus-bug ()
- "Send a bug report to the Gnus maintainers."
- (interactive)
- (let ((winconf (current-window-configuration)))
- (delete-other-windows)
- (switch-to-buffer "*Gnus Bug Help*")
- (erase-buffer)
- (insert gnus-bug-message)
- (goto-char (point-min))
- (pop-to-buffer "*Gnus Bug*")
- (erase-buffer)
- (mail-mode)
- (mail-setup gnus-maintainer nil nil nil nil nil)
- (make-local-variable 'gnus-prev-winconf)
- (setq gnus-prev-winconf winconf)
- (goto-char (point-min))
- (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$"))
- (forward-line 1)
- (insert (format "%s\n%s\n\n\n\n\n" (gnus-version) (emacs-version)))
- (let ((b (point)))
- (gnus-debug)
- (goto-char (- b 3)))
- (message "")))
-
-(defun gnus-debug ()
- "Attemps to go through the Gnus source file and report what variables have been changed.
-The source file has to be in the Emacs load path."
- (interactive)
- (let ((files '("gnus.el" "gnus-msg.el" "gnus-score.el"))
- file dirs expr olist)
- (save-excursion
- (set-buffer (get-buffer-create " *gnus bug info*"))
- (buffer-disable-undo (current-buffer))
- (message "Please wait while we snoop your variables...")
- (sit-for 0)
- (while files
- (erase-buffer)
- (setq dirs load-path)
- (while dirs
- (if (or (not (car dirs))
- (not (stringp (car dirs)))
- (not (file-exists-p
- (setq file (concat (file-name-as-directory
- (car dirs)) (car files))))))
- (setq dirs (cdr dirs))
- (setq dirs nil)
- (insert-file-contents file)
- (goto-char (point-min))
- (or (re-search-forward "^;;* Internal variables" nil t)
- (error "Malformed sources in file %s" file))
- (narrow-to-region (point-min) (point))
- (goto-char (point-min))
- (while (setq expr (condition-case ()
- (read (current-buffer)) (error nil)))
- (and (eq (car expr) 'defvar)
- (stringp (nth 3 expr))
- (or (not (boundp (nth 1 expr)))
- (not (equal (eval (nth 2 expr))
- (symbol-value (nth 1 expr)))))
- (setq olist (cons (nth 1 expr) olist))))))
- (setq files (cdr files)))
- (kill-buffer (current-buffer)))
- (insert "------------------- Environment follows -------------------\n\n")
- (while olist
- (if (boundp (car olist))
- (insert "(setq " (symbol-name (car olist)) " '"
- (prin1-to-string (symbol-value (car olist))) ")\n")
- (insert ";; (makeunbound '" (symbol-name (car olist)) ")\n"))
- (setq olist (cdr olist)))
- (insert "\n\n")))
-
(defun gnus-overload-functions (&optional overloads)
"Overload functions specified by optional argument OVERLOADS.
If nothing is specified, use the variable gnus-overload-functions."
(load (car (cdr (cdr defs))) nil 'nomessage))
(fset (car defs) (car (cdr defs))))))
-(defun gnus-replace-chars-in-string (string from to)
+(defun gnus-replace-chars-in-string (string &rest pairs)
"Replace characters in STRING from FROM to TO."
(let ((string (substring string 0)) ;Copy string.
(len (length string))
- (idx 0))
+ (idx 0)
+ sym to)
+ (or (zerop (% (length pairs) 2))
+ (error "Odd number of translation pairs"))
+ (setplist 'sym pairs)
;; Replace all occurrences of FROM with TO.
(while (< idx len)
- (if (= (aref string idx) from)
+ (if (setq to (get 'sym (aref string idx)))
(aset string idx to))
(setq idx (1+ idx)))
string))
;; from `message'.
(apply 'format args)))
+;; Generate a unique new group name.
+(defun gnus-generate-new-group-name (leaf)
+ (let ((name leaf)
+ (num 0))
+ (while (gnus-gethash name gnus-newsrc-hashtb)
+ (setq name (concat leaf "<" (int-to-string (setq num (1+ num))) ">")))
+ name))
+
;;; List and range functions
(defun gnus-last-element (list)
;; This function modifies LIST1.
(let* ((top (cons nil list1))
(prev top))
- (while (and list1 list2)
- (cond ((= (car list1) (car list2))
- (setq prev list1
- list1 (cdr list1)
- list2 (cdr list2)))
- ((< (car list1) (car list2))
- (setcdr prev (cdr list1))
- (setq list1 (cdr list1)))
- (t
- (setq list2 (cdr list2)))))
- (setcdr prev nil)
- (cdr top)))
+ (while (and list1 list2)
+ (cond ((= (car list1) (car list2))
+ (setq prev list1
+ list1 (cdr list1)
+ list2 (cdr list2)))
+ ((< (car list1) (car list2))
+ (setcdr prev (cdr list1))
+ (setq list1 (cdr list1)))
+ (t
+ (setq list2 (cdr list2)))))
+ (setcdr prev nil)
+ (cdr top)))
(defun gnus-compress-sequence (numbers &optional always-list)
"Convert list of numbers to a list of ranges or a single range.
(define-key gnus-group-mode-map "\177" 'gnus-group-prev-unread-group)
(define-key gnus-group-mode-map "N" 'gnus-group-next-group)
(define-key gnus-group-mode-map "P" 'gnus-group-prev-group)
- (define-key gnus-group-mode-map "\M-n" 'gnus-group-next-unread-group-same-level)
- (define-key gnus-group-mode-map "\M-p" 'gnus-group-prev-unread-group-same-level)
+ (define-key gnus-group-mode-map
+ "\M-n" 'gnus-group-next-unread-group-same-level)
+ (define-key gnus-group-mode-map
+ "\M-p" 'gnus-group-prev-unread-group-same-level)
(define-key gnus-group-mode-map "," 'gnus-group-best-unread-group)
(define-key gnus-group-mode-map "." 'gnus-group-first-unread-group)
(define-key gnus-group-mode-map "u" 'gnus-group-unsubscribe-current-group)
(define-key gnus-group-group-map "v" 'gnus-group-add-to-virtual)
(define-key gnus-group-group-map "V" 'gnus-group-make-empty-virtual)
(define-key gnus-group-group-map "D" 'gnus-group-enter-directory)
+ (define-key gnus-group-group-map "f" 'gnus-group-make-doc-group)
+ ;;(define-key gnus-group-group-map "sb" 'gnus-group-brew-soup)
+ ;;(define-key gnus-group-group-map "sw" 'gnus-soup-save-areas)
+ ;;(define-key gnus-group-group-map "ss" 'gnus-soup-send-replies)
+ ;;(define-key gnus-group-group-map "sp" 'gnus-soup-pack-packet)
+ ;;(define-key gnus-group-group-map "sr" 'nnsoup-pack-replies)
(define-prefix-command 'gnus-group-list-map)
(define-key gnus-group-mode-map "A" 'gnus-group-list-map)
(mouse-set-point e)
(gnus-group-read-group nil))
+;; Look at LEVEL and find out what the level is really supposed to be.
+;; If LEVEL is non-nil, LEVEL will be returned, if not, what happens
+;; will depend on whether `gnus-group-use-permanent-levels' is used.
+(defun gnus-group-default-level (&optional level number-or-nil)
+ (cond
+ (gnus-group-use-permanent-levels
+ (setq gnus-group-default-list-level
+ (or level gnus-group-default-list-level))
+ (or gnus-group-default-list-level gnus-level-subscribed))
+ (number-or-nil
+ level)
+ (t
+ (or level gnus-group-default-list-level gnus-level-subscribed))))
+
+
;;;###autoload
(defun gnus-no-server (&optional arg)
"Read network news.
prompt the user for the name of an NNTP server to use.
As opposed to `gnus', this command will not connect to the local server."
(interactive "P")
+ (setq gnus-group-use-permanent-levels t)
(gnus (or arg (1- gnus-level-default-subscribed)) t))
-(defalias '\(ding\) 'gnus)
-
;;;###autoload
(defun gnus (&optional arg dont-connect)
"Read network news.
(progn
(switch-to-buffer gnus-group-buffer)
(gnus-group-get-new-news))
+
(gnus-clear-system)
+
(nnheader-init-server-buffer)
(gnus-read-init-file)
+
+ (gnus-group-setup-buffer)
+ (let ((buffer-read-only nil))
+ (erase-buffer)
+ (if (not gnus-inhibit-startup-message)
+ (progn
+ (gnus-group-startup-message)
+ (sit-for 0))))
+
(let ((level (and arg (numberp arg) (> arg 0) arg))
did-connect)
(unwind-protect
(progn
- (gnus-group-setup-buffer)
(or dont-connect
(setq did-connect
(gnus-start-news-server (and arg (not level))))))
(gnus-group-quit)
(run-hooks 'gnus-startup-hook)
;; NNTP server is successfully open.
- (gnus-update-format-specifications)
+
+ ;; Find the current startup file name.
+ (setq gnus-current-startup-file
+ (gnus-make-newsrc-file gnus-startup-file))
+
+ ;; Read the dribble file.
+ (and gnus-use-dribble-file (gnus-dribble-read-file))
+
(gnus-summary-make-display-table)
- (let ((buffer-read-only nil))
- (erase-buffer)
- (if (not gnus-inhibit-startup-message)
- (progn
- (gnus-group-startup-message)
- (sit-for 0))))
(gnus-setup-news nil level)
- (and gnus-use-dribble-file (gnus-dribble-open))
(gnus-group-list-groups level)
(gnus-configure-windows 'group))))))
+(defun gnus-unload ()
+ "Unload all Gnus features."
+ (interactive)
+ (or (boundp 'load-history)
+ (error "Sorry, `gnus-unload' is not implemented in this Emacs version."))
+ (let ((history load-history)
+ feature)
+ (while history
+ (and (string-match "^gnus" (car (car history)))
+ (setq feature (cdr (assq 'provide (car history))))
+ (unload-feature feature 'force))
+ (setq history (cdr history)))))
+
(defun gnus-group-startup-message (&optional x y)
"Insert startup message in current buffer."
;; Insert the message.
(erase-buffer)
(insert
(format "
- %s
+ _ ___ _ _
+ _ ___ __ ___ __ _ ___
+ __ _ ___ __ ___
+ _ ___ _
+ _ _ __ _
+ ___ __ _
+ __ _
+ _ _ _
+ _ _ _
+ _ _ _
+ __ ___
+ _ _ _ _
+ _ _
+ _ _
+ _ _
+ _
+ __
+
+
+ Gnus * A newsreader for Emacsen
+ A Praxis release * larsi@ifi.uio.no
+"
+ gnus-version))
+ ;; And then hack it.
+ ;; 18 is the longest line.
+ (indent-rigidly (point-min) (point-max)
+ (/ (max (- (window-width) (or x 46)) 0) 2))
+ (goto-char (point-min))
+ (let* ((pheight (count-lines (point-min) (point-max)))
+ (wheight (window-height))
+ (rest (- wheight pheight)))
+ (insert (make-string (max 0 (* 2 (/ rest 3))) ?\n)))
+
+
+
+ ;; Fontify some.
+ (goto-char (point-min))
+ (search-forward "Praxis")
+ (put-text-property (match-beginning 0) (match-end 0) 'face 'bold)
+ (goto-char (point-min)))
+
+(defun gnus-group-startup-message-old (&optional x y)
+ "Insert startup message in current buffer."
+ ;; Insert the message.
+ (erase-buffer)
+ (insert
+ (format "
+ %s
A newsreader
for GNU Emacs
written by
Masanobu UMEDA
- Lars Magne
- Ingebrigtsen
+ A Praxis Release
larsi@ifi.uio.no
"
gnus-version))
(/ (max (- (window-width) (or x 28)) 0) 2))
(goto-char (point-min))
;; +4 is fuzzy factor.
- (insert-char ?\n (/ (max (- (window-height) (or y 12)) 0) 2)))
+ (insert-char ?\n (/ (max (- (window-height) (or y 12)) 0) 2))
+
+ ;; Fontify some.
+ (goto-char (point-min))
+ (search-forward "Praxis")
+ (put-text-property (match-beginning 0) (match-end 0) 'face 'bold)
+ (goto-char (point-min)))
(defun gnus-group-setup-buffer ()
(or (get-buffer gnus-group-buffer)
(gnus-group-mode)
(and gnus-carpal (gnus-carpal-setup-buffer 'group)))))
-(defun gnus-group-list-groups (level &optional unread)
- "List newsgroups with level LEVEL or lower that have unread alticles.
+(defun gnus-group-list-groups (&optional level unread)
+ "List newsgroups with level LEVEL or lower that have unread articles.
Default is all subscribed groups.
-If argument UNREAD is non-nil, groups with no unread articles are also listed."
- (interactive (list (and current-prefix-arg
- (prefix-numeric-value current-prefix-arg))))
- (if gnus-group-use-permanent-levels
- (progn
- (setq gnus-group-default-list-level
- (or level gnus-group-default-list-level))
- (setq level (or gnus-group-default-list-level gnus-level-subscribed)))
- (setq level (or level gnus-group-default-list-level
- gnus-level-subscribed)))
- (gnus-group-setup-buffer) ;May call from out of group buffer
+If argument UNREAD is non-nil, groups with no unread articles are also
+listed."
+ (interactive (list (if current-prefix-arg
+ (prefix-numeric-value current-prefix-arg)
+ (or
+ (gnus-group-default-level nil t)
+ gnus-group-default-list-level
+ gnus-level-subscribed))))
+ (or level
+ (setq level (car gnus-group-list-mode)
+ unread (cdr gnus-group-list-mode)))
+ (setq level (gnus-group-default-level level))
+ (gnus-group-setup-buffer) ;May call from out of group buffer
(let ((case-fold-search nil)
(group (gnus-group-group-name)))
(funcall gnus-group-prepare-function level unread nil)
group (car info)
newsrc (cdr newsrc)
unread (car (gnus-gethash group gnus-newsrc-hashtb)))
- (and unread ; This group might be bogus
+ (and unread ; This group might be bogus
(or (not regexp)
(string-match regexp group))
(<= (setq clevel (car (cdr info))) level)
(>= clevel lowest)
- (or all ; We list all groups?
- (eq unread t) ; We list unactivated groups
- (> unread 0) ; We list groups with unread articles
+ (or all ; We list all groups?
+ (eq unread t) ; We list unactivated groups
+ (> unread 0) ; We list groups with unread articles
(cdr (assq 'tick (nth 3 info)))) ; And groups with tickeds
(gnus-group-insert-group-line
nil group (car (cdr info)) (nth 3 info) unread (nth 4 info)))))
gnus-level-killed ?K regexp))
(gnus-group-set-mode-line)
- (setq gnus-have-all-newsgroups all)
+ (setq gnus-group-list-mode (cons level all))
(run-hooks 'gnus-group-prepare-hook)))
(defun gnus-group-prepare-flat-list-dead (groups level mark regexp)
(string-match regexp group))
(progn
(setq beg (point))
- (insert (format " %c *: %s\n" mark group))
+ (insert (format " %c *: %s\n" mark group))
(add-text-properties
beg (1+ beg)
(list 'gnus-group (intern group)
(if (not method-only-group)
()
(or entry
- (error "Trying to change non-existant group %s" method-only-group))
+ (error "Trying to change non-existent group %s" method-only-group))
;; We have recevied parts of the actual group info - either the
;; select method or the group parameters. We first check
;; whether we have to extend the info, and if so, do that.
nil group (nth 1 info) (nth 3 info) (car entry) (nth 4 info)))
(setq active (gnus-gethash group gnus-active-hashtb))
(gnus-group-insert-group-line
- nil group (if (member group gnus-zombie-list) gnus-level-zombie
- gnus-level-killed)
+ nil group
+ (if (member group gnus-zombie-list) gnus-level-zombie gnus-level-killed)
nil (if active (- (1+ (cdr active)) (car active)) 0) nil))))
(defun gnus-group-insert-group-line (gformat group level marked number method)
?* ? ))
(number (if (eq number t) "*" (+ number number-of-dormant
number-of-ticked)))
+ (process-marked (if (member group gnus-group-marked)
+ gnus-process-mark ? ))
(buffer-read-only nil)
+ header ; passed as parameter to user-funcs.
b)
(beginning-of-line)
(setq b (point))
;; go, and insert it there (or at the end of the buffer).
;; Fix by Per Abrahamsen <amanda@iesd.auc.dk>.
(or visible-only
- (let ((entry (cdr (gnus-gethash group gnus-newsrc-hashtb))))
+ (let ((entry
+ (cdr (cdr (gnus-gethash group gnus-newsrc-hashtb)))))
(while (and entry
(car entry)
(not
(point-min) (point-max)
'gnus-group (intern (car (car entry)))))))
(setq entry (cdr entry)))
- (if entry (forward-line 1)
- (goto-char (point-max)))))))
+ (or entry (goto-char (point-max)))))))
(if (or visible (not visible-only))
(gnus-group-insert-group-line-info group))
(gnus-group-set-mode-line))))
"Get the level of the newsgroup on the current line."
(get-text-property (gnus-point-at-bol) 'gnus-level))
+(defun gnus-group-group-unread ()
+ "Get the number of unread articles of the newsgroup on the current line."
+ (get-text-property (gnus-point-at-bol) 'gnus-unread))
+
(defun gnus-group-search-forward (&optional backward all level first-too)
"Find the next newsgroup with unread articles.
If BACKWARD is non-nil, find the previous newsgroup instead.
If ALL is non-nil, just find any newsgroup.
If LEVEL is non-nil, find group with level LEVEL, or higher if no such
group exists.
-If FIRST-TOO, the current line is also eligeble as a target."
+If FIRST-TOO, the current line is also eligible as a target."
(let ((way (if backward -1 1))
- (low 10)
+ (low gnus-level-killed)
(beg (point))
- pos found)
+ pos found lev)
(if (and backward (progn (beginning-of-line)) (bobp))
nil
(or first-too (forward-line way))
(let ((unread
(get-text-property (point) 'gnus-unread)))
(or (eq unread t) (and unread (> unread 0))))
- (let ((lev (get-text-property
- (point) 'gnus-level)))
- (and lev (<= (get-text-property
- (point) 'gnus-level)
- gnus-level-subscribed)))))
+ (setq lev (get-text-property (point)
+ 'gnus-level))
+ (<= lev gnus-level-subscribed)))
(or (not level)
- (let ((lev (get-text-property (point) 'gnus-level)))
- (if (and lev (<= lev level))
- t
- (if (< lev low)
- (progn
- (setq low lev)
- (setq pos (point))))
- nil))))))
+ (and (setq lev (get-text-property (point)
+ 'gnus-level))
+ (or (= lev level)
+ (and (< lev low)
+ (< level lev)
+ (progn
+ (setq low lev)
+ (setq pos (point))
+ nil))))))))
(zerop (forward-line way)))))
(if found
(progn (gnus-group-position-cursor) t)
- (if pos (goto-char pos) (goto-char beg))
- nil)))
+ (goto-char (or pos beg))
+ (and pos t))))
;;; Gnus group mode commands
;; Group marking.
-(defun gnus-group-mark-group (n &optional unmark)
+(defun gnus-group-mark-group (n &optional unmark no-advance)
"Mark the current group."
(interactive "p")
(let ((buffer-read-only nil)
(setq group (gnus-group-group-name))
(progn
(beginning-of-line)
- (forward-char 1)
+ (forward-char
+ (or (cdr (assq 'process gnus-group-mark-positions)) 2))
(delete-char 1)
(if unmark
(progn
(insert " ")
(setq gnus-group-marked (delete group gnus-group-marked)))
(insert "#")
- (setq gnus-group-marked (cons group gnus-group-marked)))
+ (setq gnus-group-marked
+ (cons group (delete group gnus-group-marked))))
t)
- (zerop (gnus-group-next-group 1)))
+ (or no-advance (zerop (gnus-group-next-group 1))))
(setq n (1- n)))
(gnus-summary-position-cursor)
n))
(defun gnus-group-remove-mark (group)
(and (gnus-group-goto-group group)
(save-excursion
- (gnus-group-mark-group 1 'unmark))))
+ (gnus-group-mark-group 1 'unmark t))))
;; Return a list of groups to work on. Take into consideration N (the
;; prefix) and the list of marked groups.
;; Selecting groups.
-(defun gnus-group-read-group (all &optional no-article group)
+(defun gnus-group-read-group (&optional all no-article group)
"Read news in this newsgroup.
-If argument ALL is non-nil, already read articles become readable.
-If optional argument NO-ARTICLE is non-nil, no article body is displayed."
+If the prefix argument ALL is non-nil, already read articles become
+readable. If the optional argument NO-ARTICLE is non-nil, no article
+will be auto-selected upon group entry."
(interactive "P")
(let ((group (or group (gnus-group-group-name)))
number active marked entry)
(length (cdr (assq 'dormant marked)))))))
no-article)))
-(defun gnus-group-select-group (all)
+(defun gnus-group-select-group (&optional all)
"Select this newsgroup.
No article is selected automatically.
If argument ALL is non-nil, already read articles become readable."
(interactive "P")
(gnus-group-read-group all t))
+(defun gnus-group-select-group-all ()
+ "Select the current group and display all articles in it."
+ (interactive)
+ (gnus-group-select-group 'all))
+
;; Enter a group that is not in the group buffer. Non-nil is returned
;; if selection was successful.
(defun gnus-group-read-ephemeral-group
(cons (current-buffer) 'summary)))))))
gnus-newsrc-hashtb)
(set-buffer gnus-group-buffer)
- (if activate (gnus-request-group group (nth 1 method)))
+ (or (gnus-check-server method)
+ (error "Unable to contact server: %s" (gnus-status-message method)))
+ (if activate (or (gnus-request-group group)
+ (error "Couldn't request group")))
(condition-case ()
(gnus-group-read-group t t group)
(error nil)
(defun gnus-group-jump-to-group (group)
"Jump to newsgroup GROUP."
- (interactive (list (completing-read "Group: " gnus-active-hashtb nil
- (not (not gnus-read-active-file)))))
+ (interactive
+ (list (completing-read
+ "Group: " gnus-active-hashtb nil
+ (memq gnus-select-method gnus-have-read-active-file))))
(if (equal group "")
- (error "empty group name"))
+ (error "Empty group name"))
- (let ((b (text-property-any (point-min) (point-max)
- 'gnus-group (intern group))))
+ (let ((b (text-property-any
+ (point-min) (point-max) 'gnus-group (intern group))))
(if b
;; Either go to the line in the group buffer...
(goto-char b)
;; ... or insert the line.
(or
(gnus-gethash group gnus-active-hashtb)
- (gnus-activate-newsgroup group)
+ (gnus-activate-group group)
(error "%s error: %s" group (gnus-status-message group)))
(gnus-group-update-group group)
- (goto-char (text-property-any (point-min) (point-max)
- 'gnus-group (intern group)))))
+ (goto-char (text-property-any
+ (point-min) (point-max) 'gnus-group (intern group)))))
;; Adjust cursor point.
(gnus-group-position-cursor))
(while (setq unread (get-text-property (point) 'gnus-unread))
(if (and (numberp unread) (> unread 0))
(progn
- (or best-point (setq best-point (point)))
(if (and (< (get-text-property (point) 'gnus-level) best)
(or (not exclude-group)
(not (equal exclude-group (gnus-group-group-name)))))
(defun gnus-group-first-unread-group ()
"Go to the first group with unread articles."
(interactive)
- (goto-char (point-min))
- (or (not (zerop (or (get-text-property (point) 'gnus-unread) 0)))
- (gnus-group-next-unread-group 1))
- (gnus-group-position-cursor))
+ (prog1
+ (let ((opoint (point))
+ unread)
+ (goto-char (point-min))
+ (if (or (eq (setq unread (gnus-group-group-unread)) t) ; Not active.
+ (not (zerop unread)) ; Has unread articles.
+ (zerop (gnus-group-next-unread-group 1))) ; Next unread group.
+ (point) ; Success.
+ (goto-char opoint)
+ nil)) ; Not success.
+ (gnus-group-position-cursor)))
(defun gnus-group-enter-server-mode ()
"Jump to the server buffer."
(gnus-configure-windows 'server)
(gnus-server-prepare))
-(defun gnus-group-make-group (name method address)
+(defun gnus-group-make-group (name method &optional address)
"Add a new newsgroup.
The user will be prompted for a NAME, for a select METHOD, and an
ADDRESS."
(gnus-group-change-level
(setq info (list t nname gnus-level-default-subscribed nil nil meth))
gnus-level-default-subscribed gnus-level-killed
- (gnus-gethash (or (gnus-group-group-name) "dummy.group")
- gnus-newsrc-hashtb) t)
- (gnus-sethash nname '(0 . 0) gnus-active-hashtb)
+ (and (gnus-group-group-name)
+ (gnus-gethash (gnus-group-group-name)
+ gnus-newsrc-hashtb))
+ t)
+ (gnus-sethash nname (cons 1 0) gnus-active-hashtb)
(gnus-dribble-enter
(concat "(gnus-group-set-info '" (prin1-to-string (cdr info)) ")"))
(gnus-group-insert-group-line-info nname)
+ (if (assoc method gnus-valid-select-methods)
+ (require (intern method)))
(and (gnus-check-backend-function 'request-create-group nname)
(gnus-request-create-group nname))))
(part (or part 'info))
(winconf (current-window-configuration))
info)
- (if group (setq info (nth 2 (gnus-gethash group gnus-newsrc-hashtb)))
- (error "No group on current line"))
+ (or group (error "No group on current line"))
+ (or (setq info (nth 2 (gnus-gethash group gnus-newsrc-hashtb)))
+ (error "Killed group; can't be edited"))
(set-buffer (get-buffer-create gnus-group-edit-buffer))
(gnus-configure-windows 'edit-group)
(gnus-add-current-to-buffer-list)
(or (eq 'score (car (car marked)))
(eq 'bookmark (car (car marked)))
(eq 'killed (car (car marked)))
+ (not (numberp (car (cdr (car marked)))))
(setcdr (car marked)
(gnus-compress-sequence (sort (cdr (car marked)) '<) t)))
(setq marked (cdr marked))))
(gnus-group-position-cursor)))
(defun gnus-group-make-help-group ()
- "Create the (ding) Gnus documentation group."
+ "Create the Gnus documentation group."
(interactive)
- (and (gnus-gethash (gnus-group-prefixed-name "gnus-help" '(nndoc ""))
- gnus-newsrc-hashtb)
- (error "Documentation group already exists"))
- (let ((path load-path))
+ (let ((path load-path)
+ name)
+ (and (gnus-gethash (setq name (gnus-group-prefixed-name
+ "gnus-help" '(nndoc "gnus-help")))
+ gnus-newsrc-hashtb)
+ (error "Documentation group already exists"))
(while (and path
(not (file-exists-p (concat (file-name-as-directory (car path))
"doc.txt"))))
(setq path (cdr path)))
(or path (error "Couldn't find doc group"))
(gnus-group-make-group
- "gnus-help" "nndoc"
- (concat (file-name-as-directory (car path)) "doc.txt"))
- (gnus-group-position-cursor)))
+ (gnus-group-real-name name)
+ (list 'nndoc name
+ (list 'nndoc-address
+ (concat (file-name-as-directory (car path)) "doc.txt"))
+ (list 'nndoc-article-type 'mbox))))
+ (gnus-group-position-cursor))
-(defun gnus-group-make-archive-group ()
- "Create the (ding) Gnus archive group."
- (interactive)
- (and (gnus-gethash (gnus-group-prefixed-name "ding.archives" '(nndir ""))
- gnus-newsrc-hashtb)
- (error "Archive group already exists"))
- (gnus-group-make-group "ding.archives" "nndir" gnus-group-archive-directory)
+(defun gnus-group-make-doc-group (file type)
+ "Create a group that uses a single file as the source."
+ (interactive
+ (list (read-file-name "File name: ")
+ (let ((err "")
+ found char)
+ (while (not found)
+ (message "%sFile type (mbox, babyl, digest) [mbd]: " err)
+ (setq found (cond ((= (setq char (read-char)) ?m) 'mbox)
+ ((= char ?b) 'babyl)
+ ((= char ?d) 'digest)
+ (t (setq err (format "%c unknown. " char))
+ nil))))
+ found)))
+ (let* ((file (expand-file-name file))
+ (name (gnus-generate-new-group-name
+ (gnus-group-prefixed-name
+ (file-name-nondirectory file) '(nndoc "")))))
+ (gnus-group-make-group
+ (gnus-group-real-name name)
+ (list 'nndoc name
+ (list 'nndoc-address file)
+ (list 'nndoc-article-type type)))))
+
+(defun gnus-group-make-archive-group (&optional all)
+ "Create the (ding) Gnus archive group of the most recent articles.
+Given a prefix, create a full group."
+ (interactive "P")
+ (let ((group (gnus-group-prefixed-name
+ (if all "ding.archives" "ding.recent") '(nndir ""))))
+ (and (gnus-gethash group gnus-newsrc-hashtb)
+ (error "Archive group already exists"))
+ (gnus-group-make-group
+ (gnus-group-real-name group)
+ "nndir"
+ (if all gnus-group-archive-directory
+ gnus-group-recent-archive-directory)))
(gnus-group-position-cursor))
(defun gnus-group-make-directory-group (dir)
(defun gnus-group-make-empty-virtual (group)
"Create a new, fresh, empty virtual group."
(interactive "sCreate new, empty virtual group: ")
- (let* ((method (list 'nnvirtual ""))
+ (let* ((method (list 'nnvirtual "^$"))
(pgroup (gnus-group-prefixed-name group method)))
;; Check whether it exists already.
(and (gnus-gethash pgroup gnus-newsrc-hashtb)
(leaf (gnus-group-prefixed-name
(file-name-nondirectory (directory-file-name dir))
method))
- (name leaf)
- (num 0))
- (while (gnus-gethash name gnus-newsrc-hashtb)
- (setq name (concat leaf "<" (int-to-string (setq num (1+ num))) ">")))
+ (name (gnus-generate-new-group-name leaf)))
(let ((nneething-read-only t))
(or (gnus-group-read-ephemeral-group
name method t
(setq gnus-newsrc-alist
(sort (cdr gnus-newsrc-alist) gnus-group-sort-function))
(gnus-make-hashtable-from-newsrc-alist)
- (gnus-group-list-groups nil))
+ (gnus-group-list-groups))
(defun gnus-group-sort-by-alphabet (info1 info2)
(string< (car info1) (car info2)))
;; Group catching up.
-(defun gnus-group-catchup-current (n &optional all)
+(defun gnus-group-catchup-current (&optional n all)
"Mark all articles not marked as unread in current newsgroup as read.
If prefix argument N is numeric, the ARG next newsgroups will be
caught up. If ALL is non-nil, marked articles will also be marked as
(let ((groups (gnus-group-process-prefix n))
(ret 0))
(while groups
+ ;; Virtual groups have to be given special treatment.
+ (let ((method (gnus-find-method-for-group (car groups))))
+ (if (eq 'nnvirtual (car method))
+ (nnvirtual-catchup-group
+ (gnus-group-real-name (car groups)) (nth 1 method) all)))
(gnus-group-remove-mark (car groups))
- (if (not (gnus-group-goto-group (car groups)))
- (setq ret (1+ ret))
- (gnus-group-catchup (car groups) all)
- (gnus-group-update-group-line))
+ (if (prog1
+ (gnus-group-goto-group (car groups))
+ (gnus-group-catchup (car groups) all))
+ (gnus-group-update-group-line)
+ (setq ret (1+ ret)))
(setq groups (cdr groups)))
(gnus-group-next-unread-group 1)
ret)))
-(defun gnus-group-catchup-current-all (n)
+(defun gnus-group-catchup-current-all (&optional n)
"Mark all articles in current newsgroup as read.
Cross references (Xref: header) of articles are ignored."
(interactive "P")
or nil if no action could be taken."
(let* ((entry (gnus-gethash group gnus-newsrc-hashtb))
(num (car entry))
- (marked (nth 3 (nth 2 entry)))
- ticked)
+ (marked (nth 3 (nth 2 entry))))
(if (not (numberp (car entry)))
(gnus-message 1 "Can't catch up; non-active group")
;; Do the updating only if the newsgroup isn't killed.
- (if entry
- (progn
- (setq ticked (if all nil (cdr (assq 'tick marked))))
- (gnus-update-read-articles group ticked nil ticked)
- (if (and all marked)
- (setcar (nthcdr 3 (nth 2 entry))
- (delq (assq 'dormant marked) marked))))))
+ (if (not entry)
+ ()
+ (gnus-update-read-articles
+ group (and (not all) (append (cdr (assq 'tick marked))
+ (cdr (assq 'dormant marked))))
+ nil (and (not all) (cdr (assq 'tick marked))))
+ (and all
+ (setq marked (nth 3 (nth 2 entry)))
+ (setcar (nthcdr 3 (nth 2 entry))
+ (delq (assq 'dormant marked)
+ (nth 3 (nth 2 entry)))))))
num))
-(defun gnus-group-expire-articles (n)
+(defun gnus-group-expire-articles (&optional n)
"Expire all expirable articles in the current newsgroup."
(interactive "P")
(let ((groups (gnus-group-process-prefix n))
(defun gnus-group-expire-all-groups ()
"Expire all expirable articles in all newsgroups."
(interactive)
- (gnus-message 5 "Expiring...")
- (let ((gnus-group-marked (mapcar (lambda (info) (car info))
- (cdr gnus-newsrc-alist))))
- (gnus-group-expire-articles nil))
+ (save-excursion
+ (gnus-message 5 "Expiring...")
+ (let ((gnus-group-marked (mapcar (lambda (info) (car info))
+ (cdr gnus-newsrc-alist))))
+ (gnus-group-expire-articles nil)))
+ (gnus-group-position-cursor)
(gnus-message 5 "Expiring...done"))
(defun gnus-group-set-current-level (n level)
(gnus-group-update-group-line)))
(gnus-group-position-cursor))
-(defun gnus-group-unsubscribe-current-group (arg)
- "Toggle subscribe from/to unsubscribe current group."
+(defun gnus-group-unsubscribe-current-group (&optional n)
+ "Toggle subscription of the current group.
+If given numerical prefix, toggle the N next groups."
(interactive "P")
- (let ((group (gnus-group-group-name)))
- (or group (error "No newsgroup on current line"))
- (or arg (setq arg (if (<= (gnus-group-group-level) gnus-level-subscribed)
- gnus-level-default-unsubscribed
- gnus-level-default-subscribed)))
- (gnus-group-unsubscribe-group group arg)
+ (let ((groups (gnus-group-process-prefix n))
+ group)
+ (while groups
+ (setq group (car groups)
+ groups (cdr groups))
+ (gnus-group-remove-mark group)
+ (gnus-group-unsubscribe-group
+ group (if (<= (gnus-group-group-level) gnus-level-subscribed)
+ gnus-level-default-unsubscribed
+ gnus-level-default-subscribed))
+ (gnus-group-update-group-line))
(gnus-group-next-group 1)))
(defun gnus-group-unsubscribe-group (group &optional level)
"Toggle subscribe from/to unsubscribe GROUP.
New newsgroup is added to .newsrc automatically."
(interactive
- (list (completing-read "Group: " gnus-active-hashtb nil
- gnus-have-read-active-file)))
+ (list (completing-read
+ "Group: " gnus-active-hashtb nil
+ (memq gnus-select-method gnus-have-read-active-file))))
(let ((newsrc (gnus-gethash group gnus-newsrc-hashtb)))
- (cond (newsrc
- ;; Toggle subscription flag.
- (gnus-group-change-level
- newsrc (if level level (if (<= (nth 1 (nth 2 newsrc))
- gnus-level-subscribed)
- (1+ gnus-level-subscribed)
- gnus-level-default-subscribed)))
- (gnus-group-update-group group))
- ((and (stringp group)
- (or (not gnus-have-read-active-file)
- (gnus-gethash group gnus-active-hashtb)))
- ;; Add new newsgroup.
- (gnus-group-change-level
- group
- (if level level gnus-level-default-subscribed)
- (or (and (member group gnus-zombie-list)
- gnus-level-zombie)
- gnus-level-killed)
- (and (gnus-group-group-name)
- (gnus-gethash (gnus-group-group-name) gnus-newsrc-hashtb)))
- (gnus-group-update-group group))
- (t (error "No such newsgroup: %s" group)))
+ (cond
+ ((string-match "^[ \t]$" group)
+ (error "Empty group name"))
+ (newsrc
+ ;; Toggle subscription flag.
+ (gnus-group-change-level
+ newsrc (if level level (if (<= (nth 1 (nth 2 newsrc))
+ gnus-level-subscribed)
+ (1+ gnus-level-subscribed)
+ gnus-level-default-subscribed)))
+ (gnus-group-update-group group))
+ ((and (stringp group)
+ (or (not (memq gnus-select-method gnus-have-read-active-file))
+ (gnus-gethash group gnus-active-hashtb)))
+ ;; Add new newsgroup.
+ (gnus-group-change-level
+ group
+ (if level level gnus-level-default-subscribed)
+ (or (and (member group gnus-zombie-list)
+ gnus-level-zombie)
+ gnus-level-killed)
+ (and (gnus-group-group-name)
+ (gnus-gethash (gnus-group-group-name) gnus-newsrc-hashtb)))
+ (gnus-group-update-group group))
+ (t (error "No such newsgroup: %s" group)))
(gnus-group-position-cursor)))
(defun gnus-group-transpose-groups (n)
"Move the current newsgroup up N places.
If given a negative prefix, move down instead. The difference between
-N and the number of steps taken is retured."
+N and the number of steps taken is returned."
(interactive "p")
(or (gnus-group-group-name)
(error "No group on current line"))
(interactive)
(setq gnus-killed-list (nconc gnus-zombie-list gnus-killed-list))
(setq gnus-zombie-list nil)
- (funcall gnus-group-prepare-function gnus-level-subscribed nil nil)
- (goto-char (point-min))
- (gnus-group-position-cursor))
+ (gnus-group-list-groups))
(defun gnus-group-kill-region (begin end)
"Kill newsgroups in current region (excluding current point).
The killed newsgroups can be yanked by using \\[gnus-group-yank-group]."
(interactive "r")
(let ((lines
- ;; Exclude a line where current point is on.
- (1-
- ;; Count lines.
- (save-excursion
- (count-lines
- (progn
- (goto-char begin)
- (beginning-of-line)
- (point))
- (progn
- (goto-char end)
- (end-of-line)
- (point)))))))
+ ;; Count lines.
+ (save-excursion
+ (count-lines
+ (progn
+ (goto-char begin)
+ (beginning-of-line)
+ (point))
+ (progn
+ (goto-char end)
+ (beginning-of-line)
+ (point))))))
(goto-char begin)
(beginning-of-line) ;Important when LINES < 1
(gnus-group-kill-group lines)))
-(defun gnus-group-kill-group (n)
+(defun gnus-group-kill-group (&optional n)
"The the next N groups.
The killed newsgroups can be yanked by using \\[gnus-group-yank-group].
However, only groups that were alive can be yanked; already killed
(gnus-group-position-cursor)
group))
-(defun gnus-group-list-all-groups (arg)
+(defun gnus-group-list-all-groups (&optional arg)
"List all newsgroups with level ARG or lower.
Default is gnus-level-unsubscribed, which lists all subscribed and most
unsubscribed groups."
(interactive "P")
- (setq arg (or arg gnus-level-unsubscribed))
- (gnus-group-list-groups arg t))
+ (gnus-group-list-groups (or arg gnus-level-unsubscribed) t))
(defun gnus-group-list-killed ()
"List all killed newsgroups in the group buffer."
(interactive)
(if (not gnus-killed-list)
(gnus-message 6 "No killed groups")
- (funcall gnus-group-prepare-function gnus-level-killed t gnus-level-killed)
+ (let (gnus-group-list-mode)
+ (funcall gnus-group-prepare-function
+ gnus-level-killed t gnus-level-killed))
(goto-char (point-min)))
(gnus-group-position-cursor))
(interactive)
(if (not gnus-zombie-list)
(gnus-message 6 "No zombie groups")
- (funcall gnus-group-prepare-function gnus-level-zombie t gnus-level-zombie)
+ (let (gnus-group-list-mode)
+ (funcall gnus-group-prepare-function
+ gnus-level-zombie t gnus-level-zombie))
(goto-char (point-min)))
(gnus-group-position-cursor))
specify which levels you are interested in re-scanning."
(interactive "P")
(run-hooks 'gnus-get-new-news-hook)
- (let ((level arg))
- (if gnus-group-use-permanent-levels
- (progn
- (if level
- (setq gnus-group-default-list-level level)
- (setq level (or gnus-group-default-list-level
- gnus-level-subscribed)))))
- (if (and gnus-read-active-file (not level))
- (progn
- (gnus-read-active-file)
- (gnus-get-unread-articles (or level (1+ gnus-level-subscribed))))
- (let ((gnus-read-active-file nil))
- (gnus-get-unread-articles (or level (1+ gnus-level-subscribed)))))
- (gnus-group-list-groups (or (and gnus-group-use-permanent-levels level)
- gnus-level-subscribed)
- gnus-have-all-newsgroups)))
-
-(defun gnus-group-get-new-news-this-group (n)
+ (setq arg (gnus-group-default-level arg t))
+ (if (and gnus-read-active-file (not arg))
+ (progn
+ (gnus-read-active-file)
+ (gnus-get-unread-articles (or arg (1+ gnus-level-subscribed))))
+ (let ((gnus-read-active-file (not arg))
+ (gnus-have-read-active-file
+ (and (not arg) gnus-have-read-active-file)))
+ (gnus-get-unread-articles (or arg (1+ gnus-level-subscribed)))))
+ (gnus-group-list-groups))
+
+(defun gnus-group-get-new-news-this-group (&optional n)
"Check for newly arrived news in the current group (and the N-1 next groups).
The difference between N and the number of newsgroup checked is returned.
If N is negative, this group and the N-1 previous groups will be checked."
(interactive "P")
(let* ((groups (gnus-group-process-prefix n))
(ret (if (numberp n) (- n (length groups)) 0))
- (w-p (window-start))
group)
(while groups
(setq group (car groups)
(ding)
(message "%s error: %s" group (gnus-status-message group))
(sit-for 2))))
- ;; !!! I don't know why the buffer scrolls forward when updating
- ;; the first line in the group buffer, but it does. So we set the
- ;; window start forcibly.
-; (set-window-start (get-buffer-window (current-buffer)) w-p)
- (forward-line 1)
+ (gnus-group-next-unread-group 1 t)
(gnus-summary-position-cursor)
ret))
(defun gnus-get-new-news-in-group (group)
(and group
- (gnus-activate-newsgroup group)
+ (gnus-activate-group group)
(progn
(gnus-get-unread-articles-in-group
(nth 2 (gnus-gethash group gnus-newsrc-hashtb))
"Fetch the FAQ for the current group."
(interactive (list (gnus-group-real-name (gnus-group-group-name))))
(or group (error "No group name given"))
- (let ((file (concat gnus-group-faq-directory group)))
+ (let ((file (concat gnus-group-faq-directory (gnus-group-real-name group))))
(if (not (file-exists-p file))
(error "No such file: %s" file)
(find-file file))))
(defun gnus-group-describe-group (force &optional group)
"Display a description of the current newsgroup."
- (interactive "P")
+ (interactive (list current-prefix-arg (gnus-group-group-name)))
(and force (setq gnus-description-hashtb nil))
- (let ((group (or group (gnus-group-group-name)))
+ (let ((method (gnus-find-method-for-group group))
desc)
(or group (error "No group name given"))
- (and (or gnus-description-hashtb
+ (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))
(setq desc (gnus-group-get-description group))
- (gnus-read-descriptions-file))
+ (gnus-read-descriptions-file method))
(message
(or desc (gnus-gethash group gnus-description-hashtb)
"No description available")))))
;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
-(defun gnus-group-describe-all-groups (force)
- "Pop up a buffer with descriptons of all newsgroups."
+(defun gnus-group-describe-all-groups (&optional force)
+ "Pop up a buffer with descriptions of all newsgroups."
(interactive "P")
(and force (setq gnus-description-hashtb nil))
(if (not (or gnus-description-hashtb
- (gnus-read-descriptions-file)))
+ (gnus-read-all-descriptions-files)))
(error "Couldn't request descriptions file"))
(let ((buffer-read-only nil)
b)
(interactive "sGnus apropos (regexp): ")
(let ((prev "")
(obuf (current-buffer))
- groups des prev)
+ groups des)
;; Go through all newsgroups that are known to Gnus.
(mapatoms
(lambda (group)
- (and (string-match regexp (symbol-name group))
+ (and (symbol-name group)
+ (string-match regexp (symbol-name group))
(setq groups (cons (symbol-name group) groups))))
gnus-active-hashtb)
;; Go through all descriptions that are known to Gnus.
(pop-to-buffer obuf)))
(defun gnus-group-description-apropos (regexp)
- "List all newsgroups that have names or desccriptions that match a regexp."
+ "List all newsgroups that have names or descriptions that match a regexp."
(interactive "sGnus description apropos (regexp): ")
(if (not (or gnus-description-hashtb
- (gnus-read-descriptions-file)))
+ (gnus-read-all-descriptions-files)))
(error "Couldn't request descriptions file"))
(gnus-group-apropos regexp t))
(interactive "P")
(gnus-save-newsrc-file)
(gnus-setup-news 'force)
- (gnus-group-list-groups arg gnus-have-all-newsgroups))
+ (gnus-group-list-groups arg))
(defun gnus-group-read-init-file ()
"Read the Gnus elisp init file."
(interactive)
(gnus-read-init-file))
-(defun gnus-group-check-bogus-groups ()
- "Check bogus newsgroups."
- (interactive)
- (gnus-check-bogus-newsgroups (not gnus-expert-user)) ;Require confirmation.
- (gnus-group-list-groups nil gnus-have-all-newsgroups))
+(defun gnus-group-check-bogus-groups (&optional silent)
+ "Check bogus newsgroups.
+If given a prefix, don't ask for confirmation before removing a bogus
+group."
+ (interactive "P")
+ (gnus-check-bogus-newsgroups (and (not silent) (not gnus-expert-user)))
+ (gnus-group-list-groups))
-(defun gnus-group-edit-global-kill (article &optional group)
+(defun gnus-group-edit-global-kill (&optional article group)
"Edit the global kill file.
If GROUP, edit that local kill file instead."
(interactive "P")
(setq gnus-current-kill-article article)
(gnus-kill-file-edit-file group)
- (gnus-message 6
+ (gnus-message
+ 6
(substitute-command-keys
"Editing a global kill file (Type \\[gnus-kill-file-exit] to exit)")))
The hook `gnus-exit-gnus-hook' is called before actually exiting."
(interactive)
(if (or noninteractive ;For gnus-batch-kill
- (zerop (buffer-size)) ;No news is good news.
(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? "))
(progn
(run-hooks 'gnus-exit-gnus-hook)
+ ;; Offer to save data from non-quitted summary buffers.
+ (gnus-offer-save-summaries)
+ ;; Save the newsrc file(s).
(gnus-save-newsrc-file)
+ ;; Kill-em-all.
(gnus-close-backends)
+ ;; Reset everything.
(gnus-clear-system))))
(defun gnus-close-backends ()
(file-name-nondirectory gnus-current-startup-file))))
(progn
(run-hooks 'gnus-exit-gnus-hook)
+ (if gnus-use-full-window
+ (delete-other-windows)
+ (gnus-remove-some-windows))
(gnus-dribble-save)
- (gnus-offer-save-summaries)
(gnus-close-backends)
(gnus-clear-system))))
(defun gnus-offer-save-summaries ()
- (let ((buffers (buffer-list)))
- (save-excursion
- (while buffers
- (and
- ;; We look for buffers with "Summary" in the name.
- (string-match "Summary" (or (buffer-name (car buffers)) ""))
- (progn
- (set-buffer (car buffers))
- ;; We check that this is, indeed, a summary buffer.
- (eq 'major-mode 'gnus-summary-mode))
- ;; We ask the user whether she wants to save the info.
- (not (gnus-y-or-n-p
- (format "Discard summary buffer %s? " (buffer-name))))
- ;; We do it by simply exiting.
- (gnus-summary-exit))
- (setq buffers (cdr buffers))))))
+ (save-excursion
+ (let ((buflist (buffer-list))
+ buffers bufname)
+ (while buflist
+ (and (setq bufname (buffer-name (car buflist)))
+ (string-match "Summary" bufname)
+ (save-excursion
+ (set-buffer bufname)
+ ;; We check that this is, indeed, a summary buffer.
+ (eq major-mode 'gnus-summary-mode))
+ (setq buffers (cons bufname buffers)))
+ (setq buflist (cdr buflist)))
+ (and buffers
+ (map-y-or-n-p
+ "Update summary buffer %s? "
+ (lambda (buf)
+ (set-buffer buf)
+ (gnus-summary-exit))
+ buffers)))))
(defun gnus-group-describe-briefly ()
"Give a one line description of the group mode commands."
(interactive)
- (gnus-message 6
- (substitute-command-keys "\\<gnus-group-mode-map>\\[gnus-group-read-group]:Select \\[gnus-group-next-unread-group]:Forward \\[gnus-group-prev-unread-group]:Backward \\[gnus-group-exit]:Exit \\[gnus-info-find-node]:Run Info \\[gnus-group-describe-briefly]:This help")))
+ (gnus-message 7 (substitute-command-keys "\\<gnus-group-mode-map>\\[gnus-group-read-group]:Select \\[gnus-group-next-unread-group]:Forward \\[gnus-group-prev-unread-group]:Backward \\[gnus-group-exit]:Exit \\[gnus-info-find-node]:Run Info \\[gnus-group-describe-briefly]:This help")))
(defun gnus-group-browse-foreign-server (method)
"Browse a foreign news server.
(let ((gnus-select-method method)
groups group)
(gnus-message 5 "Connecting to %s..." (nth 1 method))
- (or (gnus-server-opened method)
- (gnus-open-server method)
+ (or (gnus-check-server method)
(error "Unable to contact server: %s" (gnus-status-message method)))
(or (gnus-request-list method)
(error "Couldn't request list: %s" (gnus-status-message method)))
(gnus-browse-mode)
(setq mode-line-buffer-identification
(format
- "(ding) Browse Server {%s:%s}" (car method) (car (cdr method))))
+ "Gnus Browse Server {%s:%s}" (car method) (car (cdr method))))
(save-excursion
(set-buffer nntp-server-buffer)
(let ((cur (current-buffer)))
(gnus-group-position-cursor)))
(defun gnus-browse-mode ()
- "Major mode for browsing a foreign server."
+ "Major mode for browsing a foreign server.
+
+All normal editing commands are switched off.
+
+\\<gnus-browse-mode-map>
+The only things you can do in this buffer is
+
+1) `\\[gnus-browse-unsubscribe-current-group]' to subscribe to a group.
+The group will be inserted into the group buffer upon exit from this
+buffer.
+
+2) `\\[gnus-browse-read-group]' to read a group ephemerally.
+
+3) `\\[gnus-browse-exit]' to return to the group buffer."
(interactive)
(kill-all-local-variables)
(if gnus-visual (gnus-browse-make-menu-bar))
(defun gnus-browse-select-group ()
"Select the current group."
+ (interactive)
(gnus-browse-read-group 'no))
(defun gnus-browse-next-group (n)
(defun gnus-browse-group-name ()
(save-excursion
+ (beginning-of-line)
(if (not (re-search-forward ": \\(.*\\)$" (gnus-point-at-eol) t))
()
(gnus-group-prefixed-name
(list t group gnus-level-default-subscribed
nil nil gnus-browse-current-method)
gnus-level-default-subscribed gnus-level-killed
- (gnus-gethash (car (nth 1 gnus-newsrc-alist)) gnus-newsrc-hashtb)
+ (and (car (nth 1 gnus-newsrc-alist))
+ (gnus-gethash (car (nth 1 gnus-newsrc-alist))
+ gnus-newsrc-hashtb))
t)
(insert ? ))
(gnus-group-change-level
(if (eq major-mode 'gnus-browse-mode)
(kill-buffer (current-buffer)))
(if gnus-browse-return-buffer
- (gnus-configure-windows 'server)
- (gnus-configure-windows 'group)))
+ (gnus-configure-windows 'server 'force)
+ (gnus-configure-windows 'group 'force)
+ (gnus-group-list-groups nil)))
(defun gnus-browse-describe-briefly ()
"Give a one line description of the group mode commands."
(interactive)
(gnus-message 6
- (substitute-command-keys "\\<gnus-browse-mode-map>\\[gnus-group-next-group]:Forward \\[gnus-group-prev-group]:Backward \\[gnus-browse-exit]:Exit \\[gnus-info-find-node]:Run Info \\[gnus-browse-describe-briefly]:This help")))
+ (substitute-command-keys "\\<gnus-browse-mode-map>\\[gnus-group-next-group]:Forward \\[gnus-group-prev-group]:Backward \\[gnus-browse-exit]:Exit \\[gnus-info-find-node]:Run Info \\[gnus-browse-describe-briefly]:This help")))
\f
;;;
(defvar gnus-summary-thread-map nil)
(defvar gnus-summary-goto-map nil)
(defvar gnus-summary-exit-map nil)
-(defvar gnus-summary-various-map nil)
(defvar gnus-summary-interest-map nil)
(defvar gnus-summary-sort-map nil)
(defvar gnus-summary-backend-map nil)
(defvar gnus-summary-save-map nil)
(defvar gnus-summary-wash-map nil)
+(defvar gnus-summary-wash-hide-map nil)
+(defvar gnus-summary-wash-highlight-map nil)
+(defvar gnus-summary-wash-time-map nil)
(defvar gnus-summary-help-map nil)
(put 'gnus-summary-mode 'mode-class 'special)
(define-key gnus-summary-mode-map "\M-p" 'gnus-summary-prev-unread-subject)
(define-key gnus-summary-mode-map "." 'gnus-summary-first-unread-article)
(define-key gnus-summary-mode-map "," 'gnus-summary-best-unread-article)
- (define-key gnus-summary-mode-map "\M-s" 'gnus-summary-search-article-forward)
- (define-key gnus-summary-mode-map "\M-r" 'gnus-summary-search-article-backward)
+ (define-key gnus-summary-mode-map
+ "\M-s" 'gnus-summary-search-article-forward)
+ (define-key gnus-summary-mode-map
+ "\M-r" 'gnus-summary-search-article-backward)
(define-key gnus-summary-mode-map "<" 'gnus-summary-beginning-of-article)
(define-key gnus-summary-mode-map ">" 'gnus-summary-end-of-article)
(define-key gnus-summary-mode-map "j" 'gnus-summary-goto-subject)
(define-key gnus-summary-mode-map "E" 'gnus-summary-mark-as-expirable)
(define-key gnus-summary-mode-map "\M-u" 'gnus-summary-clear-mark-forward)
(define-key gnus-summary-mode-map "\M-U" 'gnus-summary-clear-mark-backward)
- (define-key gnus-summary-mode-map "k" 'gnus-summary-kill-same-subject-and-select)
+ (define-key gnus-summary-mode-map
+ "k" 'gnus-summary-kill-same-subject-and-select)
(define-key gnus-summary-mode-map "\C-k" 'gnus-summary-kill-same-subject)
(define-key gnus-summary-mode-map "\M-\C-k" 'gnus-summary-kill-thread)
(define-key gnus-summary-mode-map "\M-\C-l" 'gnus-summary-lower-thread)
(define-key gnus-summary-mode-map "\C-w" 'gnus-summary-mark-region-as-read)
(define-key gnus-summary-mode-map "\C-t" 'gnus-summary-toggle-truncation)
(define-key gnus-summary-mode-map "?" 'gnus-summary-mark-as-dormant)
- (define-key gnus-summary-mode-map "\C-c\M-\C-s" 'gnus-summary-show-all-expunged)
- (define-key gnus-summary-mode-map "\C-c\C-s\C-n" 'gnus-summary-sort-by-number)
- (define-key gnus-summary-mode-map "\C-c\C-s\C-a" 'gnus-summary-sort-by-author)
- (define-key gnus-summary-mode-map "\C-c\C-s\C-s" 'gnus-summary-sort-by-subject)
+ (define-key gnus-summary-mode-map
+ "\C-c\M-\C-s" 'gnus-summary-show-all-expunged)
+ (define-key gnus-summary-mode-map
+ "\C-c\C-s\C-n" 'gnus-summary-sort-by-number)
+ (define-key gnus-summary-mode-map
+ "\C-c\C-s\C-a" 'gnus-summary-sort-by-author)
+ (define-key gnus-summary-mode-map
+ "\C-c\C-s\C-s" 'gnus-summary-sort-by-subject)
(define-key gnus-summary-mode-map "\C-c\C-s\C-d" 'gnus-summary-sort-by-date)
(define-key gnus-summary-mode-map "\C-c\C-s\C-i" 'gnus-summary-sort-by-score)
(define-key gnus-summary-mode-map "=" 'gnus-summary-expand-window)
- (define-key gnus-summary-mode-map "\C-x\C-s" 'gnus-summary-reselect-current-group)
+ (define-key gnus-summary-mode-map
+ "\C-x\C-s" 'gnus-summary-reselect-current-group)
(define-key gnus-summary-mode-map "\M-g" 'gnus-summary-rescan-group)
(define-key gnus-summary-mode-map "w" 'gnus-summary-stop-page-breaking)
(define-key gnus-summary-mode-map "\C-c\C-r" 'gnus-summary-caesar-message)
(define-key gnus-summary-mode-map gnus-mouse-2 'gnus-mouse-pick-article)
(define-key gnus-summary-mode-map "m" 'gnus-summary-mail-other-window)
(define-key gnus-summary-mode-map "a" 'gnus-summary-post-news)
- (define-key gnus-summary-mode-map "x" 'gnus-summary-remove-lines-marked-as-read)
+ (define-key gnus-summary-mode-map
+ "x" 'gnus-summary-remove-lines-marked-as-read)
; (define-key gnus-summary-mode-map "X" 'gnus-summary-remove-lines-marked-with)
(define-key gnus-summary-mode-map "s" 'gnus-summary-isearch-article)
(define-key gnus-summary-mode-map "t" 'gnus-summary-toggle-header)
(define-key gnus-summary-mode-map "l" 'gnus-summary-goto-last-article)
(define-key gnus-summary-mode-map "\C-c\C-v\C-v" 'gnus-uu-decode-uu-view)
(define-key gnus-summary-mode-map "\C-d" 'gnus-summary-enter-digest-group)
+ (define-key gnus-summary-mode-map "v" 'gnus-summary-verbose-headers)
+ (define-key gnus-summary-mode-map "\C-c\C-b" 'gnus-bug)
;; Sort of orthogonal keymap
(define-key gnus-summary-mark-map "B" 'gnus-summary-remove-bookmark)
(define-key gnus-summary-mark-map "#" 'gnus-summary-mark-as-processable)
(define-key gnus-summary-mark-map "\M-#" 'gnus-summary-unmark-as-processable)
- (define-key gnus-summary-mark-map "\M-r" 'gnus-summary-remove-lines-marked-as-read)
- (define-key gnus-summary-mark-map "\M-\C-r" 'gnus-summary-remove-lines-marked-with)
+ (define-key gnus-summary-mark-map
+ "\M-r" 'gnus-summary-remove-lines-marked-as-read)
+ (define-key gnus-summary-mark-map
+ "\M-\C-r" 'gnus-summary-remove-lines-marked-with)
(define-key gnus-summary-mark-map "D" 'gnus-summary-show-all-dormant)
(define-key gnus-summary-mark-map "\M-D" 'gnus-summary-hide-all-dormant)
(define-key gnus-summary-mark-map "S" 'gnus-summary-show-all-expunged)
(define-key gnus-summary-mark-map "C" 'gnus-summary-catchup)
(define-key gnus-summary-mark-map "H" 'gnus-summary-catchup-to-here)
(define-key gnus-summary-mark-map "\C-c" 'gnus-summary-catchup-all)
- (define-key gnus-summary-mark-map "k" 'gnus-summary-kill-same-subject-and-select)
+ (define-key gnus-summary-mark-map
+ "k" 'gnus-summary-kill-same-subject-and-select)
(define-key gnus-summary-mark-map "K" 'gnus-summary-kill-same-subject)
(define-prefix-command 'gnus-summary-mscore-map)
- (define-key gnus-summary-mark-map "s" 'gnus-summary-mscore-map)
+ (define-key gnus-summary-mark-map "V" 'gnus-summary-mscore-map)
(define-key gnus-summary-mscore-map "c" 'gnus-summary-clear-above)
(define-key gnus-summary-mscore-map "u" 'gnus-summary-tick-above)
(define-key gnus-summary-mscore-map "m" 'gnus-summary-mark-above)
(define-key gnus-summary-mscore-map "k" 'gnus-summary-kill-below)
- (define-key gnus-summary-mark-map "p" 'gnus-uu-mark-map)
+ (define-key gnus-summary-mark-map "P" 'gnus-uu-mark-map)
(define-key gnus-summary-mode-map "S" 'gnus-summary-send-map)
(define-key gnus-summary-exit-map "E" 'gnus-summary-exit-no-update)
(define-key gnus-summary-exit-map "Q" 'gnus-summary-exit)
(define-key gnus-summary-exit-map "Z" 'gnus-summary-exit)
- (define-key gnus-summary-exit-map "n" 'gnus-summary-catchup-and-goto-next-group)
+ (define-key gnus-summary-exit-map
+ "n" 'gnus-summary-catchup-and-goto-next-group)
(define-key gnus-summary-exit-map "R" 'gnus-summary-reselect-current-group)
(define-key gnus-summary-exit-map "G" 'gnus-summary-rescan-group)
(define-key gnus-summary-exit-map "N" 'gnus-summary-next-group)
(define-key gnus-summary-article-map "e" 'gnus-summary-end-of-article)
(define-key gnus-summary-article-map "^" 'gnus-summary-refer-parent-article)
(define-key gnus-summary-article-map "r" 'gnus-summary-refer-parent-article)
- (define-key gnus-summary-article-map "w" 'gnus-summary-stop-page-breaking)
- (define-key gnus-summary-article-map "c" 'gnus-summary-caesar-message)
(define-key gnus-summary-article-map "g" 'gnus-summary-show-article)
- (define-key gnus-summary-article-map "t" 'gnus-summary-toggle-header)
- (define-key gnus-summary-article-map "m" 'gnus-summary-toggle-mime)
(define-key gnus-summary-article-map "s" 'gnus-summary-isearch-article)
+
(define-prefix-command 'gnus-summary-wash-map)
(define-key gnus-summary-mode-map "W" 'gnus-summary-wash-map)
- (define-key gnus-summary-wash-map "h" 'gnus-article-hide-headers)
- (define-key gnus-summary-wash-map "s" 'gnus-article-hide-signature)
- (define-key gnus-summary-wash-map "c" 'gnus-article-hide-citation)
+
+ (define-prefix-command 'gnus-summary-wash-hide-map)
+ (define-key gnus-summary-wash-map "W" 'gnus-summary-wash-hide-map)
+ (define-key gnus-summary-wash-hide-map "a" 'gnus-article-hide)
+ (define-key gnus-summary-wash-hide-map "h" 'gnus-article-hide-headers)
+ (define-key gnus-summary-wash-hide-map "s" 'gnus-article-hide-signature)
+ (define-key gnus-summary-wash-hide-map "c" 'gnus-article-hide-citation)
+ (define-key gnus-summary-wash-hide-map
+ "\C-c" 'gnus-article-hide-citation-maybe)
+
+ (define-prefix-command 'gnus-summary-wash-highlight-map)
+ (define-key gnus-summary-wash-map "H" 'gnus-summary-wash-highlight-map)
+ (define-key gnus-summary-wash-highlight-map "a" 'gnus-article-highlight)
+ (define-key gnus-summary-wash-highlight-map
+ "h" 'gnus-article-highlight-headers)
+ (define-key gnus-summary-wash-highlight-map
+ "c" 'gnus-article-highlight-citation)
+ (define-key gnus-summary-wash-highlight-map
+ "s" 'gnus-article-highlight-signature)
+
+ (define-prefix-command 'gnus-summary-wash-time-map)
+ (define-key gnus-summary-wash-map "T" 'gnus-summary-wash-time-map)
+ (define-key gnus-summary-wash-time-map "z" 'gnus-article-date-ut)
+ (define-key gnus-summary-wash-time-map "u" 'gnus-article-date-ut)
+ (define-key gnus-summary-wash-time-map "l" 'gnus-article-date-local)
+ (define-key gnus-summary-wash-time-map "e" 'gnus-article-date-lapsed)
+
+ (define-key gnus-summary-wash-map "b" 'gnus-article-add-buttons)
(define-key gnus-summary-wash-map "o" 'gnus-article-treat-overstrike)
(define-key gnus-summary-wash-map "w" 'gnus-article-word-wrap)
- (define-key gnus-summary-wash-map "d" 'gnus-article-remove-cr)
+ (define-key gnus-summary-wash-map "c" 'gnus-article-remove-cr)
(define-key gnus-summary-wash-map "q" 'gnus-article-de-quoted-unreadable)
(define-key gnus-summary-wash-map "f" 'gnus-article-display-x-face)
- (define-key gnus-summary-wash-map "t" 'gnus-article-date-ut)
- (define-key gnus-summary-wash-map "\C-t" 'gnus-article-date-local)
- (define-key gnus-summary-wash-map "T" 'gnus-article-date-lapsed)
-
- (define-key gnus-summary-wash-map "A" 'gnus-article-highlight)
- (define-key gnus-summary-wash-map "a" 'gnus-article-hide)
- (define-key gnus-summary-wash-map "H" 'gnus-article-highlight-headers)
- (define-key gnus-summary-wash-map "C" 'gnus-article-highlight-citation)
- (define-key gnus-summary-wash-map "S" 'gnus-article-highlight-signature)
- (define-key gnus-summary-wash-map "b" 'gnus-article-add-buttons)
+ (define-key gnus-summary-wash-map "l" 'gnus-summary-stop-page-breaking)
+ (define-key gnus-summary-wash-map "r" 'gnus-summary-caesar-message)
+ (define-key gnus-summary-wash-map "t" 'gnus-summary-toggle-header)
+ (define-key gnus-summary-wash-map "m" 'gnus-summary-toggle-mime)
(define-prefix-command 'gnus-summary-help-map)
(define-prefix-command 'gnus-summary-backend-map)
(define-key gnus-summary-mode-map "B" 'gnus-summary-backend-map)
(define-key gnus-summary-backend-map "e" 'gnus-summary-expire-articles)
+ (define-key gnus-summary-backend-map "\M-\C-e"
+ 'gnus-summary-expire-articles-now)
(define-key gnus-summary-backend-map "\177" 'gnus-summary-delete-article)
(define-key gnus-summary-backend-map "m" 'gnus-summary-move-article)
(define-key gnus-summary-backend-map "r" 'gnus-summary-respool-article)
(define-key gnus-summary-backend-map "w" 'gnus-summary-edit-article)
(define-key gnus-summary-backend-map "c" 'gnus-summary-copy-article)
(define-key gnus-summary-backend-map "q" 'gnus-summary-fancy-query)
+ (define-key gnus-summary-backend-map "i" 'gnus-summary-import-article)
(define-prefix-command 'gnus-summary-save-map)
(define-key gnus-summary-save-map "h" 'gnus-summary-save-article-folder)
(define-key gnus-summary-save-map "v" 'gnus-summary-save-article-vm)
(define-key gnus-summary-save-map "p" 'gnus-summary-pipe-output)
+; (define-key gnus-summary-save-map "s" 'gnus-soup-add-article)
(define-key gnus-summary-mode-map "X" 'gnus-uu-extract-map)
-
- (define-prefix-command 'gnus-summary-various-map)
- (define-key gnus-summary-mode-map "V" 'gnus-summary-various-map)
- (define-key gnus-summary-various-map "u" 'gnus-summary-universal-argument)
- (define-key gnus-summary-various-map "\C-s" 'gnus-summary-search-article-forward)
- (define-key gnus-summary-various-map "\C-r" 'gnus-summary-search-article-backward)
- (define-key gnus-summary-various-map "r" 'gnus-summary-refer-article)
- (define-key gnus-summary-various-map "&" 'gnus-summary-execute-command)
- (define-key gnus-summary-various-map "T" 'gnus-summary-toggle-truncation)
- (define-key gnus-summary-various-map "e" 'gnus-summary-expand-window)
- (define-key gnus-summary-various-map "D" 'gnus-summary-enter-digest-group)
- (define-key gnus-summary-various-map "k" 'gnus-summary-edit-local-kill)
- (define-key gnus-summary-various-map "K" 'gnus-summary-edit-global-kill)
-
- (define-key gnus-summary-various-map "S" 'gnus-summary-score-map)
-
- (define-prefix-command 'gnus-summary-sort-map)
- (define-key gnus-summary-various-map "s" 'gnus-summary-sort-map)
- (define-key gnus-summary-sort-map "n" 'gnus-summary-sort-by-number)
- (define-key gnus-summary-sort-map "a" 'gnus-summary-sort-by-author)
- (define-key gnus-summary-sort-map "s" 'gnus-summary-sort-by-subject)
- (define-key gnus-summary-sort-map "d" 'gnus-summary-sort-by-date)
- (define-key gnus-summary-sort-map "i" 'gnus-summary-sort-by-score)
+
+ (define-key gnus-summary-mode-map "\M-&" 'gnus-summary-universal-argument)
+; (define-key gnus-summary-various-map "\C-s" 'gnus-summary-search-article-forward)
+; (define-key gnus-summary-various-map "\C-r" 'gnus-summary-search-article-backward)
+; (define-key gnus-summary-various-map "r" 'gnus-summary-refer-article)
+; (define-key gnus-summary-various-map "&" 'gnus-summary-execute-command)
+; (define-key gnus-summary-various-map "T" 'gnus-summary-toggle-truncation)
+; (define-key gnus-summary-various-map "e" 'gnus-summary-expand-window)
+ (define-key gnus-summary-article-map "D" 'gnus-summary-enter-digest-group)
+; (define-key gnus-summary-various-map "k" 'gnus-summary-edit-local-kill)
+; (define-key gnus-summary-various-map "K" 'gnus-summary-edit-global-kill)
+
+ (define-key gnus-summary-mode-map "V" 'gnus-summary-score-map)
+
+; (define-prefix-command 'gnus-summary-sort-map)
+; (define-key gnus-summary-various-map "s" 'gnus-summary-sort-map)
+; (define-key gnus-summary-sort-map "n" 'gnus-summary-sort-by-number)
+; (define-key gnus-summary-sort-map "a" 'gnus-summary-sort-by-author)
+; (define-key gnus-summary-sort-map "s" 'gnus-summary-sort-by-subject)
+; (define-key gnus-summary-sort-map "d" 'gnus-summary-sort-by-date)
+; (define-key gnus-summary-sort-map "i" 'gnus-summary-sort-by-score)
(define-key gnus-summary-mode-map "I" 'gnus-summary-increase-score)
(define-key gnus-summary-mode-map "L" 'gnus-summary-lower-score)
\f
-(defun gnus-summary-mode ()
+(defun gnus-summary-mode (&optional group)
"Major mode for reading articles.
All normal editing commands are switched off.
(set (car locals) nil))
(setq locals (cdr locals))))
(gnus-make-thread-indent-array)
- (gnus-update-format-specifications)
(setq mode-line-modified "-- ")
(make-local-variable 'mode-line-format)
(setq mode-line-format (copy-sequence mode-line-format))
(setq selective-display t)
(setq selective-display-ellipses t) ;Display `...'
(setq buffer-display-table gnus-summary-display-table)
+ (setq gnus-newsgroup-name group)
(run-hooks 'gnus-summary-mode-hook))
(defun gnus-summary-make-display-table ()
(let ((i 32))
(while (>= (setq i (1- i)) 0)
(aset gnus-summary-display-table i [??])))
- ;; ... but not newline, of course.
+ ;; ... but not newline and cr, of course. (cr is necessary for the
+ ;; selective display).
(aset gnus-summary-display-table ?\n nil)
+ (aset gnus-summary-display-table ?\r nil)
;; We nix out any glyphs over 126 that are not set already.
(let ((i 256))
(while (>= (setq i (1- i)) 127)
(set (car locals) nil)))
(setq locals (cdr locals)))))
-(defun gnus-mouse-pick-article (e)
- (interactive "e")
- (mouse-set-point e)
- (gnus-summary-next-page nil t))
+;; Some summary mode macros.
-(defun gnus-summary-setup-buffer (group)
- "Initialize summary buffer."
- (let ((buffer (concat "*Summary " group "*")))
- (if (get-buffer buffer)
- (progn
- (set-buffer buffer)
- (not gnus-newsgroup-threads))
- ;; Fix by Sudish Joseph <joseph@cis.ohio-state.edu>
- (setq gnus-summary-buffer (set-buffer (get-buffer-create buffer)))
- (gnus-add-current-to-buffer-list)
- (gnus-summary-mode)
- (and gnus-carpal (gnus-carpal-setup-buffer 'summary))
- (setq gnus-newsgroup-name group)
- t)))
+;; Return a header specified by a NUMBER.
+(defun gnus-get-header-by-number (number)
+ (save-excursion
+ (set-buffer gnus-summary-buffer)
+ (or gnus-newsgroup-headers-hashtb-by-number
+ (gnus-make-headers-hashtable-by-number))
+ (gnus-gethash (int-to-string number)
+ gnus-newsgroup-headers-hashtb-by-number)))
-(defun gnus-set-global-variables ()
- ;; Set the global equivalents of the summary buffer-local variables
- ;; to the latest values they had. These reflect the summary buffer
- ;; that was in action when the last article was fetched.
- (if (eq major-mode 'gnus-summary-mode)
- (progn
- (setq gnus-summary-buffer (current-buffer))
+;; Fast version of the function above.
+(defmacro gnus-get-header-by-num (number)
+ (` (gnus-gethash (int-to-string (, number))
+ gnus-newsgroup-headers-hashtb-by-number)))
+
+(defmacro gnus-summary-search-forward (&optional unread subject backward)
+ "Search for article forward.
+If UNREAD is non-nil, only unread articles are selected.
+If SUBJECT is non-nil, the article which has the same subject will be
+searched for.
+If BACKWARD is non-nil, the search will be performed backwards instead."
+ (` (gnus-summary-search-subject (, backward) (, unread) (, subject))))
+
+(defmacro gnus-summary-search-backward (&optional unread subject)
+ "Search for article backward.
+If 1st optional argument UNREAD is non-nil, only unread article is selected.
+If 2nd optional argument SUBJECT is non-nil, the article which has
+the same subject will be searched for."
+ (` (gnus-summary-search-forward (, unread) (, subject) t)))
+
+(defmacro gnus-summary-article-number (&optional number-or-nil)
+ "The article number of the article on the current line.
+If there isn's an article number here, then we return the current
+article number."
+ (if number-or-nil
+ '(get-text-property (gnus-point-at-bol) 'gnus-number)
+ '(or (get-text-property (gnus-point-at-bol) 'gnus-number)
+ gnus-current-article)))
+
+(defmacro gnus-summary-thread-level ()
+ "The thread level of the article on the current line."
+ '(or (get-text-property (gnus-point-at-bol) 'gnus-level)
+ 0))
+
+(defmacro gnus-summary-article-mark ()
+ "The mark on the current line."
+ '(get-text-property (gnus-point-at-bol) 'gnus-mark))
+
+(defun gnus-summary-subject-string ()
+ "Return current subject string or nil if nothing."
+ (let ((article (gnus-summary-article-number))
+ header)
+ (and article
+ (setq header (gnus-get-header-by-num article))
+ (vectorp header)
+ (mail-header-subject header))))
+
+;; Various summary mode internalish functions.
+
+(defun gnus-mouse-pick-article (e)
+ (interactive "e")
+ (mouse-set-point e)
+ (gnus-summary-next-page nil t))
+
+(defun gnus-summary-setup-buffer (group)
+ "Initialize summary buffer."
+ (let ((buffer (concat "*Summary " group "*")))
+ (if (get-buffer buffer)
+ (progn
+ (set-buffer buffer)
+ (not gnus-newsgroup-begin))
+ ;; Fix by Sudish Joseph <joseph@cis.ohio-state.edu>
+ (setq gnus-summary-buffer (set-buffer (get-buffer-create buffer)))
+ (gnus-add-current-to-buffer-list)
+ (gnus-summary-mode group)
+ (and gnus-carpal (gnus-carpal-setup-buffer 'summary))
+ (setq gnus-newsgroup-name group)
+ t)))
+
+(defun gnus-set-global-variables ()
+ ;; Set the global equivalents of the summary buffer-local variables
+ ;; to the latest values they had. These reflect the summary buffer
+ ;; that was in action when the last article was fetched.
+ (if (eq major-mode 'gnus-summary-mode)
+ (progn
+ (setq gnus-summary-buffer (current-buffer))
(let ((name gnus-newsgroup-name)
(marked gnus-newsgroup-marked)
(unread gnus-newsgroup-unreads)
&optional dummy score)
(or sformat (setq sformat gnus-summary-line-format-spec))
(let* ((indentation (aref gnus-thread-indent-array level))
- (lines (header-lines header))
+ (lines (mail-header-lines header))
(score (or score gnus-summary-default-score 0))
- (score-char (if (or (null gnus-summary-default-score)
- (= score gnus-summary-default-score)) ?
- (if (< score gnus-summary-default-score)
- gnus-score-below-mark gnus-score-over-mark)))
+ (score-char
+ (if (or (null gnus-summary-default-score)
+ (<= (abs (- score gnus-summary-default-score))
+ gnus-summary-zcore-fuzz)) ?
+ (if (< score gnus-summary-default-score)
+ gnus-score-below-mark gnus-score-over-mark)))
(replied (if replied gnus-replied-mark ? ))
- (from (header-from header))
- (name-address (funcall gnus-extract-address-components from))
- (address (car (cdr name-address)))
- (name (or (car name-address) (car (cdr name-address))))
- (subject (header-subject header))
- (number (header-number header))
+ (from (mail-header-from header))
+ (name (cond
+ ((string-match "(.+)" from)
+ (substring from (1+ (match-beginning 0)) (1- (match-end 0))))
+ ((string-match "<[^>]+> *$" from)
+ (let ((beg (match-beginning 0)))
+ (or (and (string-match "^\"[^\"]*\"" from)
+ (substring from (1+ (match-beginning 0))
+ (1- (match-end 0))))
+ (substring from 0 beg))))
+ (t from)))
+ (subject (mail-header-subject header))
+ (number (mail-header-number header))
(opening-bracket (if dummy ?\< ?\[))
(closing-bracket (if dummy ?\> ?\]))
(buffer-read-only nil)
(and (not (memq article gnus-newsgroup-marked))
(not (memq article gnus-newsgroup-dormant))
(memq article gnus-newsgroup-unreads)
- (gnus-summary-mark-article nil gnus-low-score-mark))
+ (gnus-summary-mark-article-as-read gnus-low-score-mark))
(and (eq (gnus-summary-article-mark) gnus-low-score-mark)
- (gnus-summary-mark-article nil gnus-unread-mark))))
+ (gnus-summary-mark-article-as-unread gnus-unread-mark))))
(and gnus-visual
(run-hooks 'gnus-summary-update-hook))))))
(defun gnus-summary-update-lines (&optional beg end)
- ;; Rehighlight summary buffer according to `gnus-summary-highlight'.
+ ;; Mark article as read (or not) by taking into account scores.
(let ((beg (or beg (point-min)))
(end (or end (point-max))))
- (save-excursion
- (set-buffer gnus-summary-buffer)
- (goto-char beg)
- (while (and (not (eobp)) (< (point) end))
- (gnus-summary-update-line)
- (forward-line 1)))))
+ (if (or (not gnus-summary-default-score)
+ gnus-summary-inhibit-highlight)
+ ()
+ (let ((gnus-summary-inhibit-highlight t)
+ article)
+ (save-excursion
+ (set-buffer gnus-summary-buffer)
+ (goto-char beg)
+ (beginning-of-line)
+ (while (and (not (eobp)) (< (point) end))
+ (if (and gnus-summary-mark-below
+ (< (or (cdr (assq
+ (setq article (get-text-property
+ (point) 'gnus-number))
+ gnus-newsgroup-scored))
+ gnus-summary-default-score 0)
+ gnus-summary-mark-below))
+ ;; We want to possibly mark it as read...
+ (and (not (memq article gnus-newsgroup-marked))
+ (not (memq article gnus-newsgroup-dormant))
+ (memq article gnus-newsgroup-unreads)
+ (gnus-summary-mark-article-as-read gnus-low-score-mark))
+ ;; We want to possibly mark it as unread.
+ (and (eq (get-text-property (point) 'gnus-mark)
+ gnus-low-score-mark)
+ (gnus-summary-mark-article-as-unread gnus-unread-mark)))
+ ;; Do the visual highlights at the same time.
+ (and gnus-visual (run-hooks 'gnus-summary-update-hook))
+ (forward-line 1)))))))
+
+(defvar gnus-tmp-gathered nil)
(defun gnus-summary-number-of-articles-in-thread (thread &optional char)
;; Sum up all elements (and sub-elements) in a list.
- (let ((number
- (if (listp thread)
- (apply
- '+ (mapcar 'gnus-summary-number-of-articles-in-thread thread))
- 1)))
+ (let* ((number
+ ;; Fix by Luc Van Eycken <Luc.VanEycken@esat.kuleuven.ac.be>.
+ (if (and (consp thread) (cdr thread))
+ (apply
+ '+ 1 (mapcar
+ 'gnus-summary-number-of-articles-in-thread
+ (cdr thread)))
+ 1)))
(if char
(if (> number 1) gnus-not-empty-thread-mark
gnus-empty-thread-mark)
number)))
-(defun gnus-summary-read-group (group &optional show-all no-article kill-buffer)
+(defun gnus-summary-read-group
+ (group &optional show-all no-article kill-buffer)
"Start reading news in newsgroup GROUP.
If SHOW-ALL is non-nil, already read articles are also listed.
If NO-ARTICLE is non-nil, no article is selected initially."
(gnus-message 5 "Retrieving newsgroup: %s..." group)
(let* ((new-group (gnus-summary-setup-buffer group))
- (did-select (and new-group (gnus-select-newsgroup group show-all)))
- (method (car (gnus-find-method-for-group group))))
+ (quit-config (nth 1 (assoc 'quit-config (gnus-find-method-for-group
+ group))))
+ (did-select (and new-group (gnus-select-newsgroup group show-all))))
(cond
((not new-group)
(gnus-set-global-variables)
(gnus-kill-buffer kill-buffer)
- (gnus-configure-windows 'summary)
+ (gnus-configure-windows 'summary 'force)
(gnus-set-mode-line 'summary)
(gnus-summary-position-cursor)
(message "")
(not (equal (current-buffer) kill-buffer))
(progn
(kill-buffer (current-buffer))
- (set-buffer gnus-group-buffer)
- (gnus-group-next-unread-group 1)))
+ (if (not quit-config)
+ (progn
+ (set-buffer gnus-group-buffer)
+ (gnus-group-jump-to-group group)
+ (gnus-group-next-unread-group 1))
+ (if (not (buffer-name (car quit-config)))
+ (gnus-configure-windows 'group 'force)
+ (set-buffer (car quit-config))
+ (and (eq major-mode 'gnus-summary-mode)
+ (gnus-set-global-variables))
+ (gnus-configure-windows (cdr quit-config))))))
(message "Can't select group")
nil)
((eq did-select 'quit)
(not (equal (current-buffer) kill-buffer))
(kill-buffer (current-buffer)))
(gnus-kill-buffer kill-buffer)
- (gnus-configure-windows 'group)
- (gnus-group-next-unread-group 1)
+ (if (not quit-config)
+ (progn
+ (set-buffer gnus-group-buffer)
+ (gnus-group-jump-to-group group)
+ (gnus-group-next-unread-group 1)
+ (gnus-configure-windows 'group 'force))
+ (if (not (buffer-name (car quit-config)))
+ (gnus-configure-windows 'group 'force)
+ (set-buffer (car quit-config))
+ (and (eq major-mode 'gnus-summary-mode)
+ (gnus-set-global-variables))
+ (gnus-configure-windows (cdr quit-config))))
(signal 'quit nil))
(t
(gnus-set-global-variables)
(run-hooks 'gnus-select-group-hook)
;; Do score processing.
(and gnus-use-scoring (gnus-possibly-score-headers))
- ;; Update the format specifiers.
(gnus-update-format-specifications)
;; Generate the summary buffer.
(gnus-summary-prepare)
(gnus-message 6 "No unread news")
(gnus-kill-buffer kill-buffer)
nil)
- (save-excursion
- (if kill-buffer
- (let ((gnus-summary-buffer kill-buffer))
- (gnus-configure-windows 'group))))
+ ;;(save-excursion
+ ;; (if kill-buffer
+ ;; (let ((gnus-summary-buffer kill-buffer))
+ ;; (gnus-configure-windows 'group))))
;; Hide conversation thread subtrees. We cannot do this in
;; gnus-summary-prepare-hook since kill processing may not
;; work with hidden articles.
(if (and (not no-article)
gnus-auto-select-first
(gnus-summary-first-unread-article))
- (gnus-configure-windows 'article)
- (gnus-configure-windows 'summary))
+ ()
+ (gnus-configure-windows 'summary 'force))
(gnus-set-mode-line 'summary)
(gnus-summary-position-cursor)
;; If in async mode, we send some info to the backend.
(funcall gnus-asynchronous-article-function
gnus-newsgroup-threads)
gnus-newsgroup-threads)))
- (gnus-kill-buffer kill-buffer))
+ (gnus-kill-buffer kill-buffer)
+ (if (not (get-buffer-window gnus-group-buffer))
+ ()
+ ;; gotta use windows, because recenter does wierd stuff if
+ ;; the current buffer ain't the displayed window.
+ (let ((owin (selected-window)))
+ (select-window (get-buffer-window gnus-group-buffer))
+ (and (gnus-group-goto-group group)
+ (recenter))
+ (select-window owin))))
t))))
(defun gnus-summary-prepare ()
(gnus-make-threads-and-expunge)
(gnus-make-threads))))
gnus-newsgroup-headers)
- 0 nil nil t)
- ;; Erase header retrieval message.
+ 'cull)
(gnus-summary-update-lines)
- (message "")
- ;; Remove the final newline.
- ;;(goto-char (point-max))
- ;;(delete-char -1)
+ ;; Create the header hashtb.
+ (gnus-make-headers-hashtable-by-number)
;; Call hooks for modifying summary buffer.
;; Suggested by sven@tde.LTH.Se (Sven Mattisson).
(goto-char (point-min))
(run-hooks 'gnus-summary-prepare-hook)))
-(defun gnus-subject-equal (s1 s2)
- (cond
- ((numberp gnus-summary-gather-subject-limit)
- (string= (if (> (length s1) gnus-summary-gather-subject-limit)
- (substring s1 0 gnus-summary-gather-subject-limit)
- s1)
- (if (> (length s2) gnus-summary-gather-subject-limit)
- (substring s2 0 gnus-summary-gather-subject-limit)
- s2)))
- ((eq 'fuzzy gnus-summary-gather-subject-limit)
- (string= (gnus-simplify-subject-fuzzy s1)
- (gnus-simplify-subject-fuzzy s2)))
- (t
- (string= s1 s2))))
-
(defun gnus-gather-threads (threads)
"Gather threads that have lost their roots."
(if (not gnus-summary-make-false-root)
(let ((hashtb (gnus-make-hashtable 1023))
(prev threads)
(result threads)
- thread subject hthread whole-subject)
+ subject hthread whole-subject)
(while threads
(setq whole-subject
- (setq subject (header-subject (car (car threads)))))
+ (setq subject (mail-header-subject (car (car threads)))))
(if gnus-summary-gather-subject-limit
(or (and (numberp gnus-summary-gather-subject-limit)
(> (length subject) gnus-summary-gather-subject-limit)
;; `gnus-get-newsgroup-headers' and builds the trees. First we go
;; through the dependecies in the hash table and finds all the
;; roots. Roots do not refer back to any valid articles.
- (let (roots)
- (and gnus-fetch-old-headers (eq gnus-headers-retrieved-by 'nov)
+ (gnus-message 6 "Threading...")
+ (let (roots new-roots)
+ (and gnus-fetch-old-headers
+ (eq gnus-headers-retrieved-by 'nov)
(gnus-build-old-threads))
(mapatoms
(lambda (refs)
(or gnus-thread-ignore-subject
(let* ((prev (symbol-value refs))
(subject (gnus-simplify-subject-re
- (header-subject (car prev))))
+ (mail-header-subject (car prev))))
(headers (cdr prev)))
(while headers
(if (not (string= subject
(gnus-simplify-subject-re
- (header-subject (car headers)))))
+ (mail-header-subject (car headers)))))
(progn
- (setq roots (cons (car headers) roots))
+ (setq new-roots (cons (car headers) new-roots))
(setcdr prev (cdr headers)))
(setq prev headers))
(setq headers (cdr headers)))))))
gnus-newsgroup-dependencies)
-
- (mapcar 'gnus-trim-thread
- (apply 'append
- (mapcar 'gnus-cut-thread
- (mapcar 'gnus-make-sub-thread roots))))))
+
+ ;; We enter the new roots into the dependencies structure to
+ ;; ensure that any possible later thread-regeneration will be
+ ;; possible.
+ (let ((r new-roots))
+ (while r
+ (gnus-sethash (concat (mail-header-id (car r)) ".boo")
+ (list nil (car r)) gnus-newsgroup-dependencies)
+ (setq r (cdr r))))
+
+ (setq roots (nconc new-roots roots))
+
+ (prog1
+ (mapcar 'gnus-trim-thread
+ (apply 'append
+ (mapcar 'gnus-cut-thread
+ (mapcar 'gnus-make-sub-thread roots))))
+ (gnus-message 6 "Threading...done"))))
+
(defun gnus-make-threads-and-expunge ()
;; This function takes the dependencies already made by
;; `gnus-get-newsgroup-headers' and builds the trees. First we go
;; through the dependecies in the hash table and finds all the
;; roots. Roots do not refer back to any valid articles.
+ (gnus-message 6 "Threading...")
(let ((default (or gnus-summary-default-score 0))
(below gnus-summary-expunge-below)
- roots article)
- (and gnus-fetch-old-headers (eq gnus-headers-retrieved-by 'nov)
+ roots article new-roots)
+ (and gnus-fetch-old-headers
+ (eq gnus-headers-retrieved-by 'nov)
(gnus-build-old-threads))
(mapatoms
(lambda (refs)
(let ((headers (cdr (symbol-value refs))))
;; We weed out the low-scored articles.
(while headers
- (if (not (< (or (cdr (assq (header-number (car headers))
+ (if (not (< (or (cdr (assq (mail-header-number (car headers))
gnus-newsgroup-scored)) default)
below))
;; It is over.
(setq roots (cons (car headers) roots))
;; It is below, so we mark it as read.
(setq gnus-newsgroup-unreads
- (delq (header-number (car headers))
- gnus-newsgroup-unreads)))
+ (delq (mail-header-number (car headers))
+ gnus-newsgroup-unreads))
+ (setq gnus-newsgroup-reads
+ (cons (cons (mail-header-number (car headers))
+ gnus-low-score-mark)
+ gnus-newsgroup-reads)))
(setq headers (cdr headers))))
;; Ok, these refer back to valid articles, but if
;; `gnus-thread-ignore-subject' is nil, we have to check that
(or gnus-thread-ignore-subject
(let* ((prev (symbol-value refs))
(subject (gnus-simplify-subject-re
- (header-subject (car prev))))
+ (mail-header-subject (car prev))))
(headers (cdr prev)))
(while headers
(if (not (string= subject
(gnus-simplify-subject-re
- (header-subject (car headers)))))
+ (mail-header-subject (car headers)))))
(progn
- (if (not (< (or (cdr (assq (header-number (car headers))
+ (if (not (< (or (cdr (assq (mail-header-number
+ (car headers))
gnus-newsgroup-scored))
default) below))
- (setq roots (cons (car headers) roots))
+ (setq new-roots (cons (car headers) new-roots))
(setq gnus-newsgroup-unreads
- (delq (header-number (car headers))
- gnus-newsgroup-unreads)))
+ (delq (mail-header-number (car headers))
+ gnus-newsgroup-unreads))
+ (setq gnus-newsgroup-reads
+ (cons (cons (mail-header-number (car headers))
+ gnus-low-score-mark)
+ gnus-newsgroup-reads)))
(setcdr prev (cdr headers)))
(setq prev headers))
(setq headers (cdr headers)))))
;; If this article is expunged, some of the children might be
;; roots.
- (if (< (or (cdr (assq (header-number (car (symbol-value refs)))
+ (if (< (or (cdr (assq (mail-header-number (car (symbol-value refs)))
gnus-newsgroup-scored)) default)
below)
(let* ((prev (symbol-value refs))
(headers (cdr prev)))
(while headers
- (setq article (header-number (car headers)))
+ (setq article (mail-header-number (car headers)))
(if (not (< (or (cdr (assq article gnus-newsgroup-scored))
default) below))
- (progn (setq roots (cons (car headers) roots))
+ (progn (setq new-roots (cons (car headers) new-roots))
(setq prev headers))
(setq gnus-newsgroup-unreads
(delq article gnus-newsgroup-unreads))
+ (setq gnus-newsgroup-reads
+ (cons (cons article gnus-low-score-mark)
+ gnus-newsgroup-reads))
(setcdr prev (cdr headers)))
(setq headers (cdr headers))))
;; It was not expunged, but we look at expunged children.
(let* ((prev (symbol-value refs))
(headers (cdr prev))
- article id)
+ article)
(while headers
- (setq article (header-number (car headers)))
+ (setq article (mail-header-number (car headers)))
(if (not (< (or (cdr (assq article gnus-newsgroup-scored))
default) below))
(setq prev headers)
(setq gnus-newsgroup-unreads
(delq article gnus-newsgroup-unreads))
+ (setq gnus-newsgroup-reads
+ (cons (cons article gnus-low-score-mark)
+ gnus-newsgroup-reads))
(setcdr prev (cdr headers)))
(setq headers (cdr headers)))))))
gnus-newsgroup-dependencies)
- (mapcar 'gnus-trim-thread
- (apply 'append
- (mapcar 'gnus-cut-thread
- (mapcar 'gnus-make-sub-thread roots))))))
+ ;; We enter the new roots into the dependencies structure to
+ ;; ensure that any possible later thread-regeneration will be
+ ;; possible.
+ (let ((r new-roots))
+ (while r
+ (gnus-sethash (concat (mail-header-id (car r)) ".boo")
+ (list nil (car r)) gnus-newsgroup-dependencies)
+ (setq r (cdr r))))
+
+ (setq roots (nconc new-roots roots))
+
+ (prog1
+ (mapcar 'gnus-trim-thread
+ (apply 'append
+ (mapcar 'gnus-cut-thread
+ (mapcar 'gnus-make-sub-thread roots))))
+ (gnus-message 6 "Threading...done"))))
+
(defun gnus-cut-thread (thread)
;; Remove leaf dormant or ancient articles from THREAD.
(let ((head (car thread))
(tail (apply 'append (mapcar 'gnus-cut-thread (cdr thread)))))
(if (and (null tail)
- (let ((number (header-number head)))
+ (let ((number (mail-header-number head)))
(or (memq number gnus-newsgroup-ancient)
(memq number gnus-newsgroup-dormant)
(and gnus-summary-expunge-below
(progn
(setq gnus-newsgroup-unreads
(delq number gnus-newsgroup-unreads))
+ (setq gnus-newsgroup-reads
+ (cons (cons number gnus-low-score-mark)
+ gnus-newsgroup-reads))
t)))))
nil
(list (cons head tail)))))
(defun gnus-trim-thread (thread)
;; Remove root ancient articles with only one child from THREAD.
(if (and (eq gnus-fetch-old-headers 'some)
- (memq (header-number (car thread)) gnus-newsgroup-ancient)
+ (memq (mail-header-number (car thread)) gnus-newsgroup-ancient)
(= (length thread) 2))
(gnus-trim-thread (nth 1 thread))
thread))
(defun gnus-make-sub-thread (root)
;; This function makes a sub-tree for a node in the tree.
- (let ((children (reverse (cdr (gnus-gethash (downcase (header-id root))
+ (let ((children (reverse (cdr (gnus-gethash (downcase (mail-header-id root))
gnus-newsgroup-dependencies)))))
(cons root (mapcar 'gnus-make-sub-thread children))))
(progn
(setq heads (cdr (symbol-value refs)))
(while heads
- (if (not (memq (header-number (car heads))
+ (if (not (memq (mail-header-number (car heads))
gnus-newsgroup-dormant))
(progn
(setq id (symbol-name refs))
(and
(setq header (gnus-nov-parse-line
(read (current-buffer)) deps))
- (setq ref (header-references header))
+ (setq ref (mail-header-references header))
(string-match "\\(<[^>]+>\\) *$" ref)
(substring ref (match-beginning 1) (match-end 1))))))
(and header
(setq gnus-newsgroup-headers (cons header gnus-newsgroup-headers)
- gnus-newsgroup-ancient (cons (header-number header)
+ gnus-newsgroup-ancient (cons (mail-header-number header)
gnus-newsgroup-ancient))))))
;; Re-build the thread containing ID.
(while (and id (setq headers
(car (setq art (gnus-gethash (downcase id) dep)))))
(setq parent art)
- (setq id (and (setq refs (header-references headers))
+ (setq id (and (setq refs (mail-header-references headers))
(string-match "\\(<[^>]+>\\) *$" refs)
(substring refs (match-beginning 1) (match-end 1)))))
(setq thread (gnus-make-sub-thread (car parent)))
(gnus-rebuild-remove-articles thread)
(let ((beg (point)))
- (gnus-summary-prepare-threads (list thread) 0)
+ (gnus-summary-prepare-threads (list thread))
(gnus-summary-update-lines beg (point)))))
;; Delete all lines in the summary buffer that correspond to articles
;; in this thread.
(defun gnus-rebuild-remove-articles (thread)
- (and (gnus-summary-goto-subject (header-number (car thread)))
+ (and (gnus-summary-goto-subject (mail-header-number (car thread)))
(gnus-delete-line))
(mapcar (lambda (th) (gnus-rebuild-remove-articles th)) (cdr thread)))
fun (cdr fun))))
threads)
-(defun gnus-thread-header (thread)
+;; Written by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>.
+(defmacro gnus-thread-header (thread)
;; Return header of first article in THREAD.
- (if (consp thread)
- (if (stringp (car thread))
- (car (car (cdr thread)))
- (car thread))
- thread))
+ ;; Note that THREAD must never, evr be anything else than a variable -
+ ;; using some other form will lead to serious barfage.
+ (or (symbolp thread) (signal 'wrong-type-argument '(symbolp thread)))
+ ;; (8% speedup to gnus-summary-prepare, just for fun :-)
+ (list 'byte-code "\10\211:\203\17\0\211@;\203\16\0A@@\207" ;
+ (vector thread) 2))
(defun gnus-thread-sort-by-number (h1 h2)
"Sort threads by root article number."
- (let ((h1 (gnus-thread-header h1))
- (h2 (gnus-thread-header h2)))
- (< (header-number h1) (header-number h2))))
+ (< (mail-header-number (gnus-thread-header h1))
+ (mail-header-number (gnus-thread-header h2))))
(defun gnus-thread-sort-by-author (h1 h2)
"Sort threads by root author."
- (let ((h1 (gnus-thread-header h1))
- (h2 (gnus-thread-header h2)))
- (string-lessp
- (let ((extract (funcall
- gnus-extract-address-components (header-from h1))))
- (or (car extract) (cdr extract)))
- (let ((extract (funcall
- gnus-extract-address-components (header-from h2))))
- (or (car extract) (cdr extract))))))
+ (string-lessp
+ (let ((extract (funcall
+ gnus-extract-address-components
+ (mail-header-from (gnus-thread-header h1)))))
+ (or (car extract) (cdr extract)))
+ (let ((extract (funcall
+ gnus-extract-address-components
+ (mail-header-from (gnus-thread-header h2)))))
+ (or (car extract) (cdr extract)))))
(defun gnus-thread-sort-by-subject (h1 h2)
"Sort threads by root subject."
- (let ((h1 (gnus-thread-header h1))
- (h2 (gnus-thread-header h2)))
- (string-lessp
- (downcase (gnus-simplify-subject (header-subject h1)))
- (downcase (gnus-simplify-subject (header-subject h2))))))
+ (string-lessp
+ (downcase (gnus-simplify-subject
+ (mail-header-subject (gnus-thread-header h1))))
+ (downcase (gnus-simplify-subject
+ (mail-header-subject (gnus-thread-header h2))))))
(defun gnus-thread-sort-by-date (h1 h2)
"Sort threads by root article date."
- (let ((h1 (gnus-thread-header h1))
- (h2 (gnus-thread-header h2)))
- (string-lessp
- (gnus-sortable-date (header-date h1))
- (gnus-sortable-date (header-date h2)))))
+ (string-lessp
+ (gnus-sortable-date (mail-header-date (gnus-thread-header h1)))
+ (gnus-sortable-date (mail-header-date (gnus-thread-header h2)))))
(defun gnus-thread-sort-by-score (h1 h2)
"Sort threads by root article score.
-Unscored articles will be counted as havin a score of zero."
- (let ((h1 (gnus-thread-header h1))
- (h2 (gnus-thread-header h2)))
- (let ((s1 (assq (header-number h1) gnus-newsgroup-scored))
- (s2 (assq (header-number h2) gnus-newsgroup-scored)))
- (> (or (cdr s1) gnus-summary-default-score 0)
- (or (cdr s2) gnus-summary-default-score 0)))))
+Unscored articles will be counted as having a score of zero."
+ (> (or (cdr (assq (mail-header-number (gnus-thread-header h1))
+ gnus-newsgroup-scored))
+ gnus-summary-default-score 0)
+ (or (cdr (assq (mail-header-number (gnus-thread-header h2))
+ gnus-newsgroup-scored))
+ gnus-summary-default-score 0)))
(defun gnus-thread-sort-by-total-score (h1 h2)
"Sort threads by the sum of all scores in the thread.
-Unscored articles will be counted as havin a score of zero."
+Unscored articles will be counted as having a score of zero."
(> (gnus-thread-total-score h1) (gnus-thread-total-score h2)))
(defun gnus-thread-total-score (thread)
;; This function find the total score of the thread below ROOT.
(setq root (car root))
(apply gnus-thread-score-function
- (or (cdr (assq (header-number root) gnus-newsgroup-scored))
+ (or (cdr (assq (mail-header-number root) gnus-newsgroup-scored))
gnus-summary-default-score 0)
(mapcar 'gnus-thread-total-score
- (cdr (gnus-gethash (downcase (header-id root))
+ (cdr (gnus-gethash (downcase (mail-header-id root))
gnus-newsgroup-dependencies)))))
;; Added by Per Abrahamsen <amanda@iesd.auc.dk>.
(defvar gnus-tmp-prev-subject "")
-(defvar gnus-tmp-adopt-thread nil)
-;; Basic ideas by Paul Dworkin <paul@media-lab.media.mit.edu>.
-(defun gnus-summary-prepare-threads
- (threads level &optional not-child no-subject cull)
+(defun gnus-summary-prepare-threads (threads &optional cull)
"Prepare summary buffer from THREADS and indentation LEVEL.
THREADS is either a list of `(PARENT [(CHILD1 [(GRANDCHILD ...]...) ...])'
or a straight list of headers."
- (let (thread header number subject clevel)
- (while threads
- (setq thread (car threads)
- threads (cdr threads))
- ;; If `thread' is a cons, hierarchical threads are used. If not,
- ;; `thread' is the header.
- (if (consp thread)
- (setq header (car thread))
- (setq header thread)
- (and cull
- (or (memq (setq number (header-number header))
- gnus-newsgroup-dormant)
- (and gnus-summary-expunge-below
- (< (or (cdr (assq number gnus-newsgroup-scored))
- gnus-summary-default-score 0)
- gnus-summary-expunge-below)))
- (progn
- (setq header nil)
- (setq gnus-newsgroup-unreads
- (delq number gnus-newsgroup-unreads)))))
+ (message "Generating summary...")
+ (let ((level 0)
+ thread header number subject stack state gnus-tmp-gathered)
+ (if (vectorp (car threads))
+ ;; If this is a straight (sic) list of headers, then a
+ ;; threaded summary display isn't required, so we just create
+ ;; an unthreaded one.
+ (gnus-summary-prepare-unthreaded threads cull)
+
+ ;; Do the threaded display.
+
+ (while (or threads stack)
+
+ (if threads
+ ;; If there are some threads, we do them before the
+ ;; threads on the stack.
+ (setq thread threads
+ header (car (car thread)))
+ ;; There were no current threads, so we pop something off
+ ;; the stack.
+ (setq state (car stack)
+ level (car state)
+ thread (cdr state)
+ stack (cdr stack)
+ header (car (car thread))))
+
+ (if (stringp header)
+ (progn
+ ;; The header is a dummy root.
+ (cond
+ ((eq gnus-summary-make-false-root 'adopt)
+ ;; We let the first article adopt the rest.
+ (let ((th (car (cdr (car thread)))))
+ (while (cdr th)
+ (setq th (cdr th)))
+ (setcdr th (cdr (cdr (car thread))))
+ (setq gnus-tmp-gathered
+ (nconc (mapcar
+ (lambda (h) (mail-header-number (car h)))
+ (cdr (cdr (car thread))))
+ gnus-tmp-gathered))
+ (setcdr (cdr (car thread)) nil))
+ (setq level -1))
+ ((eq gnus-summary-make-false-root 'empty)
+ ;; We print adopted articles with empty subject fields.
+ (setq gnus-tmp-gathered
+ (nconc (mapcar
+ (lambda (h) (mail-header-number (car h)))
+ (cdr (cdr (car thread))))
+ gnus-tmp-gathered))
+ (setq level -1))
+ ((eq gnus-summary-make-false-root 'dummy)
+ ;; We output a dummy root.
+ (gnus-summary-insert-dummy-line
+ nil header (mail-header-number
+ (car (car (cdr (car thread)))))))
+ (t
+ ;; We do not make a root for the gathered
+ ;; sub-threads at all.
+ (setq level -1))))
+
+ (setq number (mail-header-number header)
+ subject (mail-header-subject header))
+
+ ;; Do the async thing.
+ (and gnus-newsgroup-async
+ (setq gnus-newsgroup-threads
+ (cons (cons number (mail-header-lines header))
+ gnus-newsgroup-threads)))
+
+ ;; We may have to root out some bad articles...
+ (and cull
+ (= level 0)
+ (cond ((and (memq (setq number (mail-header-number header))
+ gnus-newsgroup-dormant)
+ (null thread))
+ (setq header nil))
+ ((and gnus-summary-expunge-below
+ (< (or (cdr (assq number gnus-newsgroup-scored))
+ gnus-summary-default-score 0)
+ gnus-summary-expunge-below))
+ (setq header nil)
+ (setq gnus-newsgroup-unreads
+ (delq number gnus-newsgroup-unreads))
+ (setq gnus-newsgroup-reads
+ (cons (cons number gnus-low-score-mark)
+ gnus-newsgroup-reads)))))
+
+ (and
+ header
+ (progn
+ (inline
+ (gnus-summary-insert-line
+ nil header level nil
+ (cond
+ ((memq number gnus-newsgroup-marked) gnus-ticked-mark)
+ ((memq number gnus-newsgroup-dormant) gnus-dormant-mark)
+ ((memq number gnus-newsgroup-unreads) gnus-unread-mark)
+ ((memq number gnus-newsgroup-expirable) gnus-expirable-mark)
+ (t (or (cdr (assq number gnus-newsgroup-reads))
+ gnus-ancient-mark)))
+ (memq number gnus-newsgroup-replied)
+ (memq number gnus-newsgroup-expirable)
+ (cond
+ ((and gnus-thread-ignore-subject
+ (not (string=
+ (gnus-simplify-subject-re gnus-tmp-prev-subject)
+ (gnus-simplify-subject-re subject))))
+ subject)
+ ((zerop level)
+ (if (and (eq gnus-summary-make-false-root 'empty)
+ (memq number gnus-tmp-gathered))
+ gnus-summary-same-subject
+ subject))
+ (t gnus-summary-same-subject))
+ (and (eq gnus-summary-make-false-root 'adopt)
+ (memq number gnus-tmp-gathered))
+ (cdr (assq number gnus-newsgroup-scored)))
+
+ (setq gnus-tmp-prev-subject subject)))))
+
+ (if (nth 1 thread)
+ (setq stack (cons (cons (max 0 level) (nthcdr 1 thread)) stack)))
+ (setq level (1+ level))
+ (setq threads (cdr (car thread))))))
+ (message "Generating summary...done"))
+
+
+
+(defun gnus-summary-prepare-unthreaded (headers &optional cull)
+ (let (header number)
+
+ ;; Do the async thing, if that is required.
+ (if gnus-newsgroup-async
+ (setq gnus-newsgroup-threads
+ (mapcar (lambda (h)
+ (cons (mail-header-number h) (mail-header-lines h)))
+ headers)))
+
+ (while headers
+ (setq header (car headers)
+ headers (cdr headers)
+ number (mail-header-number header))
+
+ ;; We may have to root out some bad articles...
(cond
- ((stringp header)
- ;; The header is a dummy root.
- (cond ((eq gnus-summary-make-false-root 'adopt)
- ;; We let the first article adopt the rest.
- (let ((gnus-tmp-adopt-thread (list (cdr thread))))
- (gnus-summary-prepare-threads (list (car (cdr thread))) 0))
- (setq thread (cdr (cdr thread)))
- (while thread
- (gnus-summary-prepare-threads (list (car thread)) 1 t)
- (setq thread (cdr thread))))
- ((eq gnus-summary-make-false-root 'dummy)
- ;; We output a dummy root.
- (gnus-summary-insert-dummy-line
- nil header (header-number (car (car (cdr thread)))))
- (setq clevel 1))
- ((eq gnus-summary-make-false-root 'empty)
- ;; We print the articles with empty subject fields.
- (let ((gnus-tmp-adopt-thread (list (cdr thread))))
- (gnus-summary-prepare-threads (list (car (cdr thread))) 0))
- (setq thread (cdr (cdr thread)))
- (while thread
- (gnus-summary-prepare-threads
- (list (car thread)) 0 nil
- (not (and (eq gnus-summary-gather-subject-limit 'fuzzy)
- (not (string=
- (gnus-simplify-subject-re
- (header-subject (car (car thread))))
- (gnus-simplify-subject-re header))))))
- (setq thread (cdr thread))))
- (t
- ;; We do not make a root for the gathered
- ;; sub-threads at all.
- (setq clevel 0)))
- ;; Print the sub-threads.
- (and (consp thread) (cdr thread)
- (gnus-summary-prepare-threads (cdr thread) clevel)))
- ;; The header is a real article.
- (header
- (setq number (header-number header)
- subject (header-subject header))
- (and gnus-newsgroup-async
- (setq gnus-newsgroup-threads
- (cons (cons (header-number header)
- (header-lines header)) gnus-newsgroup-threads)))
+ ((and cull
+ (memq (setq number (mail-header-number header))
+ gnus-newsgroup-dormant)))
+ ((and cull gnus-summary-expunge-below
+ (< (or (cdr (assq number gnus-newsgroup-scored))
+ gnus-summary-default-score 0)
+ gnus-summary-expunge-below))
+ (setq gnus-newsgroup-unreads
+ (delq number gnus-newsgroup-unreads))
+ (setq gnus-newsgroup-reads
+ (cons (cons number gnus-low-score-mark)
+ gnus-newsgroup-reads)))
+ (t
(gnus-summary-insert-line
- nil header level nil
+ nil header 0 nil
(cond ((memq number gnus-newsgroup-marked) gnus-ticked-mark)
((memq number gnus-newsgroup-dormant) gnus-dormant-mark)
((memq number gnus-newsgroup-unreads) gnus-unread-mark)
((memq number gnus-newsgroup-expirable) gnus-expirable-mark)
- (t gnus-ancient-mark))
+ (t (or (cdr (assq number gnus-newsgroup-reads))
+ gnus-ancient-mark)))
(memq number gnus-newsgroup-replied)
(memq number gnus-newsgroup-expirable)
- (if no-subject
- gnus-summary-same-subject
- (if (or (zerop level)
- (and gnus-thread-ignore-subject
- (not (string=
- (gnus-simplify-subject-re gnus-tmp-prev-subject)
- (gnus-simplify-subject-re subject)))))
- subject
- gnus-summary-same-subject))
- not-child
- (cdr (assq number gnus-newsgroup-scored)))
- (setq gnus-tmp-prev-subject subject)
- ;; Recursively print subthreads.
- (and (consp thread) (cdr thread)
- (gnus-summary-prepare-threads (cdr thread) (1+ level))))))))
+ (mail-header-subject header) nil
+ (cdr (assq number gnus-newsgroup-scored))))))))
(defun gnus-select-newsgroup (group &optional read-all)
"Select newsgroup GROUP.
If READ-ALL is non-nil, all articles in the group are selected."
(let* ((entry (gnus-gethash group gnus-newsrc-hashtb))
(info (nth 2 entry))
- articles header-marks)
- (gnus-check-news-server
- (setq gnus-current-select-method (gnus-find-method-for-group group)))
+ articles)
- (or (gnus-server-opened gnus-current-select-method)
- (gnus-open-server gnus-current-select-method)
+ (or (gnus-check-server
+ (setq gnus-current-select-method (gnus-find-method-for-group group)))
(error "Couldn't open server"))
- (or (and (eq (car entry) t)
- (gnus-activate-newsgroup (car info)))
- (gnus-request-group group t)
- (progn
+ (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.
(kill-buffer (current-buffer))
(error "Couldn't request group %s: %s"
group (gnus-status-message group))))
(setq gnus-newsgroup-dependencies
(gnus-make-hashtable (length articles)))
;; Retrieve the headers and read them in.
+ (gnus-message 5 "Fetching headers...")
(setq gnus-newsgroup-headers
(if (eq 'nov (setq gnus-headers-retrieved-by
- (gnus-retrieve-headers
- (if gnus-fetch-old-headers
- (cons 1 articles) articles)
- gnus-newsgroup-name)))
+ ;; This is a naughty hack. To get the
+ ;; retrieval of old headers to work, we
+ ;; set `nntp-nov-gap' to nil (locally),
+ ;; and then just retrieve the headers.
+ ;; Mucho magic.
+ (if gnus-fetch-old-headers
+ (let (nntp-nov-gap)
+ (gnus-retrieve-headers
+ (if (not (eq 1 (car articles)))
+ (cons 1 articles)
+ articles)
+ gnus-newsgroup-name))
+ (gnus-retrieve-headers
+ articles gnus-newsgroup-name))))
(progn
(gnus-get-newsgroup-headers-xover articles))
+ ;; If we were to fetch old headers, but the backend didn't
+ ;; support XOVER, then it is possible we fetched one article
+ ;; that we shouldn't have. If that's the case, we remove it.
+ (if (or (not gnus-fetch-old-headers)
+ (eq 1 (car articles)))
+ ()
+ (save-excursion
+ (set-buffer nntp-server-buffer)
+ (goto-char (point-min))
+ (and
+ (looking-at "[0-9]+[ \t]+1[ \t]") ; This is not a NOV line.
+ (delete-region ; So we delete this head.
+ (point)
+ (search-forward "\n.\n" nil t)))))
(gnus-get-newsgroup-headers)))
- ;; If we were to fetch old headers, but the backend didn't
- ;; support XOVER, then it is possible we fetched one article
- ;; that we shouldn't have. If that's the case, we pop it off the
- ;; list of headers.
- (and (not (eq gnus-headers-retrieved-by 'nov))
- gnus-fetch-old-headers
- gnus-newsgroup-headers
- (/= (header-number (car gnus-newsgroup-headers)) (car articles))
- (setq gnus-newsgroup-headers (cdr gnus-newsgroup-headers)))
- ;; Remove cancelled articles from the list of unread articles.
+ (gnus-message 5 "Fetching headers...done")
+ ;; Remove canceled articles from the list of unread articles.
(setq gnus-newsgroup-unreads
(gnus-set-sorted-intersection
gnus-newsgroup-unreads
- (mapcar (lambda (headers) (header-number headers))
+ (mapcar (lambda (headers) (mail-header-number headers))
gnus-newsgroup-headers)))
;; Adjust and set lists of article marks.
(and info
(let (marked)
(gnus-adjust-marked-articles info)
(setq gnus-newsgroup-marked
- (cdr (assq 'tick (setq marked (nth 3 info)))))
- (setq gnus-newsgroup-replied (cdr (assq 'reply marked)))
- (setq gnus-newsgroup-expirable (cdr (assq 'expire marked)))
- (setq gnus-newsgroup-killed (cdr (assq 'killed marked)))
- (setq gnus-newsgroup-bookmarks (cdr (assq 'bookmark marked)))
- (setq gnus-newsgroup-dormant (cdr (assq 'dormant marked)))
- (setq gnus-newsgroup-scored (cdr (assq 'score marked)))
+ (copy-sequence
+ (cdr (assq 'tick (setq marked (nth 3 info))))))
+ (setq gnus-newsgroup-replied
+ (copy-sequence (cdr (assq 'reply marked))))
+ (setq gnus-newsgroup-expirable
+ (copy-sequence (cdr (assq 'expire marked))))
+ (setq gnus-newsgroup-killed
+ (copy-sequence (cdr (assq 'killed marked))))
+ (setq gnus-newsgroup-bookmarks
+ (copy-sequence (cdr (assq 'bookmark marked))))
+ (setq gnus-newsgroup-dormant
+ (copy-sequence (cdr (assq 'dormant marked))))
+ (setq gnus-newsgroup-scored
+ (copy-sequence (cdr (assq 'score marked))))
(setq gnus-newsgroup-processable nil)))
;; Check whether auto-expire is to be done in this group.
(setq gnus-newsgroup-auto-expire
;; First and last article in this newsgroup.
(and gnus-newsgroup-headers
(setq gnus-newsgroup-begin
- (header-number (car gnus-newsgroup-headers)))
+ (mail-header-number (car gnus-newsgroup-headers)))
(setq gnus-newsgroup-end
- (header-number (gnus-last-element gnus-newsgroup-headers))))
+ (mail-header-number
+ (gnus-last-element gnus-newsgroup-headers))))
(setq gnus-reffed-article-number -1)
;; GROUP is successfully selected.
(or gnus-newsgroup-headers t)))))
(format
"How many articles from %s (default %d): "
gnus-newsgroup-name number))))
- (if (string-equal input "")
+ (if (string-match "^[ \t]*$" input)
number input)))
((and (> scored marked) (< scored number))
(let ((input
"%s %s (%d scored, %d total): "
"How many articles from"
group scored number))))
- (if (string-equal input "")
+ (if (string-match "^[ \t]*$" input)
number input)))
(t number))
- (quit nil)))))
- total-articles)
+ (quit nil))))))
(setq select (if (stringp select) (string-to-number select) select))
(if (or (null select) (zerop select))
select
(setq number (length articles)))
(setq articles (copy-sequence articles)))
- (setq total-articles articles)
-
(if (< (abs select) number)
(if (< select 0)
;; Select the N oldest articles.
"Remove all marked articles that are no longer legal."
(let ((marked-lists (nth 3 info))
(active (or active (gnus-gethash (car info) gnus-active-hashtb)))
- marked m prev)
+ m prev)
;; There are many types of marked articles.
(while marked-lists
(setq m (cdr (setq prev (car marked-lists))))
newmarked)))
(and score (setq newmarked (cons (cons 'score score) newmarked)))
(if (nthcdr 3 info)
- (if newmarked
- (setcar (nthcdr 3 info) newmarked)
- (if (not (nthcdr 4 info))
- (setcdr (nthcdr 2 info) nil)
- (setcar (nthcdr 3 info) nil)))
+ (progn
+ (setcar (nthcdr 3 info) newmarked)
+ (and (not newmarked)
+ (not (nthcdr 4 info))
+ (setcdr (nthcdr 2 info) nil)))
(if newmarked
- (setcdr (nthcdr 2 info) (cons newmarked nil))))))
+ (setcdr (nthcdr 2 info) (list newmarked))))))
(defun gnus-add-marked-articles (group type articles &optional info force)
;; Add ARTICLES of TYPE to the info of GROUP.
unread-and-unticked unselected))))
(subject
(if gnus-current-headers
- (header-subject gnus-current-headers) ""))
+ (mail-header-subject gnus-current-headers) ""))
(max-len (and gnus-mode-non-string-length
(- (frame-width) gnus-mode-non-string-length)))
- header) ;; passed as argument to any user-format-funcs
+ header);; passed as argument to any user-format-funcs
(setq mode-string (eval mformat))
(or (numberp max-len)
(setq max-len (length mode-string)))
(if (< max-len 4) (setq max-len 4))
(if (> (length mode-string) max-len)
+ ;; modified by MORIOKA Tomohiko <morioka@jaist.ac.jp>
+ ;; function `substring' might cut on a middle
+ ;; of multi-octet character.
(setq mode-string
- (concat (substring mode-string 0 (- max-len 3))
+ (concat (gnus-truncate-string mode-string (- max-len 3))
"...")))
(setq mode-string (format (format "%%-%ds" max-len)
mode-string))))
start group entry number xrefs header)
(while headers
(setq header (car headers))
- (if (and (setq xrefs (header-xref header))
- (not (memq (header-number header) unreads)))
+ (if (and (setq xrefs (mail-header-xref header))
+ (not (memq (mail-header-number header) unreads)))
(progn
(setq start 0)
(while (string-match "\\([^ ]+\\):\\([0-9]+\\)" xrefs start)
(assoc (symbol-name (car (gnus-find-method-for-group
from-newsgroup)))
gnus-valid-select-methods)))
- name entry read info xref-hashtb idlist active num range exps method
+ name entry info xref-hashtb idlist method
nth4)
(save-excursion
(set-buffer gnus-group-buffer)
;; Only do cross-references on subscribed
;; groups, if that is what is wanted.
(<= (nth 1 info) gnus-level-subscribed)))
- (progn
- (setq num 0)
- ;; Set the new list of read articles in this group.
- (setq active (gnus-gethash name gnus-active-hashtb))
- ;; First peel off all illegal article numbers.
- (if active
- (let ((ids idlist)
- (ticked (cdr (assq 'tick (nth 3 info))))
- (dormant (cdr (assq 'dormant (nth 3 info))))
- id)
- (setq exps nil)
- (while ids
- (setq id (car ids))
- (if (or (> id (cdr active))
- (< id (car active))
- (memq id ticked)
- (memq id dormant))
- (setq idlist (delq id idlist)))
- (and (memq id expirable)
- (setq exps (cons id exps)))
- (setq ids (cdr ids)))))
- ;; Update expirable articles.
- (gnus-add-marked-articles nil 'expirable exps info)
- (and active
- (null (nth 2 info))
- (> (car active) 1)
- (setcar (nthcdr 2 info) (cons 1 (1- (car active)))))
- (setcar (nthcdr 2 info)
- (setq range
- (gnus-add-to-range
- (nth 2 info)
- (setq idlist (sort idlist '<)))))
- ;; Then we have to re-compute how many unread
- ;; articles there are in this group.
- (if active
- (progn
- (cond
- ((not range)
- (setq num (- (1+ (cdr active)) (car active))))
- ((not (listp (cdr range)))
- (setq num (- (cdr active) (- (1+ (cdr range))
- (car range)))))
- (t
- (while range
- (if (numberp (car range))
- (setq num (1+ num))
- (setq num (+ num (- (1+ (cdr (car range)))
- (car (car range))))))
- (setq range (cdr range)))
- (setq num (- (cdr active) num))))
- ;; Update the number of unread articles.
- (setcar
- entry
- (max 0 (- num
- (length (cdr (assq 'tick (nth 3 info))))
- (length
- (cdr (assq 'dormant (nth 3 info)))))))
- ;; Update the group buffer.
- (gnus-group-update-group name t)))))))
+ (gnus-group-make-articles-read name idlist expirable))))
xref-hashtb)))))
+(defun gnus-group-make-articles-read (group articles expirable)
+ (let* ((num 0)
+ (entry (gnus-gethash group gnus-newsrc-hashtb))
+ (info (nth 2 entry))
+ (active (gnus-gethash group gnus-active-hashtb))
+ exps expirable range)
+ ;; First peel off all illegal article numbers.
+ (if active
+ (let ((ids articles)
+ (ticked (cdr (assq 'tick (nth 3 info))))
+ (dormant (cdr (assq 'dormant (nth 3 info))))
+ id first)
+ (setq exps nil)
+ (while ids
+ (setq id (car ids))
+ (if (and first (> id (cdr active)))
+ (progn
+ ;; We'll end up in this situation in one particular
+ ;; obscure situation. If you re-scan a group and get
+ ;; a new article that is cross-posted to a different
+ ;; group that has not been re-scanned, you might get
+ ;; crossposted article that has a higher number than
+ ;; Gnus believes possible. So we re-activate this
+ ;; group as well. This might mean doing the
+ ;; crossposting thingie will *increase* the number
+ ;; of articles in some groups. Tsk, tsk.
+ (setq active (or (gnus-activate-group group) active))))
+ (if (or (> id (cdr active))
+ (< id (car active))
+ (memq id ticked)
+ (memq id dormant))
+ (setq articles (delq id articles)))
+ (and (memq id expirable)
+ (setq exps (cons id exps)))
+ (setq ids (cdr ids)))))
+ ;; Update expirable articles.
+ (gnus-add-marked-articles nil 'expirable exps info)
+ (and active
+ (null (nth 2 info))
+ (> (car active) 1)
+ (setcar (nthcdr 2 info) (cons 1 (1- (car active)))))
+ (setcar (nthcdr 2 info)
+ (setq range
+ (gnus-add-to-range
+ (nth 2 info)
+ (setq articles (sort articles '<)))))
+ ;; Then we have to re-compute how many unread
+ ;; articles there are in this group.
+ (if active
+ (progn
+ (cond
+ ((not range)
+ (setq num (- (1+ (cdr active)) (car active))))
+ ((not (listp (cdr range)))
+ (setq num (- (cdr active) (- (1+ (cdr range))
+ (car range)))))
+ (t
+ (while range
+ (if (numberp (car range))
+ (setq num (1+ num))
+ (setq num (+ num (- (1+ (cdr (car range)))
+ (car (car range))))))
+ (setq range (cdr range)))
+ (setq num (- (cdr active) num))))
+ ;; Update the number of unread articles.
+ (setcar
+ entry
+ (max 0 (- num
+ (length (cdr (assq 'tick (nth 3 info))))
+ (length
+ (cdr (assq 'dormant (nth 3 info)))))))
+ ;; Update the group buffer.
+ (gnus-group-update-group group t)))))
+
(defun gnus-methods-equal-p (m1 m2)
(let ((m1 (or m1 gnus-select-method))
(m2 (or m2 gnus-select-method)))
(setq gnus-article-internal-prepare-hook nil)
(let ((cur nntp-server-buffer)
(dependencies gnus-newsgroup-dependencies)
- headers char article id dep end)
+ headers id dep end ref)
(save-excursion
(set-buffer nntp-server-buffer)
(goto-char (point-min))
;; do not begin with 2 or 3.
(while (re-search-forward "^[23][0-9]+ " nil t)
(let ((header (make-vector 9 nil))
- (c (following-char))
(case-fold-search t)
(p (point))
- from subject in-reply-to references ref)
+ in-reply-to)
(setq id nil
- ref nil
- references nil
- subject nil
- from nil)
- (header-set-number header (setq article (read cur)))
+ ref nil)
+ (mail-header-set-number header (read cur))
;; This implementation of this function, with nine
;; search-forwards instead of the one re-search-forward and
;; a case (which basically was the old function) is actually
(search-forward "\n.\n" nil t))
(point)))
(if (search-forward "\nfrom: " nil t)
- (header-set-from header (gnus-header-value))
- (header-set-from header "(nobody)"))
+ (mail-header-set-from header (gnus-header-value))
+ (mail-header-set-from header "(nobody)"))
(goto-char p)
(if (search-forward "\nsubject: " nil t)
- (header-set-subject header (gnus-header-value))
- (header-set-subject header "(none)"))
+ (mail-header-set-subject header (gnus-header-value))
+ (mail-header-set-subject header "(none)"))
(goto-char p)
(and (search-forward "\nxref: " nil t)
- (header-set-xref header (gnus-header-value)))
+ (mail-header-set-xref header (gnus-header-value)))
(goto-char p)
(or (numberp (and (search-forward "\nlines: " nil t)
- (header-set-lines header (read cur))))
- (header-set-lines header 0))
+ (mail-header-set-lines header (read cur))))
+ (mail-header-set-lines header 0))
(goto-char p)
(and (search-forward "\ndate: " nil t)
- (header-set-date header (gnus-header-value)))
+ (mail-header-set-date header (gnus-header-value)))
(goto-char p)
(if (search-forward "\nmessage-id: " nil t)
- (header-set-id header (setq id (gnus-header-value)))
+ (mail-header-set-id header (setq id (gnus-header-value)))
;; If there was no message-id, we just fake one to make
;; subsequent routines simpler.
- (header-set-id
+ (mail-header-set-id
header
(setq id (concat "none+"
(int-to-string
(goto-char p)
(if (search-forward "\nreferences: " nil t)
(progn
- (header-set-references header (gnus-header-value))
+ (mail-header-set-references header (gnus-header-value))
(setq end (match-end 0))
(save-excursion
(setq ref
(setq in-reply-to (gnus-header-value))
(string-match "<[^>]+>" in-reply-to))
(progn
- (header-set-references
+ (mail-header-set-references
header
(setq ref (substring in-reply-to (match-beginning 0)
(match-end 0))))
;; any additional Xrefs (in case the two articles
;; came from different servers.
(progn
- (header-set-xref
+ (mail-header-set-xref
(car (symbol-value dep))
- (concat (or (header-xref (car (symbol-value dep))) "")
- (or (header-xref header) "")))
+ (concat (or (mail-header-xref
+ (car (symbol-value dep))) "")
+ (or (mail-header-xref header) "")))
(setq header nil))
(setcar (symbol-value dep) header))
(set dep (list header)))
(setq gnus-article-internal-prepare-hook '(gnus-article-get-xrefs))
(let ((cur nntp-server-buffer)
(dependencies gnus-newsgroup-dependencies)
- (none 0)
number headers header)
(save-excursion
(set-buffer nntp-server-buffer)
nil
(gnus-nov-field)) ; misc
))
- (quit (progn
+ (error (progn
+ (ding)
+ (message "Strange nov line.")
(setq header nil)
(goto-char eol))))
;; Xrefs (in case the two articles came from different
;; servers.
(progn
- (header-set-xref
+ (mail-header-set-xref
(car (symbol-value dep))
- (concat (or (header-xref (car (symbol-value dep))) "")
- (or (header-xref header) "")))
+ (concat (or (mail-header-xref (car (symbol-value dep))) "")
+ (or (mail-header-xref header) "")))
(setq header nil))
(setcar (symbol-value dep) header))
(set dep (list header))))
(let ((headers (save-excursion (set-buffer gnus-summary-buffer)
gnus-current-headers)))
(or (not gnus-use-cross-reference)
- (and (header-xref headers)
- (not (string= (header-xref headers) "")))
+ (not headers)
+ (and (mail-header-xref headers)
+ (not (string= (mail-header-xref headers) "")))
(let ((case-fold-search t)
xref)
(save-restriction
(goto-char (1+ (match-end 0)))
(setq xref (buffer-substring (point)
(progn (end-of-line) (point))))
- (header-set-xref headers xref))))))))
+ (mail-header-set-xref headers xref))))))))
(defalias 'gnus-find-header-by-number 'gnus-get-header-by-number)
(make-obsolete 'gnus-find-header-by-number 'gnus-get-header-by-number)
-;; Return a header specified by a NUMBER.
-(defun gnus-get-header-by-number (number)
- (save-excursion
- (set-buffer gnus-summary-buffer)
- (or gnus-newsgroup-headers-hashtb-by-number
- (gnus-make-headers-hashtable-by-number))
- (gnus-gethash (int-to-string number)
- gnus-newsgroup-headers-hashtb-by-number)))
-
(defun gnus-make-headers-hashtable-by-number ()
"Make hashtable for the variable gnus-newsgroup-headers by number."
(save-excursion
(gnus-make-hashtable (length headers)))
(while headers
(setq header (car headers))
- (gnus-sethash (int-to-string (header-number header))
+ (gnus-sethash (int-to-string (mail-header-number header))
header gnus-newsgroup-headers-hashtb-by-number)
(setq headers (cdr headers))))))
"Extend newsgroup selection with HEADER.
Optional argument BACKWARD means extend toward backward."
(if header
- (let ((artnum (header-number header)))
+ (let ((artnum (mail-header-number header)))
(setq gnus-newsgroup-headers
(if backward
(cons header gnus-newsgroup-headers)
If optional argument BACKWARD is non-nil, search backward instead."
(save-excursion
(set-buffer gnus-group-buffer)
- (save-excursion
- ;; We don't want to alter current point of group mode buffer.
- (if (gnus-group-search-forward
- backward nil
- (if use-level (gnus-group-group-level) nil))
- (gnus-group-group-name)))))
+ (if (gnus-group-search-forward
+ backward nil (if use-level (gnus-group-group-level) nil))
+ (gnus-group-group-name))))
(defun gnus-summary-best-group (&optional exclude-group)
"Find the name of the best unread group.
(save-excursion
(gnus-group-best-unread-group exclude-group))))
+(defun gnus-subject-equal (s1 s2)
+ (cond
+ ((null gnus-summary-gather-subject-limit)
+ (equal (gnus-simplify-subject-re s1)
+ (gnus-simplify-subject-re s2)))
+ ((eq gnus-summary-gather-subject-limit 'fuzzy)
+ (equal (gnus-simplify-subject-fuzzy s1)
+ (gnus-simplify-subject-fuzzy s2)))
+ ((numberp gnus-summary-gather-subject-limit)
+ (equal (gnus-limit-string s1 gnus-summary-gather-subject-limit)
+ (gnus-limit-string s2 gnus-summary-gather-subject-limit)))
+ (t
+ (equal s1 s2))))
+
(defun gnus-summary-search-subject (&optional backward unread subject)
"Search for article forward.
If BACKWARD is non-nil, search backward.
'next-single-property-change))
(beg (point))
(did t)
- pos)
+ pos psubject)
(beginning-of-line)
(and gnus-summary-check-current unread
(eq (get-text-property (point) 'gnus-mark) gnus-unread-mark)
(eq (get-text-property (point) 'gnus-mark)
gnus-unread-mark))
(or (not subject)
- (equal (gnus-simplify-subject-re subject)
- (gnus-simplify-subject-re
- (gnus-summary-subject-string)))))))
+ (and (setq psubject
+ (inline (gnus-summary-subject-string)))
+ (inline
+ (gnus-subject-equal subject psubject)))))))
(if backward (if (bobp) nil (forward-char -1) t)
(if (eobp) nil (forward-char 1) t)))))
(if did
(get-text-property (point) 'gnus-number)
(gnus-summary-position-cursor)))))
-(defun gnus-summary-search-forward (&optional unread subject backward)
- "Search for article forward.
-If UNREAD is non-nil, only unread articles are selected.
-If SUBJECT is non-nil, the article which has the same subject will be
-searched for.
-If BACKWARD is non-nil, the search will be performed backwards instead."
- (gnus-summary-search-subject backward unread subject))
-
-(defun gnus-summary-search-backward (&optional unread subject)
- "Search for article backward.
-If 1st optional argument UNREAD is non-nil, only unread article is selected.
-If 2nd optional argument SUBJECT is non-nil, the article which has
-the same subject will be searched for."
- (gnus-summary-search-forward unread subject t))
-
-(defun gnus-summary-article-number (&optional number-or-nil)
- "The article number of the article on the current line.
-If there isn's an article number here, then we return the current
-article number."
- (let* ((number (get-text-property (gnus-point-at-bol) 'gnus-number)))
- (if number-or-nil number (or number gnus-current-article))))
-
-(defun gnus-summary-thread-level ()
- "The thread level of the article on the current line."
- (or (get-text-property (gnus-point-at-bol) 'gnus-level)
- 0))
-
(defun gnus-summary-pseudo-article ()
"The thread level of the article on the current line."
(get-text-property (gnus-point-at-bol) 'gnus-pseudo))
-(defun gnus-summary-article-mark ()
- "The mark on the current line."
- (get-text-property (gnus-point-at-bol) 'gnus-mark))
-
-(defun gnus-summary-subject-string ()
- "Return current subject string or nil if nothing."
- (let ((article (gnus-summary-article-number))
- header)
- (and article
- (setq header (gnus-get-header-by-number article))
- (vectorp header)
- (header-subject header))))
-
(defalias 'gnus-summary-score 'gnus-summary-article-score)
(make-obsolete 'gnus-summary-score 'gnus-summary-article-score)
(defun gnus-summary-article-score ()
(or (cdr (assq (gnus-summary-article-number) gnus-newsgroup-scored))
gnus-summary-default-score 0))
-;; Written by Sudish Joseph <joseph@cis.ohio-state.edu>.
-
(defun gnus-summary-recenter ()
"Center point in the summary window.
If `gnus-auto-center-summary' is nil, or the article buffer isn't
;; Suggested by earle@mahendo.JPL.NASA.GOV (Greg Earle).
;; Recenter only when requested. Suggested by popovich@park.cs.columbia.edu.
(let* ((top (cond ((< (window-height) 4) 0)
- ((< (window-height) 6) 1)
+ ((< (window-height) 7) 1)
(t 2)))
(height (1- (window-height)))
(bottom (save-excursion (goto-char (point-max))
;; Function written by Stainless Steel Rat <ratinox@ccs.neu.edu>.
(defun gnus-short-group-name (group &optional levels)
"Collapse GROUP name LEVELS."
- (let ((name "") (foreign "")
- (levels (or levels 2)))
+ (let* ((name "") (foreign "") (depth -1) (skip 1)
+ (levels (or levels
+ (progn
+ (while (string-match "\\." group skip)
+ (setq skip (match-end 0)
+ depth (+ depth 1)))
+ depth))))
(if (string-match ":" group)
(setq foreign (substring group 0 (match-end 0))
group (substring group (match-end 0))))
(let* ((read (nth 2 (nth 2 (gnus-gethash group gnus-newsrc-hashtb))))
(active (gnus-gethash group gnus-active-hashtb))
(last (cdr active))
- unread first nlast unread)
+ first nlast unread)
;; If none are read, then all are unread.
(if (not read)
(setq first (car active))
(interactive)
(gnus-set-global-variables)
(let ((articles (reverse gnus-newsgroup-processable))
- key func)
+ func)
(or articles (error "No articles marked"))
(or (setq func (key-binding (read-key-sequence "C-c C-u")))
(error "Undefined key"))
(gnus-summary-remove-process-mark (car articles))
(setq articles (cdr articles)))))
-(defun gnus-summary-toggle-truncation (arg)
+(defun gnus-summary-toggle-truncation (&optional arg)
"Toggle truncation of summary lines.
With arg, turn line truncation on iff arg is positive."
(interactive "P")
(> (prefix-numeric-value arg) 0)))
(redraw-display))
-(defun gnus-summary-reselect-current-group (all)
+(defun gnus-summary-reselect-current-group (&optional all)
"Once exit and then reselect the current newsgroup.
The prefix argument ALL means to select all articles."
(interactive "P")
(gnus-set-global-variables)
(let ((current-subject (gnus-summary-article-number))
(group gnus-newsgroup-name))
- (setq gnus-newsgroup-threads nil)
+ (setq gnus-newsgroup-begin nil)
(gnus-summary-exit t)
;; We have to adjust the point of group mode buffer because the
;; current point was moved to the next unread newsgroup by
(gnus-group-read-group all t)
(gnus-summary-goto-subject current-subject)))
-(defun gnus-summary-rescan-group (all)
+(defun gnus-summary-rescan-group (&optional all)
"Exit the newsgroup, ask for new articles, and select the newsgroup."
(interactive "P")
(gnus-set-global-variables)
(gnus-group-read-group all)))
(defun gnus-summary-update-info ()
- (let* ((group gnus-newsgroup-name)
- (method (car (gnus-find-method-for-group group))))
+ (let* ((group gnus-newsgroup-name))
(if gnus-newsgroup-kill-headers
(setq gnus-newsgroup-killed
(gnus-compress-sequence
(sort gnus-newsgroup-unreads '<))) t)))
(or (listp (cdr gnus-newsgroup-killed))
(setq gnus-newsgroup-killed (list gnus-newsgroup-killed)))
- (let ((updated nil)
- (headers gnus-newsgroup-headers))
+ (let ((headers gnus-newsgroup-headers))
(gnus-close-group group)
(run-hooks 'gnus-exit-group-hook)
(gnus-update-read-articles
;; Do adaptive scoring, and possibly save score files.
(and gnus-newsgroup-adaptive
(gnus-score-adaptive))
- (and (fboundp 'gnus-score-save)
+ (and gnus-use-scoring
+ (fboundp 'gnus-score-save)
(funcall 'gnus-score-save))
;; Do not switch windows but change the buffer to work.
(set-buffer gnus-group-buffer)
(quit-config (nth 1 (assoc 'quit-config (gnus-find-method-for-group
gnus-newsgroup-name))))
(mode major-mode)
- (method (car (gnus-find-method-for-group group)))
(buf (current-buffer)))
- (gnus-summary-update-info) ; Make all changes in this group permanent.
+ (run-hooks 'gnus-summary-prepare-exit-hook)
+ ;; Make all changes in this group permanent.
+ (gnus-summary-update-info)
+ (set-buffer buf)
+ (and gnus-use-cache (gnus-cache-possibly-remove-articles))
;; Make sure where I was, and go to next newsgroup.
+ (set-buffer gnus-group-buffer)
(or quit-config
(progn
(gnus-group-jump-to-group group)
(gnus-summary-clear-local-variables)
;; We clear the global counterparts of the buffer-local
;; variables as well, just to be on the safe side.
- (gnus-configure-windows 'group)
+ (gnus-configure-windows 'group 'force)
(gnus-summary-clear-local-variables)
;; Return to group mode buffer.
(if (eq mode 'gnus-summary-mode)
(gnus-group-jump-to-group group)
(gnus-group-next-unread-group 1))
(if (not (buffer-name (car quit-config)))
- (gnus-configure-windows 'group)
+ (gnus-configure-windows 'group 'force)
(set-buffer (car quit-config))
(and (eq major-mode 'gnus-summary-mode)
(gnus-set-global-variables))
- (gnus-configure-windows (cdr quit-config)))))))
+ (gnus-configure-windows (cdr quit-config))))
+ (run-hooks 'gnus-summary-exit-hook))))
(defalias 'gnus-summary-quit 'gnus-summary-exit-no-update)
(defun gnus-summary-exit-no-update (&optional no-questions)
"Quit reading current newsgroup without updating read article info."
(interactive)
+ (gnus-set-global-variables)
(let* ((group gnus-newsgroup-name)
(quit-config (nth 1 (assoc 'quit-config
(gnus-find-method-for-group group)))))
(set-buffer gnus-group-buffer)
(gnus-summary-clear-local-variables)
;; Return to group selection mode.
- (gnus-configure-windows 'group)
+ (gnus-configure-windows 'group 'force)
(if (get-buffer gnus-summary-buffer)
(kill-buffer gnus-summary-buffer))
(if (get-buffer gnus-article-buffer)
(if quit-config
(progn
(if (not (buffer-name (car quit-config)))
- (gnus-configure-windows 'group)
+ (gnus-configure-windows 'group 'force)
(set-buffer (car quit-config))
(and (eq major-mode 'gnus-summary-mode)
(gnus-set-global-variables))
(defun gnus-summary-fetch-faq (group)
"Fetch the FAQ for the current group."
(interactive (list gnus-newsgroup-name))
- (gnus-configure-windows 'summary-faq)
- (find-file (concat gnus-group-faq-directory group)))
+ (let (gnus-faq-buffer)
+ (and (setq gnus-faq-buffer (gnus-group-fetch-faq group))
+ (gnus-configure-windows 'summary-faq))))
;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
-(defun gnus-summary-describe-group (force)
+(defun gnus-summary-describe-group (&optional force)
"Describe the current newsgroup."
(interactive "P")
(gnus-group-describe-group force gnus-newsgroup-name))
"Describe summary mode commands briefly."
(interactive)
(gnus-message 6
- (substitute-command-keys "\\<gnus-summary-mode-map>\\[gnus-summary-next-page]:Select \\[gnus-summary-next-unread-article]:Forward \\[gnus-summary-prev-unread-article]:Backward \\[gnus-summary-exit]:Exit \\[gnus-info-find-node]:Run Info \\[gnus-summary-describe-briefly]:This help")))
+ (substitute-command-keys "\\<gnus-summary-mode-map>\\[gnus-summary-next-page]:Select \\[gnus-summary-next-unread-article]:Forward \\[gnus-summary-prev-unread-article]:Backward \\[gnus-summary-exit]:Exit \\[gnus-info-find-node]:Run Info \\[gnus-summary-describe-briefly]:This help")))
;; Walking around group mode buffer from summary mode.
-(defun gnus-summary-next-group (&optional no-article group backward)
+(defun gnus-summary-next-group (&optional no-article target-group backward)
+ "Exit current newsgroup and then select next unread newsgroup.
+If prefix argument NO-ARTICLE is non-nil, no article is selected
+initially. If NEXT-GROUP, go to this group. If BACKWARD, go to
+previous group instead."
+ (interactive "P")
+ (gnus-set-global-variables)
+ (let ((current-group gnus-newsgroup-name)
+ (current-buffer (current-buffer))
+ entered)
+ ;; First we semi-exit this group to update Xrefs and all variables.
+ ;; We can't do a real exit, because the window conf must remain
+ ;; the same in case the user is prompted for info, and we don't
+ ;; want the window conf to change before that...
+ (gnus-summary-exit t)
+ (while (not entered)
+ ;; Then we find what group we are supposed to enter.
+ (set-buffer gnus-group-buffer)
+ (gnus-group-jump-to-group current-group)
+ (setq target-group
+ (or target-group
+ (if (eq gnus-keep-same-level 'best)
+ (gnus-summary-best-group gnus-newsgroup-name)
+ (gnus-summary-search-group backward gnus-keep-same-level))))
+ (if (not target-group)
+ ;; There are no further groups, so we return to the group
+ ;; buffer.
+ (progn
+ (gnus-message 5 "Returning to the group buffer")
+ (setq entered t)
+ (set-buffer current-buffer)
+ (gnus-summary-exit))
+ ;; We try to enter the target group.
+ (gnus-group-jump-to-group target-group)
+ (let ((unreads (gnus-group-group-unread)))
+ (if (and (or (eq t unreads)
+ (and unreads (not (zerop unreads))))
+ (gnus-summary-read-group
+ target-group nil no-article current-buffer))
+ (setq entered t)
+ (setq current-group target-group
+ target-group nil)))))))
+
+(defun gnus-summary-next-group-old (&optional no-article group backward)
"Exit current newsgroup and then select next unread newsgroup.
If prefix argument NO-ARTICLE is non-nil, no article is selected initially.
If BACKWARD, go to previous group instead."
(let ((ingroup gnus-newsgroup-name)
(sumbuf (current-buffer))
num)
- (gnus-summary-exit t) ;Update all information.
+ (set-buffer gnus-group-buffer)
(if (and group
(or (and (numberp (setq num (car (gnus-gethash
group gnus-newsrc-hashtb))))
(setq group nil))
(gnus-group-jump-to-group ingroup))
(gnus-summary-search-group backward)
- (let ((group (or group (gnus-summary-search-group backward)))
- (buf gnus-summary-buffer))
+ (let ((group (or group (gnus-summary-search-group backward))))
+ (set-buffer sumbuf)
+ (gnus-summary-exit t) ;Update all information.
(if (null group)
(gnus-summary-exit-no-update t)
+ (gnus-group-jump-to-group ingroup)
+ (setq group (gnus-summary-search-group backward))
(gnus-message 5 "Selecting %s..." group)
+ (set-buffer gnus-group-buffer)
;; We are now in group mode buffer.
;; Make sure group mode buffer point is on GROUP.
(gnus-group-jump-to-group group)
(if (not (eq gnus-auto-select-next 'quietly))
(progn
- (gnus-summary-read-group group nil no-article buf)
+ (gnus-summary-read-group group nil no-article sumbuf)
(and (string= gnus-newsgroup-name ingroup)
(bufferp sumbuf) (buffer-name sumbuf)
(progn
(set-buffer (setq gnus-summary-buffer sumbuf))
(gnus-summary-exit-no-update t))))
(let ((prevgroup group))
- (gnus-summary-read-group group nil no-article buf)
+ (gnus-group-jump-to-group ingroup)
+ (setq group (gnus-summary-search-group backward))
+ (gnus-summary-read-group group nil no-article sumbuf)
(while (and (string= gnus-newsgroup-name ingroup)
(bufferp sumbuf)
(buffer-name sumbuf)
(set-buffer gnus-group-buffer)
(gnus-summary-read-group
(setq prevgroup (gnus-group-group-name))
- nil no-article buf))
+ nil no-article sumbuf))
(and (string= prevgroup (gnus-group-group-name))
;; We have reached the final group in the group
;; buffer.
(progn
- (set-buffer sumbuf)
- (gnus-summary-exit)))))))))
+ (if (buffer-name sumbuf)
+ (progn
+ (set-buffer sumbuf)
+ (gnus-summary-exit)))))))))))
-(defun gnus-summary-prev-group (no-article)
+(defun gnus-summary-prev-group (&optional no-article)
"Exit current newsgroup and then select previous unread newsgroup.
If prefix argument NO-ARTICLE is non-nil, no article is selected initially."
(interactive "P")
;; Walking around summary lines.
-(defun gnus-summary-first-subject (unread)
+(defun gnus-summary-first-subject (&optional unread)
"Go to the first unread subject.
If UNREAD is non-nil, go to the first unread article.
Returns nil if there are no unread articles."
(interactive "P")
(prog1
- (if (or (not unread)
- (gnus-goto-char
- (text-property-any
- (point-min) (point-max) 'gnus-mark gnus-unread-mark)))
- t
- ;; If there are no unread articles.
- (gnus-message 3 "No more unread articles")
- nil)
+ (cond ((not unread)
+ (goto-char (point-min)))
+ ((gnus-goto-char
+ (text-property-any
+ (point-min) (point-max) 'gnus-mark gnus-unread-mark))
+ t)
+ (t
+ ;; There are no unread articles.
+ (gnus-message 3 "No more unread articles")
+ nil))
(gnus-summary-position-cursor)))
(defun gnus-summary-next-subject (n &optional unread dont-display)
(progn
(gnus-summary-recenter)
(gnus-summary-position-cursor)))
- n))
+ n))
(defun gnus-summary-next-unread-subject (n)
"Go to next N'th unread summary line."
(mapcar
(lambda (headers)
(list
- (int-to-string (header-number headers))))
+ (int-to-string (mail-header-number headers))))
gnus-newsgroup-headers)
nil 'require-match))))
(or article (error "No article number"))
(let ((b (point)))
- (gnus-goto-char (text-property-any (point-min) (point-max)
- 'gnus-number article))
- (gnus-summary-show-thread)
- ;; Skip dummy articles.
- (if (eq (gnus-summary-article-mark) gnus-dummy-mark)
- (forward-line 1))
- (prog1
- (if (not (eobp))
- article
- (goto-char b)
- nil)
- (gnus-summary-position-cursor))))
+ (if (not (gnus-goto-char (text-property-any (point-min) (point-max)
+ 'gnus-number article)))
+ ()
+ (gnus-summary-show-thread)
+ ;; Skip dummy articles.
+ (if (eq (gnus-summary-article-mark) gnus-dummy-mark)
+ (forward-line 1))
+ (prog1
+ (if (not (eobp))
+ article
+ (goto-char b)
+ nil)
+ (gnus-summary-position-cursor)))))
;; Walking around summary lines with displaying articles.
-(defun gnus-summary-expand-window ()
- "Expand summary window to show headers full window."
- (interactive)
+(defun gnus-summary-expand-window (&optional arg)
+ "Make the summary buffer take up the entire Emacs frame.
+Given a prefix, will force an `article' buffer configuration."
+ (interactive "P")
(gnus-set-global-variables)
- (gnus-configure-windows 'summary))
+ (if arg
+ (gnus-configure-windows 'article 'force)
+ (gnus-configure-windows 'summary 'force)))
(defun gnus-summary-display-article (article &optional all-header)
"Display ARTICLE in article buffer."
(gnus-set-global-variables)
(if (null article)
nil
- (gnus-article-prepare article all-header)
- (gnus-summary-show-thread)
- (if (eq (gnus-summary-article-mark) gnus-dummy-mark)
- (progn
- (forward-line 1)
- (gnus-summary-position-cursor)))
- (run-hooks 'gnus-select-article-hook)
- (gnus-summary-recenter)
-; (set-window-point (get-buffer-window (current-buffer)) (point-max))
-; (sit-for 0)
- (gnus-summary-goto-subject article)
- ;; Successfully display article.
- (gnus-summary-update-line)
- (gnus-article-set-window-start
- (cdr (assq article gnus-newsgroup-bookmarks)))
- t))
+ (prog1
+ (gnus-article-prepare article all-header)
+ (gnus-summary-show-thread)
+ (if (eq (gnus-summary-article-mark) gnus-dummy-mark)
+ (progn
+ (forward-line 1)
+ (gnus-summary-position-cursor)))
+ (run-hooks 'gnus-select-article-hook)
+ (gnus-summary-recenter)
+ (gnus-summary-goto-subject article)
+ ;; Successfully display article.
+ (gnus-summary-update-line)
+ (gnus-article-set-window-start
+ (cdr (assq article gnus-newsgroup-bookmarks)))
+ t)))
(defun gnus-summary-select-article (&optional all-headers force pseudo article)
"Select the current article.
(set-buffer gnus-summary-buffer)
(if (or (null gnus-current-article)
(null gnus-article-current)
+ (null (get-buffer gnus-article-buffer))
(not (eq article (cdr gnus-article-current)))
(not (equal (car gnus-article-current) gnus-newsgroup-name))
force)
(progn
(gnus-summary-display-article article all-headers)
(setq did article))
- (if all-headers (gnus-article-show-all-headers))
+ (if (or all-headers gnus-show-all-headers)
+ (gnus-article-show-all-headers))
nil))
(if did
(gnus-article-set-window-start
"Obsolete function."
nil)
-(defun gnus-summary-next-article (unread &optional subject backward)
+(defun gnus-summary-next-article (&optional unread subject backward)
"Select the next article.
If UNREAD, only unread articles are selected.
If SUBJECT, only articles with SUBJECT are selected.
If BACKWARD, the previous article is selected instead of the next."
(interactive "P")
- (let ((opoint (point))
- (method (car (gnus-find-method-for-group gnus-newsgroup-name)))
- header)
+ (gnus-set-global-variables)
+ (let (header)
(cond
;; Is there such an article?
- ((gnus-summary-display-article
- (gnus-summary-search-forward unread subject backward))
+ ((and (gnus-summary-search-forward unread subject backward)
+ (or (gnus-summary-display-article (gnus-summary-article-number))
+ (eq (gnus-summary-article-mark) gnus-canceled-mark)))
(gnus-summary-position-cursor))
;; If not, we try the first unread, if that is wanted.
((and subject
gnus-auto-select-same
- (gnus-summary-first-unread-article))
+ (or (gnus-summary-first-unread-article)
+ (eq (gnus-summary-article-mark) gnus-canceled-mark)))
+ (gnus-summary-position-cursor)
(gnus-message 6 "Wrapped"))
;; Try to get next/previous article not displayed in this group.
((and gnus-auto-extend-newsgroup
(gnus-extend-newsgroup header backward)
(let ((buffer-read-only nil))
(goto-char (if backward (point-min) (point-max)))
- (gnus-summary-prepare-threads (list header) 0))
+ (gnus-summary-prepare-threads (list header)))
(gnus-summary-goto-article (if backward gnus-newsgroup-begin
gnus-newsgroup-end)))
;; Go to next/previous group.
(t
(or (assoc 'quit-config (gnus-find-method-for-group gnus-newsgroup-name))
(gnus-summary-jump-to-group gnus-newsgroup-name))
- (let ((cmd (aref (this-command-keys) 0))
+ (let ((cmd last-command-char)
(group
(if (eq gnus-keep-same-level 'best)
(gnus-summary-best-group gnus-newsgroup-name)
(gnus-summary-search-group backward gnus-keep-same-level))))
+ ;; For some reason, the group window gets selected. We change
+ ;; it back.
+ (select-window (get-buffer-window (current-buffer)))
;; Keep just the event type of CMD.
- (and (listp cmd) (setq cmd (car cmd)))
+ ;(and (listp cmd) (setq cmd (car cmd)))
;; Select next unread newsgroup automagically.
(cond
((not gnus-auto-select-next)
(single-key-description cmd)
gnus-newsgroup-name)))
;; Confirm auto selection.
- (let* ((event (read-event)))
+ (let* ((event (read-char)))
(setq key (if (listp event) (car event) event))
- (if (member key keystrokes)
+ (if (memq key keystrokes)
(let ((obuf (current-buffer)))
(switch-to-buffer gnus-group-buffer)
- (gnus-group-jump-to-group group)
- (execute-kbd-macro (char-to-string key))
+ (and group
+ (gnus-group-jump-to-group group))
+ (condition-case ()
+ (execute-kbd-macro (char-to-string key))
+ (error (ding) nil))
(setq group (gnus-group-group-name))
(switch-to-buffer obuf)))))
- (if (eq key cmd)
+ (if (equal key cmd)
(if (or (not group) (assoc 'quit-config
(gnus-find-method-for-group
gnus-newsgroup-name)))
(gnus-summary-exit)
(gnus-summary-next-group nil group backward))
- (setq unread-command-events (list key)))))))))))
+ (execute-kbd-macro (char-to-string key)))))))))))
(defun gnus-summary-next-unread-article ()
"Select unread article after current one."
(gnus-summary-next-article t (and gnus-auto-select-same
(gnus-summary-subject-string))))
-(defun gnus-summary-prev-article (unread &optional subject)
+(defun gnus-summary-prev-article (&optional unread subject)
"Select the article after the current one.
If UNREAD is non-nil, only unread articles are selected."
(interactive "P")
(gnus-summary-prev-article t (and gnus-auto-select-same
(gnus-summary-subject-string))))
-(defun gnus-summary-next-page (lines &optional circular)
+(defun gnus-summary-next-page (&optional lines circular)
"Show next page of selected article.
If end of article, select next article.
Argument LINES specifies lines to be scrolled up.
(gnus-set-global-variables)
(let ((article (gnus-summary-article-number))
(endp nil))
+ (gnus-configure-windows 'article)
(if (or (null gnus-current-article)
(null gnus-article-current)
(/= article (cdr gnus-article-current))
(gnus-eval-in-buffer-window
gnus-article-buffer
(setq endp (gnus-article-next-page lines)))
- (gnus-summary-recenter)
(if endp
(cond (circular
(gnus-summary-beginning-of-article))
(lines
(gnus-message 3 "End of message"))
((null lines)
- (gnus-summary-next-unread-article)))))))
+ (gnus-summary-next-unread-article)))))
+ (gnus-summary-recenter)
+ (gnus-summary-position-cursor)))
-(defun gnus-summary-prev-page (lines)
+(defun gnus-summary-prev-page (&optional lines)
"Show previous page of selected article.
Argument LINES specifies lines to be scrolled down."
(interactive "P")
(gnus-set-global-variables)
(let ((article (gnus-summary-article-number)))
+ (gnus-configure-windows 'article)
(if (or (null gnus-current-article)
(null gnus-article-current)
(/= article (cdr gnus-article-current))
(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-cursor))
(defun gnus-summary-scroll-up (lines)
Argument LINES specifies lines to be scrolled up (or down if negative)."
(interactive "p")
(gnus-set-global-variables)
+ (gnus-configure-windows 'article)
(or (gnus-summary-select-article nil nil 'pseudo)
(gnus-eval-in-buffer-window
gnus-article-buffer
(gnus-set-global-variables)
(prog1
(if (gnus-summary-first-subject t)
- (gnus-summary-display-article (gnus-summary-article-number)))
+ (progn
+ (gnus-summary-show-thread)
+ (gnus-summary-first-subject t)
+ (gnus-summary-display-article (gnus-summary-article-number))))
(gnus-summary-position-cursor)))
(defun gnus-summary-best-unread-article ()
(setq article art)
(setq best (cdr (car scored))))))
(setq scored (cdr scored)))
- (if article
- (gnus-summary-goto-article article)
+ (cond
+ ((or (not article) (null gnus-newsgroup-unreads))
+ ;; We didn't find any scored articles, so we just jump to the
+ ;; first article.
(gnus-summary-first-unread-article))
+ ((> best gnus-summary-default-score)
+ ;; We found one, and it's bigger than the default score, so we
+ ;; select it.
+ (gnus-summary-goto-article article))
+ (t
+ ;; We found an article, but it has a score lower than the
+ ;; defaults, so we try to find an article with the default
+ ;; score.
+ (goto-char (point-min))
+ (while (and (or (not (= (gnus-summary-article-mark) gnus-unread-mark))
+ (and (assq (gnus-summary-article-number)
+ gnus-newsgroup-scored)
+ (< (cdr (assq (gnus-summary-article-number)
+ gnus-newsgroup-scored))
+ gnus-summary-default-score)))
+ (zerop (forward-line 1))
+ (not (eobp))))
+ (if (= (gnus-summary-article-mark) gnus-unread-mark)
+ ;; We jump to the article we have finally found.
+ (gnus-summary-goto-article (gnus-summary-article-number))
+ ;; Or there were no default-scored articles.
+ (gnus-summary-goto-article article))))
(gnus-summary-position-cursor)))
(defun gnus-summary-goto-article (article &optional all-headers)
(string-to-int
(completing-read
"Article number: "
- (mapcar (lambda (headers) (list (int-to-string (header-number headers))))
+ (mapcar (lambda (headers)
+ (list (int-to-string (mail-header-number headers))))
gnus-newsgroup-headers)
nil 'require-match))))
(prog1
(gnus-summary-position-cursor)))
(defun gnus-summary-goto-last-article ()
- "Go to the last article."
+ "Go to the previously read article."
(interactive)
(prog1
(and gnus-last-article
(while
(and
(> n 0)
- (let ((ref (header-references (gnus-get-header-by-number
- (gnus-summary-article-number)))))
+ (let ((ref (mail-header-references (gnus-get-header-by-num
+ (gnus-summary-article-number)))))
(if (and ref (not (equal ref ""))
(string-match "<[^<>]*>[ \t]*$" ref))
(gnus-summary-refer-article
- (substring ref (match-beginning 0) (match-end 0))))))
+ (substring ref (match-beginning 0) (match-end 0)))
+ (gnus-message 1 "No references in article %d"
+ (gnus-summary-article-number))
+ nil)))
(setq n (1- n)))
- (or (zerop n)
- (gnus-message 1 "No references in article or expired article."))
(gnus-summary-position-cursor)
n)
(defun gnus-summary-refer-article (message-id)
"Refer article specified by MESSAGE-ID.
-NOTE: This command only works with newsgroup that use NNTP."
+NOTE: This command only works with newsgroups that use real or simulated NNTP."
(interactive "sMessage-ID: ")
(if (or (not (stringp message-id))
(zerop (length message-id)))
(let ((header (car (gnus-gethash (downcase message-id)
gnus-newsgroup-dependencies))))
(if header
- (or (gnus-summary-goto-article (header-number header))
+ (or (gnus-summary-goto-article (mail-header-number header))
;; The header has been read, but the article had been
;; expunged, so we insert it again.
(progn
(gnus-summary-insert-line
nil header 0 nil gnus-read-mark nil nil
- (header-subject header))
+ (mail-header-subject header))
(forward-line -1)
- (header-number header)))
+ (mail-header-number header)))
(let ((gnus-override-method gnus-refer-article-method)
(gnus-ancient-mark gnus-read-mark)
- number)
+ (tmp-point (window-start
+ (get-buffer-window gnus-article-buffer)))
+ number tmp-buf)
(and gnus-refer-article-method
- (or (gnus-server-opened gnus-refer-article-method)
- (gnus-open-server gnus-refer-article-method)))
- (if (gnus-article-prepare
- message-id nil (gnus-read-header message-id))
- (progn
- (setq number (header-number gnus-current-headers))
- (gnus-rebuild-thread message-id)
- (gnus-summary-goto-subject number)
- (gnus-article-set-window-start
- (cdr (assq number gnus-newsgroup-bookmarks)))
- message-id)
- (gnus-message 1 "No such references")
- nil))))))
+ (gnus-check-server gnus-refer-article-method))
+ ;; Save the old article buffer.
+ (save-excursion
+ (set-buffer (gnus-article-setup-buffer))
+ (gnus-kill-buffer " *temp Article*")
+ (setq tmp-buf (rename-buffer " *temp Article*")))
+ (prog1
+ (if (gnus-article-prepare
+ message-id nil (gnus-read-header message-id))
+ (progn
+ (setq number (mail-header-number gnus-current-headers))
+ (gnus-rebuild-thread message-id)
+ (gnus-summary-goto-subject number)
+ (if (null gnus-use-full-window)
+ (progn
+ (delete-windows-on tmp-buf)
+ (gnus-configure-windows 'article 'force)))
+ (gnus-summary-recenter)
+ (gnus-article-set-window-start
+ (cdr (assq number gnus-newsgroup-bookmarks)))
+ message-id)
+ ;; We restore the old article buffer.
+ (save-excursion
+ (kill-buffer gnus-article-buffer)
+ (set-buffer tmp-buf)
+ (rename-buffer gnus-article-buffer)
+ (let ((buffer-read-only nil))
+ (and tmp-point
+ (set-window-start (get-buffer-window (current-buffer))
+ tmp-point)))))))))))
(defun gnus-summary-enter-digest-group ()
"Enter a digest group based on the current article."
(gnus-summary-stop-page-breaking)
(let ((name (format "%s-%d"
(gnus-group-prefixed-name
- gnus-newsgroup-name (list 'nndigest ""))
+ gnus-newsgroup-name (list 'nndoc ""))
gnus-current-article))
+ (ogroup gnus-newsgroup-name)
(buf (current-buffer)))
(if (gnus-group-read-ephemeral-group
- name (list 'nndigest gnus-article-buffer))
- ()
+ name (list 'nndoc name
+ (list 'nndoc-address (get-buffer gnus-article-buffer))
+ '(nndoc-article-type digest))
+ t)
+ (setcdr (nthcdr 4 (nth 2 (gnus-gethash name gnus-newsrc-hashtb)))
+ (list (list (cons 'to-group ogroup))))
(switch-to-buffer buf)
(gnus-set-global-variables)
(gnus-configure-windows 'summary)
(interactive)
(gnus-set-global-variables)
(gnus-summary-select-article)
- (gnus-eval-in-buffer-window gnus-article-buffer
- (isearch-forward)))
+ (gnus-eval-in-buffer-window
+ gnus-article-buffer (isearch-forward)))
-(defun gnus-summary-search-article-forward (regexp)
+(defun gnus-summary-search-article-forward (regexp &optional backward)
"Search for an article containing REGEXP forward.
-gnus-select-article-hook is not called during the search."
+If BACKWARD, search backward instead."
(interactive
(list (read-string
- (concat "Search forward (regexp): "
+ (format "Search article %s (regexp%s): "
+ (if current-prefix-arg "backward" "forward")
(if gnus-last-search-regexp
- (concat "(default " gnus-last-search-regexp ") "))))))
+ (concat ", default " gnus-last-search-regexp)
+ "")))
+ current-prefix-arg))
(gnus-set-global-variables)
(if (string-equal regexp "")
(setq regexp (or gnus-last-search-regexp ""))
(setq gnus-last-search-regexp regexp))
- (if (gnus-summary-search-article regexp nil)
- (gnus-eval-in-buffer-window
- gnus-article-buffer
- (recenter 0))
+ (if (gnus-summary-search-article regexp backward)
+ (gnus-article-set-window-start
+ (cdr (assq (gnus-summary-article-number) gnus-newsgroup-bookmarks)))
(error "Search failed: \"%s\"" regexp)))
(defun gnus-summary-search-article-backward (regexp)
- "Search for an article containing REGEXP backward.
-gnus-select-article-hook is not called during the search."
+ "Search for an article containing REGEXP backward."
(interactive
(list (read-string
- (concat "Search backward (regexp): "
+ (format "Search article backward (regexp%s): "
(if gnus-last-search-regexp
- (concat "(default " gnus-last-search-regexp ") "))))))
- (gnus-set-global-variables)
- (if (string-equal regexp "")
- (setq regexp (or gnus-last-search-regexp ""))
- (setq gnus-last-search-regexp regexp))
- (if (gnus-summary-search-article regexp t)
- (gnus-eval-in-buffer-window
- gnus-article-buffer
- (recenter 0))
- (error "Search failed: \"%s\"" regexp)))
+ (concat ", default " gnus-last-search-regexp)
+ "")))))
+ (gnus-summary-search-article-forward regexp 'backward))
(defun gnus-summary-search-article (regexp &optional backward)
"Search for an article containing REGEXP.
(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))))
+ (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
(gnus-summary-search-subject backward nil nil)))
(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)))))
+ (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)
(interactive)
(gnus-set-global-variables)
(gnus-summary-select-article)
+ (gnus-configure-windows 'article)
(gnus-eval-in-buffer-window
gnus-article-buffer
(widen)
(interactive)
(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))))
(defun gnus-summary-show-article ()
"Force re-fetching of the current article."
(interactive)
(gnus-set-global-variables)
- (gnus-summary-select-article gnus-have-all-headers t))
+ (gnus-summary-select-article nil 'force)
+ (gnus-configure-windows 'article)
+ (gnus-summary-position-cursor))
-(defun gnus-summary-toggle-header (arg)
+(defun gnus-summary-verbose-headers (&optional arg)
+ "Toggle permanent full header display.
+If ARG is a positive number, turn header display on.
+If ARG is a negative number, turn header display off."
+ (interactive "P")
+ (gnus-set-global-variables)
+ (gnus-summary-toggle-header arg)
+ (setq gnus-show-all-headers
+ (cond ((or (not (numberp arg))
+ (zerop arg))
+ (not gnus-show-all-headers))
+ ((natnump arg)
+ t))))
+
+(defun gnus-summary-toggle-header (&optional arg)
"Show the headers if they are hidden, or hide them if they are shown.
If ARG is a positive number, show the entire header.
If ARG is a negative number, hide the unwanted header lines."
gnus-hidden-properties)
(if (< arg 0) (run-hooks 'gnus-article-display-hook)))
(if (text-property-any (point-min) (point-max) 'invisible t)
- (remove-text-properties (point-min) (point-max)
- gnus-hidden-properties)
- (let ((gnus-have-all-headers nil))
- (run-hooks 'gnus-article-display-hook))))
+ (remove-text-properties
+ (point-min) (point-max) gnus-hidden-properties)
+ ;; We hide the headers. This song and dance act below is
+ ;; done because `gnus-have-all-headers' is buffer-local to
+ ;; the summary buffer, and we only want to temporarily
+ ;; change it in that buffer. Ugh.
+ (let ((have gnus-have-all-headers))
+ (save-excursion
+ (set-buffer gnus-summary-buffer)
+ (setq gnus-have-all-headers nil)
+ (save-excursion
+ (set-buffer gnus-article-buffer)
+ (run-hooks 'gnus-article-display-hook))
+ (setq gnus-have-all-headers have)))))
(set-window-point (get-buffer-window (current-buffer)) (point-min)))))
(defun gnus-summary-show-all-headers ()
(gnus-set-global-variables)
(gnus-article-show-all-headers))
-(defun gnus-summary-toggle-mime (arg)
+(defun gnus-summary-toggle-mime (&optional arg)
"Toggle MIME processing.
If ARG is a positive number, turn MIME processing on."
(interactive "P")
(> (prefix-numeric-value arg) 0)))
(gnus-summary-select-article t 'force))
-(defun gnus-summary-caesar-message (rotnum)
- "Caesar rotates all letters of current message by 13/47 places.
-With prefix arg, specifies the number of places to rotate each letter forward.
-Caesar rotates Japanese letters by 47 places in any case."
+(defun gnus-summary-caesar-message (&optional arg)
+ "Caesar rotate the current article by 13.
+The numerical prefix specifies how manu places to rotate each letter
+forward."
(interactive "P")
(gnus-set-global-variables)
(gnus-summary-select-article)
- (let ((mail-header-separator "")) ; !!! Is this necessary?
- (gnus-overload-functions)
+ (let ((mail-header-separator ""))
(gnus-eval-in-buffer-window
gnus-article-buffer
(save-restriction
(widen)
- ;; We don't want to jump to the beginning of the message.
- ;; `save-excursion' does not do its job.
- (move-to-window-line 0)
- (let ((last (point)))
- (news-caesar-buffer-body rotnum)
- (goto-char last)
- (recenter 0))))))
+ (let ((start (window-start)))
+ (news-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."
;; Suggested by Brian Edmonds <bedmonds@prodigy.bc.ca>.
-(defun gnus-summary-move-article (n &optional to-newsgroup select-method)
+(defun gnus-summary-move-article (&optional n to-newsgroup select-method)
"Move the current article to a different newsgroup.
If N is a positive number, move the N next articles.
If N is a negative number, move the N previous articles.
(error "The current newsgroup does not support article moving"))
(let ((articles (gnus-summary-work-articles n))
(prefix (gnus-group-real-prefix gnus-newsgroup-name))
- art-group)
+ art-group to-method sel-met)
(if (and (not to-newsgroup) (not select-method))
(setq to-newsgroup
(completing-read
(if (or (string= to-newsgroup "") (string= to-newsgroup prefix))
(setq to-newsgroup (or gnus-current-move-group "")))
(or (gnus-gethash to-newsgroup gnus-active-hashtb)
- (gnus-activate-newsgroup to-newsgroup)
+ (gnus-activate-group to-newsgroup)
(error "No such group: %s" to-newsgroup))
(setq gnus-current-move-group to-newsgroup)))
- (or (gnus-check-backend-function 'request-accept-article
- (or select-method to-newsgroup))
- (error "%s does not support article moving" to-newsgroup))
+ (setq to-method (if select-method (list select-method "")
+ (gnus-find-method-for-group to-newsgroup)))
+ (or (gnus-check-backend-function 'request-accept-article (car to-method))
+ (error "%s does not support article copying" (car to-method)))
+ (or (gnus-check-server to-method)
+ (error "Can't open server %s" (car to-method)))
(gnus-message 6 "Moving to %s: %s..."
(or select-method to-newsgroup) articles)
(while articles
(if (setq art-group
(gnus-request-move-article
- (car articles) ; Article to move
- gnus-newsgroup-name ; From newsgrouo
+ (car articles) ; Article to move
+ gnus-newsgroup-name ; From newsgrouo
(nth 1 (gnus-find-method-for-group
- gnus-newsgroup-name)) ; Server
+ gnus-newsgroup-name)) ; Server
(list 'gnus-request-accept-article
(if select-method
(list 'quote select-method)
to-newsgroup)
- (not (cdr articles))) ; Accept form
- (not (cdr articles)))) ; Only save nov last time
+ (not (cdr articles))) ; Accept form
+ (not (cdr articles)))) ; Only save nov last time
(let* ((buffer-read-only nil)
(entry
(or
(gnus-find-method-for-group to-newsgroup)))
gnus-newsrc-hashtb)))
(info (nth 2 entry))
- (article (car articles))
- (marked (nth 3 info)))
+ (article (car articles)))
(gnus-summary-goto-subject article)
(beginning-of-line)
- (delete-region (point)
- (progn (forward-line 1) (point)))
- (if (not (memq article gnus-newsgroup-unreads))
- (setcar (cdr (cdr info))
- (gnus-add-to-range (nth 2 info)
- (list (cdr art-group)))))
- ;; Copy any marks over to the new group.
- (let ((marks '((tick . gnus-newsgroup-marked)
- (dormant . gnus-newsgroup-dormant)
- (expire . gnus-newsgroup-expirable)
- (bookmark . gnus-newsgroup-bookmarks)
- ; (score . gnus-newsgroup-scored)
- (reply . gnus-newsgroup-replied)))
- (to-article (cdr art-group)))
- (while marks
- (if (memq article (symbol-value (cdr (car marks))))
- (gnus-add-marked-articles
- (car info) (car (car marks)) (list to-article) info))
- (setq marks (cdr marks))))
+ (delete-region (point) (progn (forward-line 1) (point)))
+ ;; Update the group that has been moved to.
+ (if (not info)
+ () ; This group does not exist yet.
+ (if (not (memq article gnus-newsgroup-unreads))
+ (setcar (cdr (cdr info))
+ (gnus-add-to-range (nth 2 info)
+ (list (cdr art-group)))))
+ ;; Copy any marks over to the new group.
+ (let ((marks '((tick . gnus-newsgroup-marked)
+ (dormant . gnus-newsgroup-dormant)
+ (expire . gnus-newsgroup-expirable)
+ (bookmark . gnus-newsgroup-bookmarks)
+ (reply . gnus-newsgroup-replied)))
+ (to-article (cdr art-group)))
+ (while marks
+ (if (memq article (symbol-value (cdr (car marks))))
+ (gnus-add-marked-articles
+ (car info) (car (car marks)) (list to-article) info))
+ (setq marks (cdr marks)))))
+ ;; Update marks.
(setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked))
(setq gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads))
(setq gnus-newsgroup-dormant
- (delq article gnus-newsgroup-dormant)))
+ (delq article gnus-newsgroup-dormant))
+ (setq gnus-newsgroup-reads
+ (cons (cons article gnus-canceled-mark)
+ gnus-newsgroup-reads)))
(gnus-message 1 "Couldn't move article %s" (car articles)))
(gnus-summary-remove-process-mark (car articles))
(setq articles (cdr articles)))))
-(defun gnus-summary-respool-article (n &optional respool-method)
+(defun gnus-summary-respool-article (&optional n respool-method)
"Respool the current article.
The article will be squeezed through the mail spooling process again,
which means that it will be put in some mail newsgroup or other
(gnus-summary-copy-article n nil (intern respool-method))))))
;; Suggested by gregj@unidata.com (Gregory J. Grubbs).
-(defun gnus-summary-copy-article (n &optional to-newsgroup select-method)
+(defun gnus-summary-copy-article (&optional n to-newsgroup select-method)
"Move the current article to a different newsgroup.
If N is a positive number, move the N next articles.
If N is a negative number, move the N previous articles.
(let ((articles (gnus-summary-work-articles n))
(copy-buf (get-buffer-create "*copy work*"))
(prefix (gnus-group-real-prefix gnus-newsgroup-name))
- art-group)
+ art-group to-method)
(buffer-disable-undo copy-buf)
(if (and (not to-newsgroup) (not select-method))
(setq to-newsgroup
(if (or (string= to-newsgroup "") (string= to-newsgroup prefix))
(setq to-newsgroup (or gnus-current-move-group "")))
(or (gnus-gethash to-newsgroup gnus-active-hashtb)
- (gnus-activate-newsgroup to-newsgroup)
+ (gnus-activate-group to-newsgroup)
(error "No such group: %s" to-newsgroup))
(setq gnus-current-move-group to-newsgroup)))
- (or (gnus-check-backend-function 'request-accept-article
- (or select-method to-newsgroup))
- (error "%s does not support article copying" to-newsgroup))
- (gnus-message 6 "Copying to %s: %s..."
- (or select-method to-newsgroup) articles)
+ (setq to-method (if select-method (list select-method "")
+ (gnus-find-method-for-group to-newsgroup)))
+ (or (gnus-check-backend-function 'request-accept-article (car to-method))
+ (error "%s does not support article copying" (car to-method)))
+ (or (gnus-check-server to-method)
+ (error "Can't open server %s" (car to-method)))
(while articles
+ (gnus-message 6 "Copying to %s: %s..."
+ (or select-method to-newsgroup) articles)
(if (setq art-group
(save-excursion
(set-buffer copy-buf)
(gnus-find-method-for-group to-newsgroup)))
gnus-newsrc-hashtb)))
(info (nth 2 entry))
- (article (car articles))
- (marked (nth 3 info)))
- (if (not (memq article gnus-newsgroup-unreads))
- (setcar (cdr (cdr info))
- (gnus-add-to-range (nth 2 info)
- (list (cdr art-group)))))
- ;; Copy any marks over to the new group.
- (let ((marks '((tick . gnus-newsgroup-marked)
- (dormant . gnus-newsgroup-dormant)
- (expire . gnus-newsgroup-expirable)
- (bookmark . gnus-newsgroup-bookmarks)
- ; (score . gnus-newsgroup-scored)
- (reply . gnus-newsgroup-replied)))
- (to-article (cdr art-group)))
- (while marks
- (if (memq article (symbol-value (cdr (car marks))))
- (gnus-add-marked-articles
- (car info) (car (car marks)) (list to-article) info))
- (setq marks (cdr marks)))))
+ (article (car articles)))
+ ;; We copy the info over to the new group.
+ (if (not info)
+ () ; This group does not exist (yet).
+ (if (not (memq article gnus-newsgroup-unreads))
+ (setcar (cdr (cdr info))
+ (gnus-add-to-range (nth 2 info)
+ (list (cdr art-group)))))
+ ;; Copy any marks over to the new group.
+ (let ((marks '((tick . gnus-newsgroup-marked)
+ (dormant . gnus-newsgroup-dormant)
+ (expire . gnus-newsgroup-expirable)
+ (bookmark . gnus-newsgroup-bookmarks)
+ (reply . gnus-newsgroup-replied)))
+ (to-article (cdr art-group)))
+ (while marks
+ (if (memq article (symbol-value (cdr (car marks))))
+ (gnus-add-marked-articles
+ (car info) (car (car marks)) (list to-article) info))
+ (setq marks (cdr marks))))))
(gnus-message 1 "Couldn't copy article %s" (car articles)))
(gnus-summary-remove-process-mark (car articles))
(setq articles (cdr articles)))
(kill-buffer copy-buf)))
+(defun gnus-summary-import-article (file)
+ "Import a random file into a mail newsgroup."
+ (interactive "fImport file: ")
+ (let ((group gnus-newsgroup-name)
+ atts)
+ (or (gnus-check-backend-function 'request-accept-article group)
+ (error "%s does not support article importing" group))
+ (or (file-readable-p file)
+ (not (file-regular-p file))
+ (error "Can't read %s" file))
+ (save-excursion
+ (set-buffer (get-buffer-create " *import file*"))
+ (buffer-disable-undo (current-buffer))
+ (erase-buffer)
+ (insert-file-contents file)
+ (goto-char (point-min))
+ (if (nnheader-article-p)
+ ()
+ (setq atts (file-attributes file))
+ (insert "From: " (read-string "From: ") "\n"
+ "Subject: " (read-string "Subject: ") "\n"
+ "Date: " (current-time-string (nth 5 atts)) "\n"
+ "Chars: " (int-to-string (nth 7 atts)) "\n\n"))
+ (gnus-request-accept-article group t)
+ (kill-buffer (current-buffer)))))
+
(defun gnus-summary-expire-articles ()
"Expire all articles that are marked as expirable in the current group."
(interactive)
- (if (and gnus-newsgroup-expirable
- (gnus-check-backend-function
+ (if (not (gnus-check-backend-function
'request-expire-articles gnus-newsgroup-name))
- (let ((expirable gnus-newsgroup-expirable))
+ ()
+ (let* ((info (nth 2 (gnus-gethash gnus-newsgroup-name
+ gnus-newsrc-hashtb)))
+ (total (memq 'total-expire (nth 5 info)))
+ (expirable (if total
+ (gnus-list-of-read-articles gnus-newsgroup-name)
+ (setq gnus-newsgroup-expirable
+ (sort gnus-newsgroup-expirable '<))))
+ es)
+ (if (not expirable)
+ ()
+ (gnus-message 6 "Expiring articles...")
;; The list of articles that weren't expired is returned.
- (setq gnus-newsgroup-expirable
- (gnus-request-expire-articles gnus-newsgroup-expirable
- gnus-newsgroup-name))
+ (setq es (gnus-request-expire-articles expirable gnus-newsgroup-name))
+ (or total (setq gnus-newsgroup-expirable es))
;; We go through the old list of expirable, and mark all
;; really expired articles as non-existant.
- (while expirable
- (or (memq (car expirable) gnus-newsgroup-expirable)
- (gnus-summary-mark-as-read (car expirable) "%"))
- (setq expirable (cdr expirable))))))
+ (or (eq es expirable) ;If nothing was expired, we don't mark.
+ (let ((gnus-use-cache nil))
+ (while expirable
+ (or (memq (car expirable) es)
+ (gnus-summary-mark-article
+ (car expirable) gnus-canceled-mark))
+ (setq expirable (cdr expirable)))))
+ (gnus-message 6 "Expiring articles...done")))))
+
+(defun gnus-summary-expire-articles-now ()
+ "Expunge all expirable articles in the current group.
+This means that *all* articles that are marked as expirable will be
+deleted forever, right now."
+ (interactive)
+ (or gnus-expert-user
+ (gnus-y-or-n-p
+ "Are you really, really, really sure you want to expunge? ")
+ (error "Phew!"))
+ (let ((nnmail-expiry-wait -1)
+ (nnmail-expiry-wait-function nil))
+ (gnus-summary-expire-articles)))
;; Suggested by Jack Vinson <vinson@unagi.cis.upenn.edu>.
-(defun gnus-summary-delete-article (n)
+(defun gnus-summary-delete-article (&optional n)
"Delete the N next (mail) articles.
This command actually deletes articles. This is not a marking
command. The article will disappear forever from you life, never to
;; The backend might not have been able to delete the article
;; after all.
(or (memq (car articles) not-deleted)
- (gnus-summary-mark-as-read (car articles) gnus-canceled-mark))
+ (gnus-summary-mark-article (car articles) gnus-canceled-mark))
(setq articles (cdr articles))))
(gnus-summary-position-cursor)
not-deleted))
'request-replace-article gnus-newsgroup-name)
(error "The current newsgroup does not support article editing."))
(gnus-summary-select-article t)
- (other-window 1)
+ (gnus-configure-windows 'article)
+ (select-window (get-buffer-window gnus-article-buffer))
(gnus-message 6 "C-c C-c to end edits")
(setq buffer-read-only nil)
(text-mode)
(use-local-map (copy-keymap (current-local-map)))
(local-set-key "\C-c\C-c" 'gnus-summary-edit-article-done)
+ (buffer-enable-undo)
+ (widen)
(goto-char (point-min))
(search-forward "\n\n" nil t))
(defun gnus-summary-edit-article-done ()
"Make edits to the current article permanent."
(interactive)
- (if (not (gnus-request-replace-article
- (cdr gnus-article-current) (car gnus-article-current)
- (current-buffer)))
- (error "Couldn't replace article.")
- (gnus-article-mode)
- (use-local-map gnus-article-mode-map)
- (setq buffer-read-only t)
- (pop-to-buffer gnus-summary-buffer)))
+ (let ((buf (buffer-substring-no-properties (point-min) (point-max))))
+ (erase-buffer)
+ (insert buf)
+ (if (not (gnus-request-replace-article
+ (cdr gnus-article-current) (car gnus-article-current)
+ (current-buffer)))
+ (error "Couldn't replace article.")
+ (gnus-article-mode)
+ (use-local-map gnus-article-mode-map)
+ (setq buffer-read-only t)
+ (buffer-disable-undo (current-buffer))
+ (gnus-configure-windows 'summary))
+ (and gnus-visual (run-hooks 'gnus-visual-mark-article-hook))))
+
+(defun gnus-summary-edit-article-postpone ()
+ "Postpone changes to the current article."
+ (interactive)
+ (gnus-article-mode)
+ (use-local-map gnus-article-mode-map)
+ (setq buffer-read-only t)
+ (buffer-disable-undo (current-buffer))
+ (gnus-configure-windows 'summary)
+ (and gnus-visual (run-hooks 'gnus-visual-mark-article-hook)))
(defun gnus-summary-fancy-query ()
"Query where the fancy respool algorithm would put this article."
(interactive "p")
(gnus-summary-set-score (+ (gnus-summary-article-score) n)))
-(defun gnus-summary-lower-score (n)
- "Lower the score of the current article by N."
- (interactive "p")
- (gnus-summary-raise-score (- n)))
-
(defun gnus-summary-set-score (n)
"Set the score of the current article to N."
(interactive "p")
(if level (prefix-numeric-value level)
gnus-score-interactive-default-score))
-(defun gnus-summary-raise-thread (score)
- "Raise articles under current thread with SCORE."
+(defun gnus-summary-raise-thread (&optional score)
+ "Raise the score of the articles in the current thread with SCORE."
(interactive "P")
- (setq score (1- (gnus-score-default score)))
+ (setq score (gnus-score-default score))
(let (e)
(save-excursion
(let ((level (gnus-summary-thread-level)))
(interactive "p")
(gnus-summary-raise-same-subject (- score)))
-(defun gnus-summary-lower-thread (score)
- "Raise articles under current thread with SCORE."
+(defun gnus-summary-lower-thread (&optional score)
+ "Lower score of articles in the current thread with SCORE."
(interactive "P")
(gnus-summary-raise-thread (- (1- (gnus-score-default score)))))
-(defun gnus-summary-kill-same-subject-and-select (unmark)
+(defun gnus-summary-kill-same-subject-and-select (&optional unmark)
"Mark articles which has the same subject as read, and then select the next.
If UNMARK is positive, remove any kind of mark.
If UNMARK is negative, tick articles."
;; select the first unread article.
(gnus-summary-next-article t (and gnus-auto-select-same
(gnus-summary-subject-string)))
- (gnus-message 7 "%d articles are marked as %s"
- count (if unmark "unread" "read"))))
+ (gnus-message 7 "%d article%s marked as %s"
+ count (if (= count 1) " is" "s are")
+ (if unmark "unread" "read"))))
-(defun gnus-summary-kill-same-subject (unmark)
+(defun gnus-summary-kill-same-subject (&optional unmark)
"Mark articles which has the same subject as read.
If UNMARK is positive, remove any kind of mark.
If UNMARK is negative, tick articles."
If optional argument UNMARK is negative, mark articles as unread instead."
(let ((count 1))
(save-excursion
- (cond ((null unmark)
- (gnus-summary-mark-as-read nil gnus-killed-mark))
- ((> unmark 0)
- (gnus-summary-tick-article nil t))
- (t
- (gnus-summary-tick-article)))
- (while (and subject
- (gnus-summary-search-forward nil subject))
- (cond ((null unmark)
- (gnus-summary-mark-as-read nil gnus-killed-mark))
- ((> unmark 0)
- (gnus-summary-tick-article nil t))
- (t
- (gnus-summary-tick-article)))
- (setq count (1+ count))))
- ;; Hide killed thread subtrees. Does not work properly always.
- ;;(and (null unmark)
- ;; gnus-thread-hide-killed
- ;; (gnus-summary-hide-thread))
- ;; Return number of articles marked as read.
- count))
+ (cond
+ ((null unmark) ; Mark as read.
+ (while (and
+ (progn
+ (gnus-summary-mark-article-as-read gnus-killed-mark)
+ (gnus-summary-show-thread) t)
+ (gnus-summary-search-forward nil subject))
+ (setq count (1+ count))))
+ ((> unmark 0) ; Tick.
+ (while (and
+ (progn
+ (gnus-summary-mark-article-as-unread gnus-ticked-mark)
+ (gnus-summary-show-thread) t)
+ (gnus-summary-search-forward nil subject))
+ (setq count (1+ count))))
+ (t ; Mark as unread.
+ (while (and
+ (progn
+ (gnus-summary-mark-article-as-unread gnus-unread-mark)
+ (gnus-summary-show-thread) t)
+ (gnus-summary-search-forward nil subject))
+ (setq count (1+ count)))))
+ (gnus-set-mode-line 'summary)
+ ;; Return the number of marked articles.
+ count)))
(defun gnus-summary-mark-as-processable (n &optional unmark)
"Set the process mark on the next N articles.
(interactive "p")
(let ((backward (< n 0))
(n (abs n)))
- (while (and
- (> n 0)
- (if unmark
- (gnus-summary-remove-process-mark (gnus-summary-article-number))
- (gnus-summary-set-process-mark (gnus-summary-article-number)))
- (zerop (gnus-summary-next-subject (if backward -1 1) nil t)))
- (setq n (1- n)))
- (if (/= 0 n) (gnus-message 7 "No more articles"))
- (gnus-summary-recenter)
- (gnus-summary-position-cursor)
- n))
+ (while (and
+ (> n 0)
+ (if unmark
+ (gnus-summary-remove-process-mark
+ (gnus-summary-article-number))
+ (gnus-summary-set-process-mark (gnus-summary-article-number)))
+ (zerop (gnus-summary-next-subject (if backward -1 1) nil t)))
+ (setq n (1- n)))
+ (if (/= 0 n) (gnus-message 7 "No more articles"))
+ (gnus-summary-recenter)
+ (gnus-summary-position-cursor)
+ n))
(defun gnus-summary-unmark-as-processable (n)
"Remove the process mark from the next N articles.
(interactive "p")
(gnus-set-global-variables)
(let ((backward (< n 0))
+ (gnus-summary-goto-unread
+ (and gnus-summary-goto-unread
+ (not (memq mark (list gnus-unread-mark
+ gnus-ticked-mark gnus-dormant-mark)))))
(n (abs n))
(mark (or mark gnus-del-mark)))
- (while (and (> n 0)
- (gnus-summary-mark-article nil mark no-expire)
- (zerop (gnus-summary-next-subject
- (if backward -1 1) gnus-summary-goto-unread t)))
- (setq n (1- n)))
- (if (/= 0 n) (gnus-message 7 "No more %sarticles" (if mark "" "unread ")))
- (gnus-summary-recenter)
- (gnus-summary-position-cursor)
- (gnus-set-mode-line 'summary)
- n))
+ (while (and (> n 0)
+ (gnus-summary-mark-article nil mark no-expire)
+ (zerop (gnus-summary-next-subject
+ (if backward -1 1) gnus-summary-goto-unread t)))
+ (setq n (1- n)))
+ (if (/= 0 n) (gnus-message 7 "No more %sarticles" (if mark "" "unread ")))
+ (gnus-summary-recenter)
+ (gnus-summary-position-cursor)
+ (gnus-set-mode-line 'summary)
+ n))
+
+(defun gnus-summary-mark-article-as-read (mark)
+ "Mark the current article quickly as read with MARK."
+ (let ((article (gnus-summary-article-number)))
+ (setq gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads))
+ (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked))
+ (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant))
+ (setq gnus-newsgroup-reads
+ (cons (cons article mark) gnus-newsgroup-reads))
+ ;; Possibly remove from cache, if that is used.
+ (and gnus-use-cache (gnus-cache-enter-remove-article article))
+ (and gnus-newsgroup-auto-expire
+ (or (= mark gnus-killed-mark) (= mark gnus-del-mark)
+ (= mark gnus-catchup-mark) (= mark gnus-low-score-mark)
+ (= mark gnus-read-mark))
+ (progn
+ (setq mark gnus-expirable-mark)
+ (setq gnus-newsgroup-expirable
+ (cons article gnus-newsgroup-expirable))))
+ (while (eq (gnus-summary-article-mark) gnus-dummy-mark)
+ (forward-line 1))
+ ;; Fix the mark.
+ (gnus-summary-update-mark mark 'unread)
+ t))
+
+(defun gnus-summary-mark-article-as-unread (mark)
+ "Mark the current article quickly as unread with MARK."
+ (let ((article (gnus-summary-article-number)))
+ (or (memq article gnus-newsgroup-unreads)
+ (setq gnus-newsgroup-unreads (cons article gnus-newsgroup-unreads)))
+ (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 (assq article gnus-newsgroup-reads)
+ gnus-newsgroup-reads))
+ (if (= mark gnus-ticked-mark)
+ (setq gnus-newsgroup-marked (cons article gnus-newsgroup-marked)))
+ (if (= mark gnus-dormant-mark)
+ (setq gnus-newsgroup-dormant (cons article gnus-newsgroup-dormant)))
+
+ ;; See whether the article is to be put in the cache.
+ (and gnus-use-cache
+ (vectorp (gnus-get-header-by-num article))
+ (save-excursion
+ (gnus-cache-possibly-enter-article
+ gnus-newsgroup-name article
+ (gnus-get-header-by-num article)
+ (= mark gnus-ticked-mark)
+ (= mark gnus-dormant-mark) (= mark gnus-unread-mark))))
+
+ (while (eq (gnus-summary-article-mark) gnus-dummy-mark)
+ (forward-line 1))
+ ;; Fix the mark.
+ (gnus-summary-update-mark mark 'unread)
+ t))
(defun gnus-summary-mark-article (&optional article mark no-expire)
- "Mark ARTICLE with MARK.
-MARK can be any character.
-Five MARK strings are reserved: ? (unread),
-?! (ticked), ?? (dormant), ?D (read), ?E (expirable).
-If MARK is nil, then the default character ?D is used.
+ "Mark ARTICLE with MARK. MARK can be any character.
+Four MARK strings are reserved: `? ' (unread), `?!' (ticked), `??'
+(dormant) and `?E' (expirable).
+If MARK is nil, then the default character `?D' is used.
If ARTICLE is nil, then the article on the current line will be
marked."
+ (and (stringp mark)
+ (setq mark (aref mark 0)))
;; If no mark is given, then we check auto-expiring.
(and (not no-expire)
gnus-newsgroup-auto-expire
(or (not mark)
- (and (numberp mark) (or (= mark gnus-killed-mark)
- (= mark gnus-del-mark)
- (= mark gnus-catchup-mark)
- (= mark gnus-low-score-mark)
- (= mark gnus-read-mark))))
+ (and (numberp mark)
+ (or (= mark gnus-killed-mark) (= mark gnus-del-mark)
+ (= mark gnus-catchup-mark) (= mark gnus-low-score-mark)
+ (= mark gnus-read-mark))))
(setq mark gnus-expirable-mark))
- (let* ((mark (or (and (stringp mark) (aref mark 0)) mark gnus-del-mark))
+ (let* ((mark (or mark gnus-del-mark))
(article (or article (gnus-summary-article-number))))
+ (or article (error "No article on current line"))
(if (or (= mark gnus-unread-mark)
(= mark gnus-ticked-mark)
(= mark gnus-dormant-mark))
;; See whether the article is to be put in the cache.
(and gnus-use-cache
+ (not (= mark gnus-canceled-mark))
+ (vectorp (gnus-get-header-by-num article))
(save-excursion
(gnus-cache-possibly-enter-article
gnus-newsgroup-name article
- (gnus-get-header-by-number article)
+ (gnus-get-header-by-num article)
(= mark gnus-ticked-mark)
(= mark gnus-dormant-mark) (= mark gnus-unread-mark))))
(defun gnus-summary-update-mark (mark type)
(beginning-of-line)
(let ((forward (cdr (assq type gnus-summary-mark-positions)))
+ (buffer-read-only nil)
plist)
(if (not forward)
()
(delete-char 1)
(insert mark)
(and plist (add-text-properties (1- (point)) (point) plist))
- (add-text-properties (1- (point)) (point) (list 'gnus-mark mark))
- (gnus-summary-update-line (eq mark gnus-unread-mark)))))
+ (and (eq type 'unread)
+ (progn
+ (add-text-properties (1- (point)) (point) (list 'gnus-mark mark))
+ (gnus-summary-update-line (eq mark gnus-unread-mark)))))))
(defun gnus-mark-article-as-read (article &optional mark)
"Enter ARTICLE in the pertinent lists and remove it from others."
;; Make the article expirable.
- (let ((mark (or (and (stringp mark) (aref mark 0)) mark gnus-del-mark)))
+ (let ((mark (or mark gnus-del-mark)))
(if (= mark gnus-expirable-mark)
(setq gnus-newsgroup-expirable (cons article gnus-newsgroup-expirable))
(setq gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable)))
;; Remove from unread and marked lists.
(setq gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads))
(setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked))
- (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant))))
+ (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant))
+ (setq gnus-newsgroup-reads
+ (cons (cons article mark) gnus-newsgroup-reads))
+ ;; Possibly remove from cache, if that is used.
+ (and gnus-use-cache (gnus-cache-enter-remove-article article))))
(defun gnus-mark-article-as-unread (article &optional mark)
"Enter ARTICLE in the pertinent lists and remove it from others."
- (let ((mark (or (and (stringp mark) (aref mark 0)) mark gnus-ticked-mark)))
+ (let ((mark (or mark gnus-ticked-mark)))
;; Add to unread list.
(or (memq article gnus-newsgroup-unreads)
(setq gnus-newsgroup-unreads (cons article gnus-newsgroup-unreads)))
- ;; If CLEAR-MARK is non-nil, the article must be removed from mark
- ;; lists. Otherwise, it must be added to the list.
(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 (assq article gnus-newsgroup-reads)
+ gnus-newsgroup-reads))
(if (= mark gnus-ticked-mark)
(setq gnus-newsgroup-marked (cons article gnus-newsgroup-marked)))
(if (= mark gnus-dormant-mark)
(or (memq gnus-current-article gnus-newsgroup-marked)
(memq gnus-current-article gnus-newsgroup-dormant)
(memq gnus-current-article gnus-newsgroup-expirable)
- (gnus-summary-mark-as-read gnus-current-article gnus-read-mark)))
+ (gnus-summary-mark-article gnus-current-article gnus-read-mark)))
(defun gnus-summary-mark-region-as-read (point mark all)
"Mark all unread articles between point and mark as read.
(concat (mapconcat
(lambda (char) (char-to-string (symbol-value char)))
'(gnus-del-mark gnus-read-mark gnus-ancient-mark
- gnus-killed-mark gnus-kill-file-mark
- gnus-low-score-mark gnus-expirable-mark)
+ gnus-killed-mark gnus-kill-file-mark
+ gnus-low-score-mark gnus-expirable-mark
+ gnus-canceled-mark gnus-catchup-mark)
""))))
(defalias 'gnus-summary-delete-marked-with
(gnus-summary-subject-string)))
()
(forward-line -1)
- (gnus-delete-line))))))
+ (gnus-delete-line)))))
(or (zerop (buffer-size))
(if (eobp)
(gnus-summary-prev-subject 1)
- (gnus-summary-position-cursor)))
+ (gnus-summary-position-cursor))))
-(defun gnus-summary-expunge-below (score)
+(defun gnus-summary-expunge-below (&optional score)
"Remove articles with score less than SCORE."
(interactive "P")
(gnus-set-global-variables)
(gnus-summary-mark-article nil mark))
(forward-line 1))))
-(defun gnus-summary-kill-below (score)
+(defun gnus-summary-kill-below (&optional score)
"Mark articles with score below SCORE as read."
(interactive "P")
+ (gnus-set-global-variables)
(gnus-summary-mark-below score gnus-killed-mark))
-(defun gnus-summary-clear-above (score)
+(defun gnus-summary-clear-above (&optional score)
"Clear all marks from articles with score above SCORE."
(interactive "P")
+ (gnus-set-global-variables)
(gnus-summary-mark-above score gnus-unread-mark))
-(defun gnus-summary-tick-above (score)
+(defun gnus-summary-tick-above (&optional score)
"Tick all articles with score above SCORE."
(interactive "P")
+ (gnus-set-global-variables)
(gnus-summary-mark-above score gnus-ticked-mark))
(defun gnus-summary-mark-above (score mark)
"Mark articles with score over SCORE with MARK."
(interactive "P\ncMark: ")
+ (gnus-set-global-variables)
(setq score (if score
(prefix-numeric-value score)
(or gnus-summary-default-score 0)))
(defun gnus-summary-show-all-expunged ()
"Display all the hidden articles that were expunged for low scores."
(interactive)
+ (gnus-set-global-variables)
(let ((buffer-read-only nil))
(let ((scored gnus-newsgroup-scored)
headers h)
(while scored
(or (gnus-summary-goto-subject (car (car scored)))
- (and (setq h (gnus-get-header-by-number (car (car scored))))
+ (and (setq h (gnus-get-header-by-num (car (car scored))))
(< (cdr (car scored)) gnus-summary-expunge-below)
(setq headers (cons h headers))))
(setq scored (cdr scored)))
(gnus-summary-update-lines
(point)
(progn
- (gnus-summary-prepare-threads (nreverse headers) 0)
+ (gnus-summary-prepare-unthreaded (nreverse headers))
(point)))))
(goto-char (point-min))
(gnus-summary-position-cursor)))
(defun gnus-summary-show-all-dormant ()
"Display all the hidden articles that are marked as dormant."
(interactive)
+ (gnus-set-global-variables)
(let ((buffer-read-only nil))
- (goto-char (point-min))
(let ((dormant gnus-newsgroup-dormant)
headers h)
(while dormant
(or (gnus-summary-goto-subject (car dormant))
- (and (setq h (gnus-get-header-by-number (car dormant)))
+ (and (setq h (gnus-get-header-by-num (car dormant)))
(setq headers (cons h headers))))
(setq dormant (cdr dormant)))
(or headers (error "No dormant articles hidden."))
+ (goto-char (point-min))
(save-excursion
(gnus-summary-update-lines
(point)
(progn
- (gnus-summary-prepare-threads (nreverse headers) 0)
+ (gnus-summary-prepare-unthreaded (nreverse headers))
(point)))))
(goto-char (point-min))
(gnus-summary-position-cursor)))
(defun gnus-summary-hide-all-dormant ()
"Hide all dormant articles."
(interactive)
+ (gnus-set-global-variables)
(gnus-summary-remove-lines-marked-with (char-to-string gnus-dormant-mark))
(gnus-summary-position-cursor))
-(defun gnus-summary-catchup (all &optional quietly to-here not-mark)
+(defun gnus-summary-catchup (&optional all quietly to-here not-mark)
"Mark all articles not marked as unread in this newsgroup as read.
If prefix argument ALL is non-nil, all articles are marked as read.
If QUIETLY is non-nil, no questions will be asked.
articles before this point will be marked as read.
The number of articles marked as read is returned."
(interactive "P")
+ (gnus-set-global-variables)
(prog1
(if (or quietly
(not gnus-interactive-catchup) ;Without confirmation?
(progn
(and all (setq gnus-newsgroup-marked nil
gnus-newsgroup-dormant nil))
- (setq gnus-newsgroup-unreads gnus-newsgroup-marked))
+ (setq gnus-newsgroup-unreads
+ (append gnus-newsgroup-marked gnus-newsgroup-dormant)))
+ ;; We actually mark all articles as canceled, which we
+ ;; have to do when using auto-expiry or adaptive scoring.
(let ((unreads (length gnus-newsgroup-unreads)))
+ (gnus-summary-show-all-threads)
(if (gnus-summary-first-subject (not all))
- (while (and (gnus-summary-mark-as-read nil gnus-catchup-mark)
- (if to-here (< (point) to-here) t)
- (gnus-summary-search-subject nil (not all)))))
+ (while (and
+ (if to-here (< (point) to-here) t)
+ (gnus-summary-mark-article-as-read gnus-catchup-mark)
+ (gnus-summary-search-subject nil (not all)))))
(- unreads (length gnus-newsgroup-unreads))
(or to-here
(setq gnus-newsgroup-unreads gnus-newsgroup-marked)))))
+ (let ((method (gnus-find-method-for-group gnus-newsgroup-name)))
+ (if (and (not to-here) (eq 'nnvirtual (car method)))
+ (nnvirtual-catchup-group
+ (gnus-group-real-name gnus-newsgroup-name) (nth 1 method) all)))
(gnus-summary-position-cursor)))
(defun gnus-summary-catchup-to-here (&optional all)
"Mark all unticked articles before the current one as read.
If ALL is non-nil, also mark ticked and dormant articles as read."
(interactive)
- (beginning-of-line)
- (gnus-summary-catchup all t (point))
+ (gnus-set-global-variables)
+ (save-excursion
+ (and (zerop (forward-line -1))
+ (progn
+ (end-of-line)
+ (gnus-summary-catchup all t (point))
+ (gnus-set-mode-line 'summary))))
(gnus-summary-position-cursor))
(defun gnus-summary-catchup-all (&optional quietly)
"Mark all articles in this newsgroup as read."
(interactive)
+ (gnus-set-global-variables)
(gnus-summary-catchup t quietly))
-(defun gnus-summary-catchup-and-exit (all &optional quietly)
+(defun gnus-summary-catchup-and-exit (&optional all quietly)
"Mark all articles not marked as unread in this newsgroup as read, then exit.
If prefix argument ALL is non-nil, all articles are marked as read."
(interactive "P")
+ (gnus-set-global-variables)
(gnus-summary-catchup all quietly nil 'fast)
;; Select next newsgroup or exit.
(if (eq gnus-auto-select-next 'quietly)
(defun gnus-summary-catchup-all-and-exit (&optional quietly)
"Mark all articles in this newsgroup as read, and then exit."
(interactive)
+ (gnus-set-global-variables)
(gnus-summary-catchup-and-exit t quietly))
;; Suggested by "Arne Eofsson" <arne@hodgkin.mbi.ucla.edu>.
-(defun gnus-summary-catchup-and-goto-next-group (all)
+(defun gnus-summary-catchup-and-goto-next-group (&optional all)
"Mark all articles in this group as read and select the next group.
If given a prefix, mark all articles, unread as well as ticked, as
read."
(interactive "P")
+ (gnus-set-global-variables)
(gnus-summary-catchup all)
(gnus-summary-next-group))
;; Thread-based commands.
-(defun gnus-summary-toggle-threads (arg)
+(defun gnus-summary-toggle-threads (&optional arg)
"Toggle showing conversation threads.
If ARG is positive number, turn showing conversation threads on."
(interactive "P")
+ (gnus-set-global-variables)
(let ((current (or (gnus-summary-article-number) gnus-newsgroup-end)))
(setq gnus-show-threads
(if (null arg) (not gnus-show-threads)
(defun gnus-summary-show-all-threads ()
"Show all threads."
(interactive)
+ (gnus-set-global-variables)
(save-excursion
(let ((buffer-read-only nil))
(subst-char-in-region (point-min) (point-max) ?\^M ?\n t)))
"Show thread subtrees.
Returns nil if no thread was there to be shown."
(interactive)
- (prog1
- (save-excursion
- (let ((buffer-read-only nil)
- ;; first goto end then to beg, to have point at beg after let
- (end (progn (end-of-line) (point)))
- (beg (progn (beginning-of-line) (point))))
- (prog1
- ;; Any hidden lines here?
- (search-forward "\r" end t)
- (subst-char-in-region beg end ?\^M ?\n t))))
- (gnus-summary-position-cursor)))
+ (gnus-set-global-variables)
+ (let ((buffer-read-only nil)
+ (orig (prog1 (point) (gnus-summary-hide-thread)))
+ ;; first goto end then to beg, to have point at beg after let
+ (end (progn (end-of-line) (point)))
+ (beg (progn (beginning-of-line) (point))))
+ (prog1
+ ;; Any hidden lines here?
+ (search-forward "\r" end t)
+ (subst-char-in-region beg end ?\^M ?\n t)
+ (goto-char orig)
+ (gnus-summary-position-cursor))))
(defun gnus-summary-hide-all-threads ()
"Hide all thread subtrees."
(interactive)
+ (gnus-set-global-variables)
(save-excursion
(goto-char (point-min))
(gnus-summary-hide-thread)
"Hide thread subtrees.
Returns nil if no threads were there to be hidden."
(interactive)
+ (gnus-set-global-variables)
(let ((buffer-read-only nil)
(start (point))
(level (gnus-summary-thread-level))
(goto-char end)
(search-backward "\n" start t))
(subst-char-in-region start end ?\n ?\^M t)
- (forward-line -1)))))
+ (forward-line -1)
+ (gnus-summary-position-cursor)))))
(defun gnus-summary-go-to-next-thread (&optional previous)
"Go to the same level (or less) next thread.
(let ((level (gnus-summary-thread-level))
(article (gnus-summary-article-number)))
(if previous
- (while (and (zerop (gnus-summary-prev-subject 1))
+ (while (and (zerop (forward-line -1))
(> (gnus-summary-thread-level) level)))
- (while (and (zerop (gnus-summary-next-subject 1))
+ (while (and (save-excursion
+ (forward-line 1)
+ (not (eobp)))
+ (zerop (forward-line 1))
(> (gnus-summary-thread-level) level))))
(gnus-summary-recenter)
(gnus-summary-position-cursor)
Returns the difference between N and the number of skips actually
done."
(interactive "p")
+ (gnus-set-global-variables)
(let ((backward (< n 0))
(n (abs n)))
- (while (and (> n 0)
- (gnus-summary-go-to-next-thread backward))
- (setq n (1- n)))
- (gnus-summary-position-cursor)
- (if (/= 0 n) (gnus-message 7 "No more threads"))
- n))
+ (while (and (> n 0)
+ (gnus-summary-go-to-next-thread backward))
+ (setq n (1- n)))
+ (gnus-summary-position-cursor)
+ (if (/= 0 n) (gnus-message 7 "No more threads"))
+ n))
(defun gnus-summary-prev-thread (n)
"Go to the same level previous N'th thread.
Returns the difference between N and the number of skips actually
done."
(interactive "p")
+ (gnus-set-global-variables)
(gnus-summary-next-thread (- n)))
(defun gnus-summary-go-down-thread (&optional same)
Returns the difference between N and how many steps down that were
taken."
(interactive "p")
+ (gnus-set-global-variables)
(let ((up (< n 0))
(n (abs n)))
- (while (and (> n 0)
- (if up (gnus-summary-go-up-thread)
- (gnus-summary-go-down-thread)))
- (setq n (1- n)))
- (gnus-summary-position-cursor)
- (if (/= 0 n) (gnus-message 7 "Can't go further"))
- n))
+ (while (and (> n 0)
+ (if up (gnus-summary-go-up-thread)
+ (gnus-summary-go-down-thread)))
+ (setq n (1- n)))
+ (gnus-summary-position-cursor)
+ (if (/= 0 n) (gnus-message 7 "Can't go further"))
+ n))
(defun gnus-summary-up-thread (n)
"Go up thread N steps.
Returns the difference between N and how many steps down that were
taken."
(interactive "p")
+ (gnus-set-global-variables)
(gnus-summary-down-thread (- n)))
-(defun gnus-summary-kill-thread (unmark)
+(defun gnus-summary-kill-thread (&optional unmark)
"Mark articles under current thread as read.
If the prefix argument is positive, remove any kinds of marks.
If the prefix argument is negative, tick articles instead."
(interactive "P")
+ (gnus-set-global-variables)
(if unmark
(setq unmark (prefix-numeric-value unmark)))
(let ((killing t)
(level (gnus-summary-thread-level)))
(save-excursion
+ ;; Expand the thread.
+ (gnus-summary-show-thread)
(while killing
;; Mark the article...
- (cond ((null unmark) (gnus-summary-mark-as-read nil gnus-killed-mark))
- ((> unmark 0) (gnus-summary-tick-article nil t))
- (t (gnus-summary-tick-article)))
+ (cond ((null unmark) (gnus-summary-mark-article-as-read
+ gnus-killed-mark))
+ ((> unmark 0) (gnus-summary-mark-article-as-unread
+ gnus-unread-mark))
+ (t (gnus-summary-mark-article-as-unread gnus-ticked-mark)))
;; ...and go forward until either the buffer ends or the subtree
;; ends.
(if (not (and (zerop (forward-line 1))
"Sort summary buffer by article number.
Argument REVERSE means reverse order."
(interactive "P")
+ (gnus-set-global-variables)
(gnus-summary-sort
- (cons 'gnus-summary-article-number 'gnus-thread-sort-by-number) reverse))
+ ;; `gnus-summary-article-number' is a macro, and `sort-subr' wants
+ ;; a function, so we wrap it.
+ (cons (lambda () (gnus-summary-article-number))
+ 'gnus-thread-sort-by-number) reverse))
(defun gnus-summary-sort-by-author (&optional reverse)
"Sort summary buffer by author name alphabetically.
If case-fold-search is non-nil, case of letters is ignored.
Argument REVERSE means reverse order."
(interactive "P")
+ (gnus-set-global-variables)
(gnus-summary-sort
(cons
(lambda ()
- (let ((extract (funcall
- gnus-extract-address-components
- (header-from (gnus-get-header-by-number
- (gnus-summary-article-number))))))
- (or (car extract) (cdr extract))))
+ (let* ((header (gnus-get-header-by-num (gnus-summary-article-number)))
+ (extract (funcall
+ gnus-extract-address-components
+ (mail-header-from header))))
+ (concat (or (car extract) (cdr extract))
+ "\r" (mail-header-subject header))))
'gnus-thread-sort-by-author)
reverse))
If case-fold-search is non-nil, case of letters is ignored.
Argument REVERSE means reverse order."
(interactive "P")
+ (gnus-set-global-variables)
(gnus-summary-sort
(cons
(lambda ()
- (downcase (gnus-simplify-subject (gnus-summary-subject-string))))
+ (let* ((header (gnus-get-header-by-num (gnus-summary-article-number)))
+ (extract (funcall
+ gnus-extract-address-components
+ (mail-header-from header))))
+ (concat
+ (downcase (gnus-simplify-subject (gnus-summary-subject-string) t))
+ "\r" (or (car extract) (cdr extract)))))
'gnus-thread-sort-by-subject)
reverse))
"Sort summary buffer by date.
Argument REVERSE means reverse order."
(interactive "P")
+ (gnus-set-global-variables)
(gnus-summary-sort
(cons
(lambda ()
(gnus-sortable-date
- (header-date
- (gnus-get-header-by-number (gnus-summary-article-number)))))
+ (mail-header-date
+ (gnus-get-header-by-num (gnus-summary-article-number)))))
'gnus-thread-sort-by-date)
reverse))
"Sort summary buffer by score.
Argument REVERSE means reverse order."
(interactive "P")
+ (gnus-set-global-variables)
(gnus-summary-sort
- (cons 'gnus-summary-article-score 'gnus-thread-sort-by-score)
+ (cons (lambda () (gnus-summary-article-score))
+ 'gnus-thread-sort-by-score)
(not reverse)))
(defvar gnus-summary-already-sorted nil)
()
(let (buffer-read-only)
(if (not gnus-show-threads)
+ ;; We do untreaded sorting...
(progn
(goto-char (point-min))
(sort-subr reverse 'forward-line 'end-of-line (car predicate)))
+ ;; ... or we do threaded sorting.
(let ((gnus-thread-sort-functions (list (cdr predicate)))
(gnus-summary-prepare-hook nil)
(gnus-summary-already-sorted nil))
+ ;; We do that by simply regenerating the threads.
(gnus-summary-prepare)
(and gnus-show-threads
gnus-thread-hide-subtree
- (gnus-summary-hide-all-threads)))))))
+ (gnus-summary-hide-all-threads))
+ ;; If in async mode, we send some info to the backend.
+ (and gnus-newsgroup-async
+ (setq gnus-newsgroup-threads (nreverse gnus-newsgroup-threads))
+ (gnus-request-asynchronous
+ gnus-newsgroup-name
+ (if (and gnus-asynchronous-article-function
+ (fboundp gnus-asynchronous-article-function))
+ (funcall gnus-asynchronous-article-function
+ gnus-newsgroup-threads)))))))))
+
(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)))
+ (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
;; Summary saving commands.
-(defun gnus-summary-save-article (n)
+(defun gnus-summary-save-article (&optional n)
"Save the current article using the default saver function.
If N is a positive number, save the N next articles.
If N is a negative number, save the N previous articles.
save those articles instead.
The variable `gnus-default-article-saver' specifies the saver function."
(interactive "P")
+ (gnus-set-global-variables)
(let ((articles (gnus-summary-work-articles n)))
(while articles
- (let ((header (gnus-get-header-by-number (car articles))))
+ (let ((header (gnus-get-header-by-num (car articles))))
(if (vectorp header)
(progn
- (gnus-summary-select-article t nil nil (car articles))
+ (save-window-excursion
+ (gnus-summary-select-article t nil nil (car articles)))
(or gnus-save-all-headers
(gnus-article-hide-headers t))
;; Remove any X-Gnus lines.
(delete-region (point)
(progn (forward-line 1) (point))))
(widen))))
- (save-excursion
+ (save-window-excursion
(if gnus-default-article-saver
(funcall gnus-default-article-saver)
(error "No default saver is defined."))))
(gnus-summary-position-cursor)
n))
-(defun gnus-summary-pipe-output (arg)
+(defun gnus-summary-pipe-output (&optional arg)
"Pipe the current article to a subprocess.
If N is a positive number, pipe the N next articles.
If N is a negative number, pipe the N previous articles.
If N is nil and any articles have been marked with the process mark,
pipe those articles instead."
(interactive "P")
+ (gnus-set-global-variables)
(let ((gnus-default-article-saver 'gnus-summary-save-in-pipe))
(gnus-summary-save-article arg)))
-(defun gnus-summary-save-article-mail (arg)
+(defun gnus-summary-save-article-mail (&optional arg)
"Append the current article to an mail file.
If N is a positive number, save the N next articles.
If N is a negative number, save the N previous articles.
If N is nil and any articles have been marked with the process mark,
save those articles instead."
(interactive "P")
+ (gnus-set-global-variables)
(let ((gnus-default-article-saver 'gnus-summary-save-in-mail))
(gnus-summary-save-article arg)))
-(defun gnus-summary-save-article-rmail (arg)
+(defun gnus-summary-save-article-rmail (&optional arg)
"Append the current article to an rmail file.
If N is a positive number, save the N next articles.
If N is a negative number, save the N previous articles.
If N is nil and any articles have been marked with the process mark,
save those articles instead."
(interactive "P")
+ (gnus-set-global-variables)
(let ((gnus-default-article-saver 'gnus-summary-save-in-rmail))
(gnus-summary-save-article arg)))
-(defun gnus-summary-save-article-file (arg)
+(defun gnus-summary-save-article-file (&optional arg)
"Append the current article to a file.
If N is a positive number, save the N next articles.
If N is a negative number, save the N previous articles.
If N is nil and any articles have been marked with the process mark,
save those articles instead."
(interactive "P")
+ (gnus-set-global-variables)
(let ((gnus-default-article-saver 'gnus-summary-save-in-file))
(gnus-summary-save-article arg)))
Directory to save to is default to `gnus-article-save-directory' which
is initialized from the SAVEDIR environment variable."
(interactive)
+ (gnus-set-global-variables)
(let ((default-name
(funcall gnus-rmail-save-name gnus-newsgroup-name
gnus-current-headers gnus-newsgroup-last-rmail)))
(save-restriction
(widen)
(gnus-output-to-rmail filename))))
- ;; Remember the directory name to save articles.
+ ;; Remember the directory name to save articles
(setq gnus-newsgroup-last-rmail filename)))
(defun gnus-summary-save-in-mail (&optional filename)
Directory to save to is default to `gnus-article-save-directory' which
is initialized from the SAVEDIR environment variable."
(interactive)
+ (gnus-set-global-variables)
(let ((default-name
(funcall gnus-mail-save-name gnus-newsgroup-name
gnus-current-headers gnus-newsgroup-last-mail)))
Directory to save to is default to `gnus-article-save-directory' which
is initialized from the SAVEDIR environment variable."
(interactive)
+ (gnus-set-global-variables)
(let ((default-name
(funcall gnus-file-save-name gnus-newsgroup-name
gnus-current-headers gnus-newsgroup-last-file)))
(defun gnus-summary-save-in-pipe (&optional command)
"Pipe this article to subprocess."
(interactive)
+ (gnus-set-global-variables)
(let ((command (read-string "Shell command on article: "
gnus-last-shell-command)))
(if (string-equal command "")
;; Summary extract commands
-(defun gnus-summary-insert-pseudos (pslist)
+(defun gnus-summary-insert-pseudos (pslist &optional not-view)
(let ((buffer-read-only nil)
(article (gnus-summary-article-number))
b)
(or (gnus-summary-goto-subject article)
(error (format "No such article: %d" article)))
- (or gnus-newsgroup-headers-hashtb-by-number
- (gnus-make-headers-hashtable-by-number))
(gnus-summary-position-cursor)
;; If all commands are to be bunched up on one line, we collect
;; them here.
action
(mapconcat (lambda (f) f) files " ")))))
(setq ps (cdr ps)))))
- (if gnus-view-pseudos
+ (if (and gnus-view-pseudos (not not-view))
(while pslist
(and (assq 'execute (car pslist))
(gnus-execute-command (cdr (assq 'execute (car pslist)))
(forward-line -1)
(gnus-sethash (int-to-string gnus-reffed-article-number)
(car pslist) gnus-newsgroup-headers-hashtb-by-number)
+ (setq gnus-newsgroup-unreads
+ (cons gnus-reffed-article-number gnus-newsgroup-unreads))
(setq gnus-reffed-article-number (1- gnus-reffed-article-number))
(setq pslist (cdr pslist)))))))
(interactive
(list (read-file-name "Copy file: " default-directory)
(read-file-name "Copy file to: " default-directory)))
+ (gnus-set-global-variables)
(or to (setq to (read-file-name "Copy file to: " default-directory)))
(and (file-directory-p to)
(setq to (concat (file-name-as-directory to)
(defun gnus-summary-edit-global-kill (article)
"Edit the \"global\" kill file."
(interactive (list (gnus-summary-article-number)))
+ (gnus-set-global-variables)
(gnus-group-edit-global-kill article))
(defun gnus-summary-edit-local-kill ()
"Edit a local kill file applied to the current newsgroup."
(interactive)
+ (gnus-set-global-variables)
(setq gnus-current-headers
(gnus-gethash
(int-to-string (gnus-summary-article-number))
(put 'gnus-article-mode 'mode-class 'special)
+(defvar gnus-boogaboo nil)
+
(if gnus-article-mode-map
nil
(setq gnus-article-mode-map (make-keymap))
(define-key gnus-article-mode-map "h" 'gnus-article-show-summary)
(define-key gnus-article-mode-map "s" 'gnus-article-show-summary)
(define-key gnus-article-mode-map "\C-c\C-m" 'gnus-article-mail)
- (define-key gnus-article-mode-map "\C-c\C-M" 'gnus-article-mail-with-original)
+ (define-key gnus-article-mode-map
+ "\C-c\C-M" 'gnus-article-mail-with-original)
(define-key gnus-article-mode-map "?" 'gnus-article-describe-briefly)
(define-key gnus-article-mode-map gnus-mouse-2 'gnus-article-push-button)
(define-key gnus-article-mode-map "\r" 'gnus-article-press-button)
(define-key gnus-article-mode-map "\t" 'gnus-article-next-button)
+ (define-key gnus-article-mode-map "\C-c\C-b" 'gnus-bug)
;; Duplicate almost all summary keystrokes in the article mode map.
(let ((commands
- (list "#" "\M-#" "\C-c\M-#" "n" "p"
- "N" "P" "\M-\C-n" "\M-\C-p" "." "\M-s" "\M-r"
- "<" ">" "l" "j" "^" "\M-^" "-" "u" "U" "d" "D"
- "\M-u" "\M-U" "k" "\C-k" "\M-\C-k""x" "X"
- "\M-\C-x" "\M-\177" "b" "B" "$" "w" "\C-c\C-r"
- "t" "\M-t" "C" "S"
- "m" "o" "\C-o" "|" "\M-m" "\M-\C-m" "\M-k" "M"
- "V" "\C-c\C-d")))
- (while commands
+ (list
+ "p" "N" "P" "\M-\C-n" "\M-\C-p"
+ "\M-n" "\M-p" "." "," "\M-s" "\M-r" "<" ">" "j"
+ "u" "!" "U" "d" "D" "E" "\M-u" "\M-U" "k" "\C-k" "\M-\C-k"
+ "\M-\C-l" "e" "#" "\M-#" "\M-\C-t" "\M-\C-s" "\M-\C-h"
+ "\M-\C-f" "\M-\C-b" "\M-\C-u" "\M-\C-d" "&" "\C-w"
+ "\C-t" "?" "\C-c\M-\C-s" "\C-c\C-s\C-n" "\C-c\C-s\C-a"
+ "\C-c\C-s\C-s" "\C-c\C-s\C-d" "\C-c\C-s\C-i" "\C-x\C-s"
+ "\M-g" "w" "\C-c\C-r" "\M-t" "C"
+ "o" "\C-o" "|" "\M-k" "\M-K" "V" "\C-c\C-d"
+ "\C-c\C-i" "x" "X" "t" "g" "?" "l"
+ "\C-c\C-v\C-v" "\C-d" "v"
+;; "Mt" "M!" "Md" "Mr"
+;; "Mc" "M " "Me" "Mx" "M?" "Mb" "MB" "M#" "M\M-#" "M\M-r"
+;; "M\M-\C-r" "MD" "M\M-D" "MS" "MC" "MH" "M\C-c" "Mk" "MK"
+;; "Ms" "Mc" "Mu" "Mm" "Mk" "Gn" "Gp" "GN" "GP" "G\C-n" "G\C-p"
+;; "G\M-n" "G\M-p" "Gf" "Gb" "Gg" "Gl" "Gp" "Tk" "Tl" "Ti" "TT"
+;; "Ts" "TS" "Th" "TH" "Tn" "Tp" "Tu" "Td" "T#" "A " "An" "A\177" "Ap"
+;; "A\r" "A<" "A>" "Ab" "Ae" "A^" "Ar" "Aw" "Ac" "Ag" "At" "Am"
+;; "As" "Wh" "Ws" "Wc" "Wo" "Ww" "Wd" "Wq" "Wf" "Wt" "W\C-t"
+;; "WT" "WA" "Wa" "WH" "WC" "WS" "Wb" "Hv" "Hf" "Hd" "Hh" "Hi"
+;; "Be" "B\177" "Bm" "Br" "Bw" "Bc" "Bq" "Bi" "Oo" "Om" "Or"
+;; "Of" "Oh" "Ov" "Op" "Vu" "V\C-s" "V\C-r" "Vr" "V&" "VT" "Ve"
+;; "VD" "Vk" "VK" "Vsn" "Vsa" "Vss" "Vsd" "Vsi"
+ )))
+ (while (and gnus-boogaboo commands) ; disabled
(define-key gnus-article-mode-map (car commands)
'gnus-article-summary-command)
(setq commands (cdr commands))))
- (let ((commands (list "q" "Q" "c" "r" "R" "\C-c\C-f" "m" "a" "f" "F")))
- (while commands
+ (let ((commands (list "q" "Q" "c" "r" "R" "\C-c\C-f" "m" "a" "f" "F"
+;; "Zc" "ZC" "ZE" "ZQ" "ZZ" "Zn" "ZR" "ZG" "ZN" "ZP"
+ "=" "n" "^" "\M-^")))
+ (while (and gnus-boogaboo commands) ; disabled
(define-key gnus-article-mode-map (car commands)
'gnus-article-summary-command-nosave)
(setq commands (cdr commands)))))
(defun gnus-article-setup-buffer ()
"Initialize article mode buffer."
+ ;; Returns the article buffer.
(if (get-buffer gnus-article-buffer)
(save-excursion
(set-buffer gnus-article-buffer)
+ (buffer-disable-undo (current-buffer))
+ (setq buffer-read-only t)
+ (gnus-add-current-to-buffer-list)
(or (eq major-mode 'gnus-article-mode)
- (gnus-article-mode)))
+ (gnus-article-mode))
+ (current-buffer))
(save-excursion
(set-buffer (get-buffer-create gnus-article-buffer))
(gnus-add-current-to-buffer-list)
- (gnus-article-mode))))
+ (gnus-article-mode)
+ (current-buffer))))
;; Set article window start at LINE, where LINE is the number of lines
;; from the head of the article.
(setq group (or group gnus-newsgroup-name))
;; Open server if it has closed.
- (gnus-check-news-server (gnus-find-method-for-group group))
+ (gnus-check-server (gnus-find-method-for-group group))
;; Using `gnus-request-article' directly will insert the article into
;; `nntp-server-buffer' - so we'll save some time by not having to
()
(save-excursion
(set-buffer gnus-summary-buffer)
- (let ((header (gnus-get-header-by-number article)))
+ (let ((header (gnus-get-header-by-num article)))
(if (< article 0)
(if (vectorp header)
;; It's a real article.
- (setq article (header-id header))
+ (setq article (mail-header-id header))
;; It is an extracted pseudo-article.
(setq article 'pseudo)
(gnus-request-pseudo-article header)))
(if (not (eq (car method) 'nneething))
()
(let ((dir (concat (file-name-as-directory (nth 1 method))
- (header-subject header))))
+ (mail-header-subject header))))
(if (file-directory-p dir)
(progn
(setq article 'nneething)
(defun gnus-read-header (id)
"Read the headers of article ID and enter them into the Gnus system."
- (or gnus-newsgroup-headers-hashtb-by-number
- (gnus-make-headers-hashtable-by-number))
(let (header)
(if (not (setq header
(car (if (let ((gnus-nov-is-evil t))
(gnus-get-newsgroup-headers)))))
nil
(if (stringp id)
- (header-set-number header gnus-reffed-article-number))
+ (mail-header-set-number header gnus-reffed-article-number))
(setq gnus-newsgroup-headers (cons header gnus-newsgroup-headers))
- (gnus-sethash (int-to-string (header-number header)) header
+ (gnus-sethash (int-to-string (mail-header-number header)) header
gnus-newsgroup-headers-hashtb-by-number)
(if (stringp id)
(setq gnus-reffed-article-number (1- gnus-reffed-article-number)))
;; Make sure the connection to the server is alive.
(or (gnus-server-opened (gnus-find-method-for-group gnus-newsgroup-name))
(progn
- (gnus-check-news-server
+ (gnus-check-server
(gnus-find-method-for-group gnus-newsgroup-name))
(gnus-request-group gnus-newsgroup-name t)))
- (or gnus-newsgroup-headers-hashtb-by-number
- (gnus-make-headers-hashtable-by-number))
- (let* ((article (if header (header-number header) article))
+ (let* ((article (if header (mail-header-number header) article))
(summary-buffer (current-buffer))
(internal-hook gnus-article-internal-prepare-hook)
(group gnus-newsgroup-name)
(gnus-request-article-this-buffer
article group))))
;; There is no such article.
- (progn
- (save-excursion
+ (save-excursion
+ (if (not (numberp article))
+ ()
+ (setq gnus-article-current
+ (cons gnus-newsgroup-name article))
(set-buffer gnus-summary-buffer)
- (setq gnus-current-article 0)
- (and (numberp article)
- (gnus-summary-mark-as-read article gnus-canceled-mark))
- (gnus-message 1 "No such article (may be canceled)")
- (and (numberp article)
- (setq gnus-current-article article))
- (ding))
- (and (numberp article)
- (setq gnus-article-current
- (cons gnus-newsgroup-name article)))
+ (setq gnus-current-article article)
+ (gnus-summary-mark-article article gnus-canceled-mark))
+ (gnus-message 1 "No such article (may be canceled)")
+ (ding)
nil)
(if (or (eq result 'pseudo) (eq result 'nneething))
(progn
gnus-newsgroup-history)
gnus-current-article article
gnus-current-headers
- (gnus-get-header-by-number gnus-current-article)
+ (gnus-get-header-by-num gnus-current-article)
gnus-article-current
(cons gnus-newsgroup-name gnus-current-article))
(gnus-summary-show-thread)
;; Suggested by Jim Sisolak
;; <sisolak@trans4.neep.wisc.edu>.
(gnus-set-global-variables)
+ (setq gnus-have-all-headers
+ (or all-headers gnus-show-all-headers))
(and gnus-use-cache
+ (vectorp (gnus-get-header-by-number article))
(gnus-cache-possibly-enter-article
group article
(gnus-get-header-by-number article)
(memq article gnus-newsgroup-marked)
(memq article gnus-newsgroup-dormant)
(memq article gnus-newsgroup-unreads)))))
- ;; gnus-have-all-headers must be either T or NIL.
- (setq gnus-have-all-headers
- (not (not (or all-headers gnus-show-all-headers))))
;; Hooks for getting information from the article.
;; This hook must be called before being narrowed.
(let (buffer-read-only)
(run-hooks 'gnus-article-prepare-hook)
;; Decode MIME message.
(if (and gnus-show-mime
- (gnus-fetch-field "Mime-Version"))
+ (or (not gnus-strict-mime)
+ (gnus-fetch-field "Mime-Version")))
(funcall gnus-show-mime-method))
;; Perform the article display hooks.
(run-hooks 'gnus-article-display-hook))
(defun gnus-article-hide-headers-if-wanted ()
"Hide unwanted headers if `gnus-have-all-headers' is nil.
Provided for backwards compatability."
- (or gnus-have-all-headers
+ (or (save-excursion (set-buffer gnus-summary-buffer) gnus-have-all-headers)
(gnus-article-hide-headers)))
(defun gnus-article-hide-headers (&optional delete)
(save-restriction
(let ((sorted gnus-sorted-header-list)
(buffer-read-only nil)
- want want-list beg want-l)
+ want-list beg want-l)
;; First we narrow to just the headers.
(widen)
(goto-char (point-min))
;; Hide any "From " lines at the beginning of (mail) articles.
(while (looking-at "From ")
(forward-line 1))
- (if (bobp)
+ (or (bobp)
(add-text-properties (point-min) (point) gnus-hidden-properties))
;; Then treat the rest of the header lines.
(narrow-to-region
(let ((next (following-char))
(previous (char-after (- (point) 2))))
(cond ((eq next previous)
- (delete-region (- (point) 2) (point))
+ (put-text-property (- (point) 2) (point)
+ 'invisible t)
(put-text-property (point) (1+ (point))
'face 'bold))
((eq next ?_)
- (delete-region (1- (point)) (1+ (point)))
+ (put-text-property (1- (point)) (1+ (point))
+ 'invisible t)
(put-text-property (1- (point)) (point)
'face 'underline))
((eq previous ?_)
- (delete-region (- (point) 2) (point))
+ (put-text-property (- (point) 2) (point)
+ 'invisible t)
(put-text-property (point) (1+ (point))
'face 'underline))))))))
(goto-char (point-min))
(search-forward "\n\n" nil t)
(end-of-line 1)
- (let ((paragraph-start "^\\W"))
+ (let ((paragraph-start "^[>|#:<;* ]*[ \t]*$")
+ (adaptive-fill-regexp "[ \t]*\\([|#:<;>*]+ *\\)?")
+ (adaptive-fill-mode t))
(while (not (eobp))
- (and (>= (current-column) (window-width))
+ (and (>= (current-column) (min fill-column (window-width)))
(/= (preceding-char) ?:)
(fill-paragraph nil))
(end-of-line 2))))))
(search-forward "\n\n")
(narrow-to-region (point-min) (point))
(goto-char (point-min))
- (if (or (not gnus-article-x-face-command)
- (and (not force)
- (or (not gnus-article-x-face-too-ugly)
- (string-match gnus-article-x-face-too-ugly
- (mail-fetch-field "from"))))
- (progn
- (goto-char (point-min))
- (not (re-search-forward "^X-Face: " nil t))))
+ (if (not (and gnus-article-x-face-command
+ (or force
+ (not gnus-article-x-face-too-ugly)
+ (and gnus-article-x-face-too-ugly
+ (not (string-match gnus-article-x-face-too-ugly
+ (mail-fetch-field "from")))))
+ (progn
+ (goto-char (point-min))
+ (re-search-forward "^X-Face: " nil t))))
nil
(let ((beg (point))
(end (1- (re-search-forward "^\\($\\|[^ \t]\\)" nil t))))
(insert (hexl-hex-string-to-integer
(buffer-substring (point) (+ 2 (point)))))
(delete-char 2))
+ ((looking-at "=")
+ (delete-char 1))
((gnus-message 3 "Malformed MIME quoted-printable message"))))))
+(defvar gnus-article-time-units
+ (list (cons 'year (* 365.25 24 60 60))
+ (cons 'week (* 7 24 60 60))
+ (cons 'day (* 24 60 60))
+ (cons 'hour (* 60 60))
+ (cons 'minute 60)
+ (cons 'second 1)))
+
(defun gnus-article-date-ut (&optional type)
"Convert DATE date to universal time in the current article.
If TYPE is `local', convert to local time; if it is `lapsed', output
how much time has lapsed since DATE."
(interactive (list 'ut))
- (let ((date (header-date (or gnus-current-headers
- (gnus-get-header-by-number
- (gnus-summary-article-number))"")))
+ (let ((date (mail-header-date (or gnus-current-headers
+ (gnus-get-header-by-number
+ (gnus-summary-article-number))"")))
(date-regexp "^Date: \\|^X-Sent: "))
- (if (not date)
+ (if (or (not date)
+ (string= date ""))
()
(save-excursion
(set-buffer gnus-article-buffer)
(insert
(cond
((eq type 'local)
- (concat "Date: " (timezone-make-date-arpa-standard date) "\n"))
+ (concat "Date: " (condition-case ()
+ (timezone-make-date-arpa-standard date)
+ (error date))
+ "\n"))
((eq type 'ut)
- (concat "Date: " (timezone-make-date-arpa-standard date nil "UT")
+ (concat "Date: "
+ (condition-case ()
+ (timezone-make-date-arpa-standard date nil "UT")
+ (error date))
"\n"))
((eq type 'lapsed)
- (let* ((sec (- (gnus-seconds-since-epoch
- (timezone-make-date-arpa-standard
- (current-time-string) (current-time-zone) "UT"))
- (gnus-seconds-since-epoch
- (timezone-make-date-arpa-standard date nil "UT"))))
- (units (list (cons 'year (* 365.25 24 60 60))
- (cons 'week (* 7 24 60 60))
- (cons 'day (* 24 60 60))
- (cons 'hour (* 60 60))
- (cons 'minute 60)
- (cons 'second 1)))
+ ;; If the date is seriously mangled, the timezone
+ ;; functions are liable to bug out, so we condition-case
+ ;; the entire thing.
+ (let* ((real-sec (condition-case ()
+ (- (gnus-seconds-since-epoch
+ (timezone-make-date-arpa-standard
+ (current-time-string)
+ (current-time-zone) "UT"))
+ (gnus-seconds-since-epoch
+ (timezone-make-date-arpa-standard
+ date nil "UT")))
+ (error 0)))
+ (sec (abs real-sec))
num prev)
- (concat
- "X-Sent: "
- (mapconcat
- (lambda (unit)
- (if (zerop (setq num (ffloor (/ sec (cdr unit)))))
- ""
- (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))))
- units "")
- " ago\n")))
+ (if (zerop sec)
+ "X-Sent: Now\n"
+ (concat
+ "X-Sent: "
+ (mapconcat
+ (lambda (unit)
+ (if (zerop (setq num (ffloor (/ sec (cdr unit)))))
+ ""
+ (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 (> real-sec 0)
+ " ago\n"
+ " in the future\n")))))
(t
(error "Unknown conversion type: %s" type)))))))))
(gnus-article-date-ut 'lapsed))
(defun gnus-article-maybe-highlight ()
- (if gnus-visual (gnus-article-highlight)))
+ "Do some article highlighting if `gnus-visual' is non-nil."
+ (if gnus-visual (gnus-article-highlight-some)))
;; Article savers.
(goto-char (point-min))
(insert "\^L\n0, unseen,,\n*** EOOH ***\n")
(while (search-forward "\n\^_" nil t) ;single char
- (replace-match "\n^_" t t)) ;2 chars: "^" and "_"
+ (replace-match "\n^_" t t)) ;2 chars: "^" and "_"
(goto-char (point-max))
(insert "\^_")))
(goto-char (point-min))
(if (re-search-forward "^Date:[ \t]\\(.*\\)$" nil t)
(let ((buffer-read-only nil)
- (date (buffer-substring (match-beginning 1) (match-end 1))))
+ (date (buffer-substring-no-properties
+ (match-beginning 1) (match-end 1))))
(delete-region (match-beginning 1) (match-end 1))
(insert
(timezone-make-date-arpa-standard
;; Article mode commands
-(defun gnus-article-next-page (lines)
+(defun gnus-article-next-page (&optional lines)
"Show next page of current article.
If end of article, return non-nil. Otherwise return nil.
Argument LINES specifies lines to be scrolled up."
(goto-char (point-max))))
nil))
-(defun gnus-article-prev-page (lines)
+(defun gnus-article-prev-page (&optional lines)
"Show previous page of current article.
Argument LINES specifies lines to be scrolled down."
(interactive "P")
(bobp)
(not (save-restriction (widen) (bobp)))) ;Real beginning-of-buffer?
(progn
- (gnus-narrow-to-page -1) ;Go to previous page.
+ (gnus-narrow-to-page -1) ;Go to previous page.
(goto-char (point-max))
(recenter -1))
(scroll-down lines)))
(defun gnus-article-refer-article ()
"Read article specified by message-id around point."
(interactive)
- (search-forward ">" nil t) ;Move point to end of "<....>".
+ (search-forward ">" nil t) ;Move point to end of "<....>".
(if (re-search-backward "\\(<[^<> \t\n]+>\\)" nil t)
(let ((message-id
(buffer-substring (match-beginning 1) (match-end 1))))
"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-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")))
(defun gnus-article-summary-command ()
"Execute the last keystroke in the summary buffer."
(setq func (lookup-key (current-local-map) (this-command-keys)))
(call-interactively func)
(set-buffer obuf)
- (let ((npoint (point)))
- (set-window-configuration owin)
- (set-window-start (get-buffer-window (current-buffer)) (point)))))
+ (set-window-configuration owin)
+ (set-window-point (get-buffer-window (current-buffer)) (point))))
(defun gnus-article-summary-command-nosave ()
"Execute the last keystroke in the summary buffer."
(interactive)
- (let ((obuf (current-buffer))
- (owin (current-window-configuration))
- func)
- (switch-to-buffer gnus-summary-buffer 'norecord)
+ (let (func)
+ (pop-to-buffer gnus-summary-buffer 'norecord)
(setq func (lookup-key (current-local-map) (this-command-keys)))
(call-interactively func)))
-;; caesar-region written by phr@prep.ai.mit.edu Nov 86
-;; Modified by tower@prep Nov 86
-;; Modified by umerin@flab.flab.Fujitsu.JUNET for ROT47.
-
-(defun gnus-caesar-region (&optional n)
- "Caesar rotation of region by N, default 13, for decrypting netnews.
-ROT47 will be performed for Japanese text in any case."
- (interactive (if current-prefix-arg ; Was there a prefix arg?
- (list (prefix-numeric-value current-prefix-arg))
- (list nil)))
- (cond ((not (numberp n)) (setq n 13))
- (t (setq n (mod n 26)))) ;canonicalize N
- (if (not (zerop n)) ; no action needed for a rot of 0
- (progn
- (if (or (not (boundp 'caesar-translate-table))
- (not caesar-translate-table)
- (/= (aref caesar-translate-table ?a) (+ ?a n)))
- (let ((i 0)
- (lower "abcdefghijklmnopqrstuvwxyz")
- upper)
- (gnus-message 9 "Building caesar-translate-table...")
- (setq caesar-translate-table (make-vector 256 0))
- (while (< i 256)
- (aset caesar-translate-table i i)
- (setq i (1+ i)))
- (setq lower (concat lower lower)
- upper (upcase lower)
- i 0)
- (while (< i 26)
- (aset caesar-translate-table (+ ?a i) (aref lower (+ i n)))
- (aset caesar-translate-table (+ ?A i) (aref upper (+ i n)))
- (setq i (1+ i)))
- ;; ROT47 for Japanese text.
- ;; Thanks to ichikawa@flab.fujitsu.junet.
- (setq i 161)
- (let ((t1 (logior ?O 128))
- (t2 (logior ?! 128))
- (t3 (logior ?~ 128)))
- (while (< i 256)
- (aset caesar-translate-table i
- (let ((v (aref caesar-translate-table i)))
- (if (<= v t1) (if (< v t2) v (+ v 47))
- (if (<= v t3) (- v 47) v))))
- (setq i (1+ i))))
- (gnus-message 9 "Building caesar-translate-table...done")))
- (let ((from (region-beginning))
- (to (region-end))
- (i 0) str len)
- (setq str (buffer-substring from to))
- (setq len (length str))
- (while (< i len)
- (aset str i (aref caesar-translate-table (aref str i)))
- (setq i (1+ i)))
- (goto-char from)
- (delete-region from to)
- (insert str)))))
-
\f
;; Basic ideas by emv@math.lsa.umich.edu (Edward Vielmetti)
(gnus-use-dribble-file nil)
(yes (car yes-and-no))
(no (cdr yes-and-no))
- group subscribed newsrc entry
+ group newsrc entry
;; Disable verbose message.
gnus-novice-user gnus-large-newsgroup)
;; Eat all arguments.
(or gnus-kill-files-directory "~/News")))
((gnus-use-long-file-name 'not-kill)
;; Append ".KILL" to newsgroup name.
- (expand-file-name (concat newsgroup "." gnus-kill-file-name)
+ (expand-file-name (concat (gnus-newsgroup-saveable-name newsgroup)
+ "." gnus-kill-file-name)
(or gnus-kill-files-directory "~/News")))
(t
;; Place "KILL" under the hierarchical directory.
;;;
(defvar gnus-dribble-ignore nil)
+(defvar gnus-dribble-eval-file nil)
(defun gnus-dribble-file-name ()
- (concat gnus-startup-file "-dribble"))
-
-(defun gnus-dribble-open ()
- (save-excursion
- (set-buffer
- (setq gnus-dribble-buffer (find-file-noselect (gnus-dribble-file-name))))
- (buffer-disable-undo (current-buffer))
- (bury-buffer gnus-dribble-buffer)
- (auto-save-mode t)
- (goto-char (point-max))))
+ (concat gnus-current-startup-file "-dribble"))
(defun gnus-dribble-enter (string)
(if (and (not gnus-dribble-ignore)
(set-buffer-modified-p t))
(if (gnus-y-or-n-p
"Auto-save file exists. Do you want to read it? ")
- (progn
- (gnus-message 5 "Reading %s..." dribble-file)
- (eval-current-buffer)
- (gnus-message 5 "Reading %s...done" dribble-file)))))))))
+ (setq gnus-dribble-eval-file t))))))))
+
+(defun gnus-dribble-eval-file ()
+ (if (not gnus-dribble-eval-file)
+ ()
+ (setq gnus-dribble-eval-file nil)
+ (save-excursion
+ (let ((gnus-dribble-ignore t))
+ (set-buffer gnus-dribble-buffer)
+ (eval-buffer (current-buffer))))))
(defun gnus-dribble-delete-file ()
(if (file-exists-p (gnus-dribble-file-name))
;;; Server Communication
;;;
-;; All the Gnus backends have the same interface, and should return
-;; data in a similar format. Below is an overview of what functions
-;; these packages must supply and what results they should return.
-;;
-;; Variables:
-;;
-;; `nntp-server-buffer' - All data should be returned to Gnus in this
-;; buffer.
-;;
-;; Functions for the imaginary backend `choke':
-;;
-;; `choke-retrieve-headers ARTICLES &optional GROUP SERVER'
-;; Should return all headers for all ARTICLES, or return NOV lines for
-;; the same.
-;;
-;; `choke-request-group GROUP &optional SERVER DISCARD'
-;; Switch to GROUP. If DISCARD is nil, active information on the group
-;; must be returned.
-;;
-;; `choke-close-group GROUP &optional SERVER'
-;; Close group. Most backends won't have to do anything with this
-;; call, but it is an opportunity to clean up, if that is needed. It
-;; is called when Gnus exits a group.
-;;
-;; `choke-request-article ARTICLE &optional GROUP SERVER'
-;; Return ARTICLE, which is either an article number or
-;; message-id. Note that not all backends can return articles based on
-;; message-id.
-;;
-;; `choke-request-list SERVER'
-;; Return a list of all newsgroups on SERVER.
-;;
-;; `choke-request-list-newsgroups SERVER'
-;; Return a list of descriptions of all newsgroups on SERVER.
-;;
-;; `choke-request-newgroups DATE &optional SERVER'
-;; Return a list of all groups that have arrived after DATE on
-;; SERVER. Note that the date doesn't have to be respected - Gnus will
-;; always check whether the groups are old or not. Backends that do
-;; not store date information may just return the entire list of
-;; groups, although this might not be a good idea in general.
-;;
-;; `choke-request-post-buffer METHOD HEADER ARTICLE-BUFFER GROUP INFO'
-;; Should return a buffer that is suitable for "posting". nnspool and
-;; nntp return a `*post-buffer*', and nnmail return a `*mail*'
-;; buffer. This function should fill out the appropriate headers.
-;;
-;; `choke-request-post &optional SERVER'
-;; Function that will be called from a buffer to be posted.
-;;
-;; `choke-open-server SERVER &optional ARGUMENT'
-;; Open a connection to SERVER.
-;;
-;; `choke-close-server &optional SERVER'
-;; Close the connection to SERVER.
-;;
-;; `choke-server-opened &optional SERVER'
-;; Whether the conenction to SERVER is opened or not.
-;;
-;; `choke-server-status &optional SERVER'
-;; Should return a status string (not in the nntp buffer, but as the
-;; result of the function).
-;;
-;; `choke-retrieve-groups GROUPS &optional SERVER'
-;; Optional function for retrieving active file info on all groups in
-;; GROUPS. Two return formats are supported: The normal active file
-;; format, and a list of GROUP lines. This function should return (as
-;; a function value) either `active' or `group', depending on what
-;; format it returns.
-;;
-;; The following functions are optional and apply only to backends
-;; that are able to control the contents of their groups totally
-;; (ie. mail backends.) Backends that aren't able to do that
-;; shouldn't define these functions at all. Gnus will check for their
-;; presence before attempting to call them.
-;;
-;; `choke-request-expire-articles ARTICLES &optional NEWSGROUP SERVER'
-;; Should expire (according to some aging scheme) all ARTICLES. Most
-;; backends will not be able to expire articles. Should return a list
-;; of all articles that were not expired.
-;;
-;; `choke-request-move-article ARTICLE GROUP SERVER ACCEPT-FORM &optional LAST'
-;; Should move ARTICLE from GROUP on SERVER by using ACCEPT-FORM.
-;; Removes any information it has added to the article (extra headers,
-;; whatever - make it as clean as possible), and then passes the
-;; article on by evaling ACCEPT-FORM, which is normally a call to the
-;; function described below. If the ACCEPT-FORM returns a non-nil
-;; value, the article should then be deleted. If LAST is nil, that
-;; means that there will be further calls to this function. This might
-;; be taken as an advice not to save buffers/internal variables just
-;; yet, but wait until the last call to speed things up.
-;;
-;; `choke-request-accept-article GROUP &optional LAST'
-;; The contents of the current buffer will be put into GROUP. There
-;; should, of course, be an article in the current buffer. This
-;; function is normally only called by the function described above,
-;; and LAST works the same way as in that function.
-;;
-;; `choke-request-replace-article ARTICLE GROUP BUFFER'
-;; Replace ARTICLE in GROUP with the contents of BUFFER.
-;; This provides an easy interface for allowing editing of
-;; articles. Note that even headers may be edited, so the backend has
-;; to update any tables (nov buffers, etc) that it maintains after
-;; replacing the article.
-;;
-;; `choke-request-create-group GROUP &optional SERVER'
-;; Create GROUP on SERVER. This might be a new, empty group, or it
-;; might be a group that already exists, but hasn't been registered
-;; yet.
-;;
-;; All these functions must return nil if they couldn't service the
-;; request. If the optional arguments are not supplied, some "current"
-;; or "default" values should be used. In short, one should emulate an
-;; NNTP server, in a way.
-;;
-;; If you want to write a new backend, you just have to supply the
-;; functions listed above. In addition, you must enter the new backend
-;; into the list of valid select methods:
-;; (setq gnus-valid-select-methods
-;; (cons '("choke" mail) gnus-valid-select-methods))
-;; The first element in this list is the name of the backend. Other
-;; elemnets may be `mail' (for mail groups), `post' (for news
-;; groups), `none' (neither), `respool' (for groups that can control
-;; their contents).
-
(defun gnus-start-news-server (&optional confirm)
"Open a method for getting news.
If CONFIRM is non-nil, the user will be asked for an NNTP server."
- (let (how where)
+ (let (how)
(if gnus-current-select-method
;; Stream is already opened.
nil
(list 'nntp gnus-nntp-server)))))
(setq how (car gnus-select-method))
- (setq where (car (cdr gnus-select-method)))
(cond ((eq how 'nnspool)
(require 'nnspool)
(gnus-message 5 "Looking up local news spool..."))
(gnus-open-server gnus-select-method)
(gnus-y-or-n-p
(format
- "%s server on %s can't be opened. Continue? "
- (car gnus-select-method) (nth 1 gnus-select-method)))
+ "%s open error: '%s'. Continue? "
+ (nth 1 gnus-select-method)
+ (gnus-status-message gnus-select-method)))
(progn
(gnus-message 1 "Couldn't open server on %s"
(nth 1 gnus-select-method))
(ding)
nil)))))
-(defun gnus-check-news-server (&optional method)
+(defun gnus-check-server (&optional method)
"If the news server is down, start it up again."
(let ((method (if method method gnus-select-method)))
(and (stringp method)
;; Open server.
(gnus-message 5 "Opening server %s on %s..." (car method) (nth 1 method))
(run-hooks 'gnus-open-server-hook)
- (or (gnus-server-opened method)
- (gnus-open-server method))
- (message ""))))
+ (prog1
+ (gnus-open-server method)
+ (message "")))))
(defun gnus-nntp-message (&optional message)
"Check the status of the NNTP server.
(defun gnus-retrieve-headers (articles group)
(let ((method (gnus-find-method-for-group group)))
- (if gnus-use-cache
+ (if (and gnus-use-cache (numberp (car articles)))
(gnus-cache-retrieve-headers articles group)
(funcall (gnus-get-function method 'retrieve-headers)
articles (gnus-group-real-name group) (nth 1 method)))))
(funcall (gnus-get-function method 'request-head)
article (gnus-group-real-name group) (nth 1 method))))
+(defun gnus-request-body (article group)
+ (let ((method (gnus-find-method-for-group group)))
+ (funcall (gnus-get-function method 'request-body)
+ article (gnus-group-real-name group) (nth 1 method))))
+
;; Fix by Sudish Joseph <joseph@cis.ohio-state.edu>.
(defun gnus-request-post-buffer (post group subject header artbuf
info follow-to respect-poster)
- (let* ((info (or info (and group (nth 2 (gnus-gethash
- group gnus-newsrc-hashtb)))))
- (method
- (if (and gnus-post-method
- ;; Fix by Sudish Joseph <joseph@cis.ohio-state.edu>.
- (memq 'post (assoc
- (format "%s" (car (gnus-find-method-for-group
- gnus-newsgroup-name)))
- gnus-valid-select-methods)))
- gnus-post-method
- (gnus-find-method-for-group gnus-newsgroup-name))))
- (or (gnus-server-opened method)
- (gnus-open-server method)
- (error "Can't open server %s:%s" (car method) (nth 1 method)))
- (let ((mail-self-blind nil)
- (mail-archive-file-name nil))
- (funcall (gnus-get-function method 'request-post-buffer)
- post group subject header artbuf info follow-to
- respect-poster))))
+ (let* ((info (or info (and group (nth 2 (gnus-gethash
+ group gnus-newsrc-hashtb)))))
+ (method
+ (if (and gnus-post-method
+ ;; Fix by Sudish Joseph <joseph@cis.ohio-state.edu>.
+ (memq 'post (assoc
+ (format "%s" (car (gnus-find-method-for-group
+ gnus-newsgroup-name)))
+ gnus-valid-select-methods)))
+ gnus-post-method
+ (gnus-find-method-for-group gnus-newsgroup-name))))
+ (or (gnus-check-server method)
+ (error "Can't open server %s:%s" (car method) (nth 1 method)))
+ (let ((mail-self-blind nil)
+ (mail-archive-file-name nil))
+ (funcall (gnus-get-function method 'request-post-buffer)
+ post group subject header artbuf info follow-to
+ respect-poster))))
(defun gnus-request-post (method &optional force)
(and (stringp method)
(format "%s" (car (gnus-find-method-for-group group)))
gnus-valid-select-methods)))
+(defun gnus-secondary-method-p (method)
+ (let ((methods gnus-secondary-select-methods)
+ (gmethod (gnus-server-get-method nil method)))
+ (while (and methods
+ (not (equal (gnus-server-get-method nil (car methods))
+ gmethod)))
+ (setq methods (cdr methods)))
+ methods))
+
(defun gnus-find-method-for-group (group &optional info)
(or gnus-override-method
(and (not group)
(defun gnus-check-backend-function (func group)
(let ((method (if (stringp group) (car (gnus-find-method-for-group group))
- group)))
+ group)))
(fboundp (intern (format "%s-%s" method func)))))
(defun gnus-methods-using (method)
;; (67 . 99)) ...)
;; The only element in each entry in this hash table is a range of
;; (possibly) available articles. (Articles in this range may have
-;; been expired or cancelled.)
+;; been expired or canceled.)
;;
;; Gnus internal format of gnus-killed-list and gnus-zombie-list:
;; ("alt.misc" "alt.test" "alt.general" ...)
If LEVEL is non-nil, the news will be set up at level LEVEL."
(let ((init (not (and gnus-newsrc-alist gnus-active-hashtb (not rawfile)))))
;; Clear some variables to re-initialize news information.
- (if init (setq gnus-newsrc-alist nil gnus-active-hashtb nil))
+ (if init (setq gnus-newsrc-alist nil
+ gnus-active-hashtb nil))
;; Read the newsrc file and create `gnus-newsrc-hashtb'.
(if init (gnus-read-newsrc-file rawfile))
+ ;; If we don't read the complete active file, we fill in the
+ ;; hashtb here.
+ (if (or (null gnus-read-active-file)
+ (eq gnus-read-active-file 'some))
+ (gnus-update-active-hashtb-from-killed))
+
;; Read the active file and create `gnus-active-hashtb'.
;; If `gnus-read-active-file' is nil, then we just create an empty
;; hash table. The partial filling out of the hash table will be
;; done in `gnus-get-unread-articles'.
- (if (and gnus-read-active-file
- (not level)
- (gnus-server-opened gnus-select-method))
- (gnus-read-active-file)
- (setq gnus-active-hashtb (make-vector 4095 0)))
+ (and gnus-read-active-file
+ (not level)
+ (gnus-read-active-file))
- (and init gnus-use-dribble-file (gnus-dribble-read-file))
+ (or gnus-active-hashtb
+ (setq gnus-active-hashtb (make-vector 4095 0)))
+
+ ;; Possibly eval the dribble file.
+ (and init gnus-use-dribble-file (gnus-dribble-eval-file))
+
+ (gnus-update-format-specifications)
- ;; Find the number of unread articles in each non-dead group.
- (gnus-get-unread-articles (or level (1+ gnus-level-subscribed)))
;; Find new newsgroups and treat them.
(if (and init gnus-check-new-newsgroups gnus-read-active-file (not level)
(gnus-server-opened gnus-select-method))
(gnus-find-new-newsgroups))
+
+ ;; Find the number of unread articles in each non-dead group.
+ (let ((gnus-read-active-file (and (not level) gnus-read-active-file)))
+ (gnus-get-unread-articles (or level (1+ gnus-level-subscribed))))
+
(if (and init gnus-check-bogus-newsgroups
gnus-read-active-file (not level)
(gnus-server-opened gnus-select-method))
(gnus-ask-server-for-new-groups)
(let ((groups 0)
group new-newsgroups)
+ (gnus-message 5 "Looking for new newsgroups...")
(or gnus-have-read-active-file (gnus-read-active-file))
(setq gnus-newsrc-last-checked-date (current-time-string))
(if (not gnus-killed-hashtb) (gnus-make-hashtable-from-killed))
;; with `gnus-newsrc-hashtb' and `gnus-killed-hashtb'.
(mapatoms
(lambda (sym)
- (setq group (symbol-name sym))
- (if (or (gnus-gethash group gnus-killed-hashtb)
+ (if (or (null (setq group (symbol-name sym)))
+ (null (symbol-value sym))
+ (gnus-gethash group gnus-killed-hashtb)
(gnus-gethash group gnus-newsrc-hashtb))
()
(let ((do-sub (gnus-matches-options-n group)))
- (cond ((eq do-sub 'subscribe)
- (setq groups (1+ groups))
- (gnus-sethash group group gnus-killed-hashtb)
- (funcall
- gnus-subscribe-options-newsgroup-method group))
- ((eq do-sub 'ignore)
- nil)
- (t
- (setq groups (1+ groups))
- (gnus-sethash group group gnus-killed-hashtb)
- (if gnus-subscribe-hierarchical-interactive
- (setq new-newsgroups (cons group new-newsgroups))
- (funcall gnus-subscribe-newsgroup-method group)))))))
+ (cond
+ ((eq do-sub 'subscribe)
+ (setq groups (1+ groups))
+ (gnus-sethash group group gnus-killed-hashtb)
+ (funcall gnus-subscribe-options-newsgroup-method group))
+ ((eq do-sub 'ignore)
+ nil)
+ (t
+ (setq groups (1+ groups))
+ (gnus-sethash group group gnus-killed-hashtb)
+ (if gnus-subscribe-hierarchical-interactive
+ (setq new-newsgroups (cons group new-newsgroups))
+ (funcall gnus-subscribe-newsgroup-method group)))))))
gnus-active-hashtb)
(if new-newsgroups
(gnus-subscribe-hierarchical-interactive new-newsgroups))
;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
(if (> groups 0)
(gnus-message 6 "%d new newsgroup%s arrived."
- groups (if (> groups 1) "s have" " has")))))))
+ groups (if (> groups 1) "s have" " has"))
+ (gnus-message 6 "No new newsgroups."))))))
(defun gnus-matches-options-n (group)
;; Returns `subscribe' if the group is to be uncoditionally
;; First we check the two user variables.
(cond
((and gnus-options-subscribe
- (string-match gnus-options-not-subscribe group))
+ (string-match gnus-options-subscribe group))
'subscribe)
((and gnus-options-not-subscribe
- (string-match gnus-options-subscribe group))
+ (string-match gnus-options-not-subscribe group))
'ignore)
;; Then we go through the list that was retrieved from the .newsrc
;; file. This list has elements on the form
gnus-secondary-select-methods)))
(groups 0)
(new-date (current-time-string))
- hashtb group new-newsgroups got-new)
- ;; Go thorugh both primary and secondary select methods and
+ (hashtb (gnus-make-hashtable 100))
+ group new-newsgroups got-new method)
+ ;; Go through both primary and secondary select methods and
;; request new newsgroups.
(while methods
- (if (gnus-request-newgroups date (car methods))
- (save-excursion
- (setq got-new t)
- (or hashtb (setq hashtb (gnus-make-hashtable
- (count-lines (point-min) (point-max)))))
- (set-buffer nntp-server-buffer)
- ;; Enter all the new groups in a hashtable.
- (gnus-active-to-gnus-format (car methods) hashtb)))
+ (setq method (gnus-server-get-method nil (car methods)))
+ (and (gnus-check-server method)
+ (gnus-request-newgroups date method)
+ (save-excursion
+ (setq got-new t)
+ (set-buffer nntp-server-buffer)
+ ;; Enter all the new groups in a hashtable.
+ (gnus-active-to-gnus-format method hashtb 'ignore)))
(setq methods (cdr methods)))
(and got-new (setq gnus-newsrc-last-checked-date new-date))
;; Now all new groups from all select methods are in `hashtb'.
(mapatoms
(lambda (group-sym)
(setq group (symbol-name group-sym))
- (if (or (gnus-gethash group gnus-newsrc-hashtb)
+ (if (or (null group)
+ (null (symbol-value group-sym))
+ (gnus-gethash group gnus-newsrc-hashtb)
(member group gnus-zombie-list)
(member group gnus-killed-list))
;; The group is already known.
()
- (gnus-sethash group (symbol-value group-sym) gnus-active-hashtb)
+ (and (symbol-value group-sym)
+ (gnus-sethash group (symbol-value group-sym) gnus-active-hashtb))
(let ((do-sub (gnus-matches-options-n group)))
(cond ((eq do-sub 'subscribe)
(setq groups (1+ groups))
(setq groups (or groups gnus-backup-default-subscribed-newsgroups))
(mapatoms
(lambda (sym)
- (setq group (symbol-name sym))
- (let ((do-sub (gnus-matches-options-n group)))
- (cond ((eq do-sub 'subscribe)
- (gnus-sethash group group gnus-killed-hashtb)
- (funcall
- gnus-subscribe-options-newsgroup-method group))
- ((eq do-sub 'ignore)
- nil)
- (t
- (setq gnus-killed-list (cons group gnus-killed-list))))))
+ (if (null (setq group (symbol-name sym)))
+ ()
+ (let ((do-sub (gnus-matches-options-n group)))
+ (cond
+ ((eq do-sub 'subscribe)
+ (gnus-sethash group group gnus-killed-hashtb)
+ (funcall gnus-subscribe-options-newsgroup-method group))
+ ((eq do-sub 'ignore)
+ nil)
+ (t
+ (setq gnus-killed-list (cons group gnus-killed-list)))))))
gnus-active-hashtb)
(while groups
(if (gnus-gethash (car groups) gnus-active-hashtb)
;; after.
(defun gnus-group-change-level (entry level &optional oldlevel
previous fromkilled)
- (let ((pinfo entry)
- group info active num)
+ (let (group info active num)
;; Glean what info we can from the arguments
(if (consp entry)
(if fromkilled (setq group (nth 1 entry))
(< oldlevel gnus-level-zombie))
(setq entry (gnus-gethash entry gnus-newsrc-hashtb)))
(if (and (not oldlevel)
- (listp entry))
+ (consp entry))
(setq oldlevel (car (cdr (nth 2 entry)))))
(if (stringp previous)
(setq previous (gnus-gethash previous gnus-newsrc-hashtb)))
- (gnus-dribble-enter
- (format "(gnus-group-change-level %S %S %S %S %S)"
- group level oldlevel (car (nth 2 previous)) fromkilled))
+ (if (and (>= oldlevel gnus-level-zombie)
+ (gnus-gethash group gnus-newsrc-hashtb))
+ ;; We are trying to subscribe a group that is already
+ ;; subscribed.
+ () ; Do nothing.
+
+ (gnus-dribble-enter
+ (format "(gnus-group-change-level %S %S %S %S %S)"
+ group level oldlevel (car (nth 2 previous)) fromkilled))
- ;; Then we remove the newgroup from any old structures, if needed.
- ;; If the group was killed, we remove it from the killed or zombie
- ;; list. If not, and it is in fact going to be killed, we remove
- ;; it from the newsrc hash table and assoc.
- (cond ((>= oldlevel gnus-level-zombie)
- (if (= oldlevel gnus-level-zombie)
- (setq gnus-zombie-list (delete group gnus-zombie-list))
- (setq gnus-killed-list (delete group gnus-killed-list))))
- (t
- (if (>= level gnus-level-zombie)
- (progn
- (gnus-sethash (car (nth 2 entry))
- nil gnus-newsrc-hashtb)
- (if (nth 3 entry)
- (setcdr (gnus-gethash (car (nth 3 entry))
- gnus-newsrc-hashtb)
- (cdr entry)))
- (setcdr (cdr entry) (cdr (cdr (cdr entry))))))))
-
- ;; Finally we enter (if needed) the list where it is supposed to
- ;; go, and change the subscription level. If it is to be killed,
- ;; we enter it into the killed or zombie list.
- (cond ((>= level gnus-level-zombie)
- ;; Remove from the hash table.
- (gnus-sethash group nil gnus-newsrc-hashtb)
- (or (gnus-group-foreign-p group)
- ;; We do not enter foreign groups into the list of dead
- ;; groups.
- (if (= level gnus-level-zombie)
- (setq gnus-zombie-list (cons group gnus-zombie-list))
- (setq gnus-killed-list (cons group gnus-killed-list)))))
- (t
- ;; If the list is to be entered into the newsrc assoc, and
- ;; it was killed, we have to create an entry in the newsrc
- ;; hashtb format and fix the pointers in the newsrc assoc.
- (if (>= oldlevel gnus-level-zombie)
- (progn
- (if (listp entry)
- (progn
- (setq info (cdr entry))
- (setq num (car entry)))
- (setq active (gnus-gethash group gnus-active-hashtb))
- (setq num (if active (- (1+ (cdr active)) (car active)) t))
- ;; Check whether the group is foreign. If so, the
- ;; foreign select method has to be entered into the
- ;; info.
- (let ((method (gnus-group-method-name group)))
- (if (eq method gnus-select-method)
- (setq info (list group level nil))
- (setq info (list group level nil nil method)))))
- (or previous
- (setq previous
- (let ((p gnus-newsrc-alist))
- (while (cdr (cdr p))
- (setq p (cdr p)))
- p)))
- (setq entry (cons info (cdr (cdr previous))))
- (if (cdr previous)
- (progn
- (setcdr (cdr previous) entry)
- (gnus-sethash group (cons num (cdr previous))
- gnus-newsrc-hashtb))
- (setcdr previous entry)
- (gnus-sethash group (cons num previous)
- gnus-newsrc-hashtb))
- (if (cdr entry)
- (setcdr (gnus-gethash (car (car (cdr entry)))
- gnus-newsrc-hashtb)
- entry)))
- ;; It was alive, and it is going to stay alive, so we
- ;; just change the level and don't change any pointers or
- ;; hash table entries.
- (setcar (cdr (car (cdr (cdr entry)))) level))))))
+ ;; Then we remove the newgroup from any old structures, if needed.
+ ;; If the group was killed, we remove it from the killed or zombie
+ ;; list. If not, and it is in fact going to be killed, we remove
+ ;; it from the newsrc hash table and assoc.
+ (cond ((>= oldlevel gnus-level-zombie)
+ (if (= oldlevel gnus-level-zombie)
+ (setq gnus-zombie-list (delete group gnus-zombie-list))
+ (setq gnus-killed-list (delete group gnus-killed-list))))
+ (t
+ (if (and (>= level gnus-level-zombie)
+ entry)
+ (progn
+ (gnus-sethash (car (nth 2 entry)) nil gnus-newsrc-hashtb)
+ (if (nth 3 entry)
+ (setcdr (gnus-gethash (car (nth 3 entry))
+ gnus-newsrc-hashtb)
+ (cdr entry)))
+ (setcdr (cdr entry) (cdr (cdr (cdr entry))))))))
+
+ ;; Finally we enter (if needed) the list where it is supposed to
+ ;; go, and change the subscription level. If it is to be killed,
+ ;; we enter it into the killed or zombie list.
+ (cond ((>= level gnus-level-zombie)
+ ;; Remove from the hash table.
+ (gnus-sethash group nil gnus-newsrc-hashtb)
+ (or (gnus-group-foreign-p group)
+ ;; We do not enter foreign groups into the list of dead
+ ;; groups.
+ (if (= level gnus-level-zombie)
+ (setq gnus-zombie-list (cons group gnus-zombie-list))
+ (setq gnus-killed-list (cons group gnus-killed-list)))))
+ (t
+ ;; If the list is to be entered into the newsrc assoc, and
+ ;; it was killed, we have to create an entry in the newsrc
+ ;; hashtb format and fix the pointers in the newsrc assoc.
+ (if (>= oldlevel gnus-level-zombie)
+ (progn
+ (if (listp entry)
+ (progn
+ (setq info (cdr entry))
+ (setq num (car entry)))
+ (setq active (gnus-gethash group gnus-active-hashtb))
+ (setq num
+ (if active (- (1+ (cdr active)) (car active)) t))
+ ;; Check whether the group is foreign. If so, the
+ ;; foreign select method has to be entered into the
+ ;; info.
+ (let ((method (gnus-group-method-name group)))
+ (if (eq method gnus-select-method)
+ (setq info (list group level nil))
+ (setq info (list group level nil nil method)))))
+ (or previous
+ (setq previous
+ (let ((p gnus-newsrc-alist))
+ (while (cdr (cdr p))
+ (setq p (cdr p)))
+ p)))
+ (setq entry (cons info (cdr (cdr previous))))
+ (if (cdr previous)
+ (progn
+ (setcdr (cdr previous) entry)
+ (gnus-sethash group (cons num (cdr previous))
+ gnus-newsrc-hashtb))
+ (setcdr previous entry)
+ (gnus-sethash group (cons num previous)
+ gnus-newsrc-hashtb))
+ (if (cdr entry)
+ (setcdr (gnus-gethash (car (car (cdr entry)))
+ gnus-newsrc-hashtb)
+ entry)))
+ ;; It was alive, and it is going to stay alive, so we
+ ;; just change the level and don't change any pointers or
+ ;; hash table entries.
+ (setcar (cdr (car (cdr (cdr entry)))) level)))))))
(defun gnus-kill-newsgroup (newsgroup)
"Obsolete function. Kills a newsgroup."
If CONFIRM is non-nil, the user has to confirm the deletion of every
newsgroup."
(let ((newsrc (cdr gnus-newsrc-alist))
- bogus group)
+ bogus group entry)
(gnus-message 5 "Checking bogus newsgroups...")
(or gnus-have-read-active-file (gnus-read-active-file))
;; Find all bogus newsgroup that are subscribed.
(while newsrc
(setq group (car (car newsrc)))
- (if (or (gnus-gethash group gnus-active-hashtb)
- (nth 4 (car newsrc))
+ (if (or (gnus-gethash group gnus-active-hashtb) ; Active
+ (nth 4 (car newsrc)) ; Foreign
(and confirm
(not (gnus-y-or-n-p
(format "Remove bogus newsgroup: %s " group)))))
- ;; Active newsgroup.
+ ;; Don't remove.
()
;; Found a bogus newsgroup.
(setq bogus (cons group bogus)))
;; Remove all bogus subscribed groups by first killing them, and
;; then removing them from the list of killed groups.
(while bogus
- (gnus-group-change-level
- (gnus-gethash (car bogus) gnus-newsrc-hashtb) gnus-level-killed)
- (setq gnus-killed-list (delete (car bogus) gnus-killed-list))
+ (and (setq entry (gnus-gethash (car bogus) gnus-newsrc-hashtb))
+ (progn
+ (gnus-group-change-level entry gnus-level-killed)
+ (setq gnus-killed-list (delete (car bogus) gnus-killed-list))))
(setq bogus (cdr bogus)))
;; Then we remove all bogus groups from the list of killed and
;; zombie groups. They are are removed without confirmation.
;; Go though `gnus-newsrc-alist' and compare with `gnus-active-hashtb'
;; and compute how many unread articles there are in each group.
-(defun gnus-get-unread-articles (&optional level)
+(defun gnus-get-unread-articles (&optional level)
(let* ((newsrc (cdr gnus-newsrc-alist))
- (conditional level)
(level (or level (1+ gnus-level-subscribed)))
+ (foreign-level
+ (min
+ (cond ((and gnus-activate-foreign-newsgroups
+ (not (numberp gnus-activate-foreign-newsgroups)))
+ (1+ gnus-level-subscribed))
+ ((numberp gnus-activate-foreign-newsgroups)
+ gnus-activate-foreign-newsgroups)
+ (t 0))
+ level))
info group active virtuals method)
(gnus-message 5 "Checking new news...")
+
(while newsrc
- (setq info (car newsrc))
- (setq group (car info))
- (setq active (gnus-gethash group gnus-active-hashtb))
+ (setq info (car newsrc)
+ group (car info)
+ active (gnus-gethash group gnus-active-hashtb))
;; Check newsgroups. If the user doesn't want to check them, or
;; they can't be checked (for instance, if the news server can't
;; unread articles, but it has no idea how many.
(if (and (setq method (nth 4 info))
(not (gnus-server-equal gnus-select-method
- (gnus-server-get-method nil method))))
- (if (or (and gnus-activate-foreign-newsgroups
- (not (numberp gnus-activate-foreign-newsgroups)))
- (and (numberp gnus-activate-foreign-newsgroups)
- (<= (nth 1 info) gnus-activate-foreign-newsgroups)
- (<= (nth 1 info) level)))
+ (gnus-server-get-method nil method)))
+ (not (gnus-secondary-method-p method)))
+ ;; These groups are foreign. Check the level.
+ (if (<= (nth 1 info) foreign-level)
(if (eq (car (if (stringp method)
(gnus-server-to-method method)
(nth 4 info))) 'nnvirtual)
+ ;; We have to activate the virtual groups after all
+ ;; the others, so we just pop them on a list for
+ ;; now.
(setq virtuals (cons info virtuals))
- (setq active (gnus-activate-newsgroup (car info)))))
+ (and (setq active (gnus-activate-group (car info)))
+ ;; Close the groups as we look at them!
+ (gnus-close-group group))))
+
+ ;; These groups are native or secondary.
(if (and (not gnus-read-active-file)
(<= (nth 1 info) level))
(progn
- (setq active (gnus-activate-newsgroup (car info))))))
+ (or gnus-read-active-file (gnus-check-server method))
+ (setq active (gnus-activate-group (car info))))))
- (or active (progn (gnus-sethash group nil gnus-active-hashtb)
- (setcar (gnus-gethash group gnus-newsrc-hashtb) t)))
- (and active
- (gnus-get-unread-articles-in-group info active)
- ;; Close the groups as we look at them!
- (gnus-close-group group))
+ (if active
+ (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-sethash group nil gnus-active-hashtb)
+ (setcar (gnus-gethash group gnus-newsrc-hashtb) t))
+
(setq newsrc (cdr newsrc)))
;; Activate the virtual groups. This has to be done after all the
;; other groups.
;; !!! If one virtual group contains another virtual group, even
;; doing it this way might cause problems.
- (while virtuals
- (and (setq active (gnus-activate-newsgroup (car (car virtuals))))
+ (while virtuals
+ (and (setq active (gnus-activate-group (car (car virtuals))))
(gnus-get-unread-articles-in-group (car virtuals) active))
(setq virtuals (cdr virtuals)))
;; alist elements are used as keys.
(defun gnus-make-hashtable-from-newsrc-alist ()
(let ((alist gnus-newsrc-alist)
- prev)
+ (ohashtb gnus-newsrc-hashtb)
+ prev)
(setq gnus-newsrc-hashtb (gnus-make-hashtable (length alist)))
(setq alist
(setq prev (setq gnus-newsrc-alist
- (cons (list "dummy.group" 0 nil) alist))))
+ (if (equal (car (car gnus-newsrc-alist))
+ "dummy.group")
+ gnus-newsrc-alist
+ (cons (list "dummy.group" 0 nil) alist)))))
(while alist
- (gnus-sethash (car (car alist)) (cons nil prev) gnus-newsrc-hashtb)
- (setq prev alist)
- (setq alist (cdr alist)))))
+ (gnus-sethash (car (car alist))
+ (cons (and ohashtb (car (gnus-gethash
+ (car (car alist)) ohashtb)))
+ prev) gnus-newsrc-hashtb)
+ (setq prev alist
+ alist (cdr alist)))))
(defun gnus-make-hashtable-from-killed ()
"Create a hash table from the killed and zombie lists."
(defun gnus-get-unread-articles-in-group (info active)
(let* ((range (nth 2 info))
(num 0)
- (marked (nth 3 info))
- srange lowest group highest)
+ (marked (nth 3 info)))
;; If a cache is present, we may have to alter the active info.
(and gnus-use-cache
(gnus-cache-possibly-alter-active (car info) active))
;; Modify the list of read articles according to what articles
;; are available; then tally the unread articles and add the
;; number to the group hash table entry.
- (cond ((zerop (cdr active))
- (setq num 0))
- ((not range)
- (setq num (- (1+ (cdr active)) (car active))))
- ((not (listp (cdr range)))
- ;; Fix a single (num . num) range according to the
- ;; active hash table.
- ;; Fix by Carsten Bormann <cabo@Informatik.Uni-Bremen.DE>.
- (and (< (cdr range) (car active)) (setcdr range (1- (car active))))
- (and (> (cdr range) (cdr active)) (setcdr range (cdr active)))
- ;; Compute number of unread articles.
- (setq num (max 0 (- (cdr active)
- (- (1+ (cdr range)) (car range))))))
- (t
- ;; The read list is a list of ranges. Fix them according to
- ;; the active hash table.
- ;; First peel off any elements that are below the lower
- ;; active limit.
- (while (and (cdr range)
- (>= (car active)
- (or (and (atom (car (cdr range))) (car (cdr range)))
- (car (car (cdr range))))))
- (if (numberp (car range))
- (setcar range
- (cons (car range)
- (or (and (numberp (car (cdr range)))
- (car (cdr range)))
- (cdr (car (cdr range))))))
- (setcdr (car range)
- (or (and (numberp (nth 1 range)) (nth 1 range))
- (cdr (car (cdr range))))))
- (setcdr range (cdr (cdr range))))
- ;; Adjust the first element to be the same as the lower limit.
- (if (and (not (atom (car range)))
- (< (cdr (car range)) (car active)))
- (setcdr (car range) (1- (car active))))
- ;; Then we want to peel off any elements that are higher
- ;; than the upper active limit.
- (let ((srange range))
- ;; Go past all legal elements.
- (while (and (cdr srange)
- (<= (or (and (atom (car (cdr srange)))
- (car (cdr srange)))
- (car (car (cdr srange)))) (cdr active)))
- (setq srange (cdr srange)))
- (if (cdr srange)
- ;; Nuke all remaining illegal elements.
- (setcdr srange nil))
-
- ;; Adjust the final element.
- (if (and (not (atom (car srange)))
- (> (cdr (car srange)) (cdr active)))
- (setcdr (car srange) (cdr active))))
- ;; Compute the number of unread articles.
- (while range
- (setq num (+ num (- (1+ (or (and (atom (car range)) (car range))
- (cdr (car range))))
- (or (and (atom (car range)) (car range))
- (car (car range))))))
- (setq range (cdr range)))
- (setq num (max 0 (- (cdr active) num)))))
+ (cond
+ ((zerop (cdr active))
+ (setq num 0))
+ ((not range)
+ (setq num (- (1+ (cdr active)) (car active))))
+ ((not (listp (cdr range)))
+ ;; Fix a single (num . num) range according to the
+ ;; active hash table.
+ ;; Fix by Carsten Bormann <cabo@Informatik.Uni-Bremen.DE>.
+ (and (< (cdr range) (car active)) (setcdr range (1- (car active))))
+ (and (> (cdr range) (cdr active)) (setcdr range (cdr active)))
+ ;; Compute number of unread articles.
+ (setq num (max 0 (- (cdr active) (- (1+ (cdr range)) (car range))))))
+ (t
+ ;; The read list is a list of ranges. Fix them according to
+ ;; the active hash table.
+ ;; First peel off any elements that are below the lower
+ ;; active limit.
+ (while (and (cdr range)
+ (>= (car active)
+ (or (and (atom (car (cdr range))) (car (cdr range)))
+ (car (car (cdr range))))))
+ (if (numberp (car range))
+ (setcar range
+ (cons (car range)
+ (or (and (numberp (car (cdr range)))
+ (car (cdr range)))
+ (cdr (car (cdr range))))))
+ (setcdr (car range)
+ (or (and (numberp (nth 1 range)) (nth 1 range))
+ (cdr (car (cdr range))))))
+ (setcdr range (cdr (cdr range))))
+ ;; Adjust the first element to be the same as the lower limit.
+ (if (and (not (atom (car range)))
+ (< (cdr (car range)) (car active)))
+ (setcdr (car range) (1- (car active))))
+ ;; Then we want to peel off any elements that are higher
+ ;; than the upper active limit.
+ (let ((srange range))
+ ;; Go past all legal elements.
+ (while (and (cdr srange)
+ (<= (or (and (atom (car (cdr srange)))
+ (car (cdr srange)))
+ (car (car (cdr srange)))) (cdr active)))
+ (setq srange (cdr srange)))
+ (if (cdr srange)
+ ;; Nuke all remaining illegal elements.
+ (setcdr srange nil))
+
+ ;; Adjust the final element.
+ (if (and (not (atom (car srange)))
+ (> (cdr (car srange)) (cdr active)))
+ (setcdr (car srange) (cdr active))))
+ ;; Compute the number of unread articles.
+ (while range
+ (setq num (+ num (- (1+ (or (and (atom (car range)) (car range))
+ (cdr (car range))))
+ (or (and (atom (car range)) (car range))
+ (car (car range))))))
+ (setq range (cdr range)))
+ (setq num (max 0 (- (cdr active) num)))))
(and info
(progn
(and (assq 'tick marked)
(setq marked m))
(setq m (cdr m)))))
-(defun gnus-activate-newsgroup (group)
+(defun gnus-activate-group (group)
+ ;; Check whether a group has been activated or not.
(let ((method (gnus-find-method-for-group group))
active)
- (and (or (gnus-server-opened method) (gnus-open-server method))
- (gnus-request-group group)
+ (and (gnus-check-server method)
+ ;; We escape all bugs and quit here to make it possible to
+ ;; continue if a group is so out-there that it reports bugs
+ ;; and stuff.
+ (condition-case ()
+ (gnus-request-group group)
+ (error nil)
+ (quit nil))
(save-excursion
(set-buffer nntp-server-buffer)
(goto-char (point-min))
+ ;; Parse the result we got from `gnus-request-group'.
(and (looking-at "[0-9]+ [0-9]+ \\([0-9]+\\) [0-9]+")
(progn
(goto-char (match-beginning 1))
group (setq active (cons (read (current-buffer))
(read (current-buffer))))
gnus-active-hashtb))
+ ;; Return the new active info.
active)))))
(defun gnus-update-read-articles
(let* ((active (or gnus-newsgroup-active
(gnus-gethash group gnus-active-hashtb)))
(entry (gnus-gethash group gnus-newsrc-hashtb))
- (number (car entry))
(info (nth 2 entry))
(marked (nth 3 info))
(prev 1)
(unread (sort (copy-sequence unread) (function <)))
- last read)
+ read)
(if (or (not info) (not active))
;; There is no info on this group if it was, in fact,
;; killed. Gnus stores no information on killed groups, so
(while (and dormant (< (car dormant) (car active)))
(setq dormant (cdr dormant)))
(setq unread (sort (append unselected unread) '<))
- ;; Set the number of unread articles in gnus-newsrc-hashtb.
- (setcar entry (max 0 (- (length unread) (length ticked)
- (length dormant))))
;; Compute the ranges of read articles by looking at the list of
;; unread articles.
(while unread
(if domarks dormant (cdr (assq 'dormant marked)))
(if domarks bookmark (cdr (assq 'bookmark marked)))
(if domarks score (cdr (assq 'score marked))))
+ ;; Set the number of unread articles in gnus-newsrc-hashtb.
+ (gnus-get-unread-articles-in-group
+ info (gnus-gethash group gnus-active-hashtb))
t)))
(defun gnus-make-articles-unread (group articles)
(gnus-remove-from-range (nth 2 info) (nreverse news)))
(gnus-group-update-group group t))))
+;; Enter all dead groups into the hashtb.
+(defun gnus-update-active-hashtb-from-killed ()
+ (let ((hashtb (setq gnus-active-hashtb (make-vector 4095 0)))
+ (lists (list gnus-killed-list gnus-zombie-list))
+ killed)
+ (while lists
+ (setq killed (car lists))
+ (while killed
+ (gnus-sethash (car killed) nil hashtb)
+ (setq killed (cdr killed)))
+ (setq lists (cdr lists)))))
+
+;; Get the active file(s) from the backend(s).
(defun gnus-read-active-file ()
- "Get active file from NNTP server."
(gnus-group-set-mode-line)
- (let ((methods (cons gnus-select-method gnus-secondary-select-methods))
- (not-first nil)
+ (let ((methods (if (gnus-check-server gnus-select-method)
+ ;; The native server is available.
+ (cons gnus-select-method gnus-secondary-select-methods)
+ ;; The native server is down, so we just do the
+ ;; secondary ones.
+ gnus-secondary-select-methods))
list-type)
(setq gnus-have-read-active-file nil)
(save-excursion
(set-buffer nntp-server-buffer)
(while methods
- (let* ((where (nth 1 (car methods)))
+ (let* ((method (gnus-server-get-method nil (car methods)))
+ (where (nth 1 method))
(mesg (format "Reading active file%s via %s..."
(if (and where (not (zerop (length where))))
(concat " from " where) "")
- (car (car methods)))))
+ (car method))))
(gnus-message 5 mesg)
- (gnus-check-news-server (car methods))
- (cond
- ((and (eq gnus-read-active-file 'some)
- (gnus-check-backend-function
- 'retrieve-groups (car (car methods))))
- (let ((newsrc (cdr gnus-newsrc-alist))
- groups)
- (while newsrc
- (and (gnus-server-equal
- (gnus-find-method-for-group
- (car (car newsrc)) (car newsrc))
- (gnus-server-get-method nil (car methods)))
- (setq groups (cons (car (car newsrc)) groups)))
- (setq newsrc (cdr newsrc)))
- (setq list-type (gnus-retrieve-groups groups (car methods)))
- (cond ((not list-type)
- (gnus-message
- 1 "Cannot read partial active file from %s server."
- (car (car methods)))
- (ding)
- (sit-for 2))
- ((eq list-type 'active)
- (gnus-active-to-gnus-format (and not-first (car methods)))
- (setq not-first t))
- (t
- (gnus-groups-to-gnus-format (and not-first (car methods)))
- (setq not-first t)))))
- (t
- (if (not (gnus-request-list (car methods)))
- (progn
- (gnus-message 1 "Cannot read active file from %s server."
- (car (car methods)))
- (ding))
- (gnus-active-to-gnus-format
- (and gnus-have-read-active-file (car methods)))
- (setq gnus-have-read-active-file t)
- (gnus-message 5 "%s...done" mesg)))))
+ (if (not (gnus-check-server method))
+ ()
+ (cond
+ ((and (eq gnus-read-active-file 'some)
+ (gnus-check-backend-function 'retrieve-groups (car method)))
+ (let ((newsrc (cdr gnus-newsrc-alist))
+ (gmethod (gnus-server-get-method nil method))
+ groups)
+ (while newsrc
+ (and (gnus-server-equal
+ (gnus-find-method-for-group
+ (car (car newsrc)) (car newsrc))
+ gmethod)
+ (setq groups (cons (gnus-group-real-name
+ (car (car newsrc))) groups)))
+ (setq newsrc (cdr newsrc)))
+ (gnus-check-server method)
+ (setq list-type (gnus-retrieve-groups groups method))
+ (cond
+ ((not list-type)
+ (gnus-message
+ 1 "Cannot read partial active file from %s server."
+ (car method))
+ (ding)
+ (sit-for 2))
+ ((eq list-type 'active)
+ (gnus-active-to-gnus-format method gnus-active-hashtb))
+ (t
+ (gnus-groups-to-gnus-format method gnus-active-hashtb)))))
+ (t
+ (if (not (gnus-request-list method))
+ (progn
+ (gnus-message 1 "Cannot read active file from %s server."
+ (car method))
+ (ding))
+ (gnus-active-to-gnus-format method)
+ ;; We mark this active file as read.
+ (setq gnus-have-read-active-file
+ (cons method gnus-have-read-active-file))
+ (gnus-message 5 "%sdone" mesg))))))
(setq methods (cdr methods))))))
;; Read an active file and place the results in `gnus-active-hashtb'.
-(defun gnus-active-to-gnus-format (method &optional hashtb)
+(defun gnus-active-to-gnus-format (method &optional hashtb ignore-errors)
(let ((cur (current-buffer))
(hashtb (or hashtb
- (if method
+ (if (and gnus-active-hashtb
+ (not (equal method gnus-select-method)))
gnus-active-hashtb
(setq gnus-active-hashtb
- (gnus-make-hashtable
- (count-lines (point-min) (point-max))))))))
+ (if (equal method gnus-select-method)
+ (gnus-make-hashtable
+ (count-lines (point-min) (point-max)))
+ (gnus-make-hashtable 4096))))))
+ (flag-hashtb (gnus-make-hashtable 60)))
;; Delete unnecessary lines.
(goto-char (point-min))
(while (search-forward "\nto." nil t)
- (delete-region (match-beginning 0) (progn (forward-line 1) (point))))
+ (delete-region (1+ (match-beginning 0))
+ (progn (forward-line 1) (point))))
(or (string= gnus-ignored-newsgroups "")
(progn
(goto-char (point-min))
(delete-matching-lines gnus-ignored-newsgroups)))
- (and method (not (eq method gnus-select-method))
+ ;; Make the group names readable as a lisp expression even if they
+ ;; contain special characters.
+ ;; Fix by Luc Van Eycken <Luc.VanEycken@esat.kuleuven.ac.be>.
+ (goto-char (point-max))
+ (while (re-search-backward "[][';?()#]" nil t)
+ (insert ?\\))
+ ;; 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))
- (null (insert prefix))
- (zerop (forward-line 1))))))
- (goto-char (point-min))
- ;; Store active file in hashtable.
+ (progn (insert prefix)
+ (zerop (forward-line 1)))))))
+ ;; Store the active file in a hash table.
(goto-char (point-min))
(if (string-match "%[oO]" gnus-group-line-format)
;; Suggested by Brian Edmonds <edmonds@cs.ubc.ca>.
;; loop...
(let* ((mod-hashtb (make-vector 7 0))
(m (intern "m" mod-hashtb))
- group max mod)
+ group max min)
(while (not (eobp))
(condition-case nil
(progn
(narrow-to-region (point) (gnus-point-at-eol))
(setq group (let ((obarray hashtb)) (read cur)))
- (setq max (read cur))
- (set group (cons (read cur) max))
+ (if (and (numberp (setq max (read cur)))
+ (numberp (setq min (read cur)))
+ (progn
+ (skip-chars-forward " \t")
+ (not
+ (or (= (following-char) ?=)
+ (= (following-char) ?x)
+ (= (following-char) ?j)))))
+ (set group (cons min max))
+ (set group nil))
;; Enter moderated groups into a list.
(if (eq (let ((obarray mod-hashtb)) (read cur)) m)
(setq gnus-moderated-list
(cons (symbol-name group) gnus-moderated-list))))
- (error nil))
+ (error
+ (and group
+ (symbolp group)
+ (set group nil))))
(widen)
(forward-line 1)))
;; And if we do not care about moderation, we use this loop,
;; which is faster.
- (let (group max)
+ (let (group max min)
(while (not (eobp))
(condition-case ()
(progn
(narrow-to-region (point) (gnus-point-at-eol))
;; group gets set to a symbol interned in the hash table
- ;; (what a hack!!)
+ ;; (what a hack!!) - jwz
(setq group (let ((obarray hashtb)) (read cur)))
- (and (numberp (setq max (read cur)))
- (set group (cons (read cur) max))))
+ (if (and (numberp (setq max (read cur)))
+ (numberp (setq min (read cur)))
+ (progn
+ (skip-chars-forward " \t")
+ (not
+ (or (= (following-char) ?=)
+ (= (following-char) ?x)
+ (= (following-char) ?j)))))
+ (set group (cons min max))
+ (set group nil)))
(error
- (progn (ding)
- (gnus-message 3 "Illegal active: %s"
- (buffer-substring
- (gnus-point-at-bol) (gnus-point-at-eol)))
- nil)))
+ (progn
+ (and group
+ (symbolp group)
+ (set group nil))
+ (or ignore-errors
+ (gnus-message 3 "Warning - illegal active: %s"
+ (buffer-substring
+ (gnus-point-at-bol) (gnus-point-at-eol)))))))
(widen)
(forward-line 1))))))
;; Parse a "groups" active file.
(let ((cur (current-buffer))
(hashtb (or hashtb
- (if method
+ (if (and method gnus-active-hashtb)
gnus-active-hashtb
(setq gnus-active-hashtb
(gnus-make-hashtable
(count-lines (point-min) (point-max)))))))
- (prefix (and method (not (eq method gnus-select-method))
+ (prefix (and method
+ (not (gnus-server-equal
+ (gnus-server-get-method nil method)
+ (gnus-server-get-method nil gnus-select-method)))
(gnus-group-prefixed-name "" method))))
(goto-char (point-min))
- (condition-case ()
- ;; We split this into to separate loops, one with the prefix
- ;; and one without to speed the reading up somewhat.
- (if prefix
- (let (min max opoint)
- (while (not (eobp))
- (read cur) (read cur)
- (setq min (read cur)
- max (read cur)
- opoint (point))
- (skip-chars-forward " \t")
- (insert prefix)
- (goto-char opoint)
- (set (let ((obarray hashtb)) (read cur))
- (cons min max))
- (forward-line 1)))
- (let (min max opoint)
- (while (not (eobp))
+ ;; We split this into to separate loops, one with the prefix
+ ;; and one without to speed the reading up somewhat.
+ (if prefix
+ (let (min max opoint group)
+ (while (not (eobp))
+ (condition-case ()
+ (progn
+ (read cur) (read cur)
+ (setq min (read cur)
+ max (read cur)
+ opoint (point))
+ (skip-chars-forward " \t")
+ (insert prefix)
+ (goto-char opoint)
+ (set (let ((obarray hashtb)) (read cur))
+ (cons min max)))
+ (error (and group (symbolp group) (set group nil))))
+ (forward-line 1)))
+ (let (min max group)
+ (while (not (eobp))
+ (condition-case ()
(if (= (following-char) ?2)
(progn
(read cur) (read cur)
(setq min (read cur)
max (read cur))
- (set (let ((obarray hashtb)) (read cur))
+ (set (setq group (let ((obarray hashtb)) (read cur)))
(cons min max))))
- (forward-line 1))))
- (error
- (progn (ding) (gnus-message 3 "Possible error in active file."))))))
+ (error (and group (symbolp group) (set group nil))))
+ (forward-line 1))))))
(defun gnus-read-newsrc-file (&optional force)
"Read startup file.
If FORCE is non-nil, the .newsrc file is read."
- (setq gnus-current-startup-file (gnus-make-newsrc-file gnus-startup-file))
;; Reset variables that might be defined in the .newsrc.eld file.
(let ((variables gnus-variable-list))
(while variables
(error nil))
(and gnus-newsrc-assoc (setq gnus-newsrc-alist gnus-newsrc-assoc)))
(let ((inhibit-quit t))
- (gnus-uncompress-newsrc-assoc))
+ (gnus-uncompress-newsrc-alist))
(gnus-make-hashtable-from-newsrc-alist)
(if (not (file-newer-than-file-p file ding-file))
()
;; Parse the old-style quick startup file
(defun gnus-read-old-newsrc-el-file (file)
- (let (newsrc killed marked group g m len info)
+ (let (newsrc killed marked group m)
(prog1
(let ((gnus-killed-assoc nil)
gnus-marked-assoc gnus-newsrc-alist gnus-newsrc-assoc)
(cdr (cdr group))))
gnus-newsrc-alist)))
(if (setq m (assoc (car group) marked))
- (setcdr (cdr (cdr info)) (cons (list (cons 'tick (cdr m))) nil))))
+ (setcdr (cdr (cdr info))
+ (cons (list (cons 'tick (cdr m))) nil))))
(setq newsrc (cdr newsrc)))
(setq newsrc killed)
(while newsrc
(setcar newsrc (car (car newsrc)))
(setq newsrc (cdr newsrc)))
(setq gnus-killed-list killed))
+ ;; The .el file version of this variable does not begin with
+ ;; "options", while the .eld version does, so we just add it if it
+ ;; isn't there.
+ (and
+ gnus-newsrc-options
+ (progn
+ (and (not (string-match "^ *options" gnus-newsrc-options))
+ (setq gnus-newsrc-options (concat "options " gnus-newsrc-options)))
+ (and (not (string-match "\n$" gnus-newsrc-options))
+ (setq gnus-newsrc-options (concat gnus-newsrc-options "\n")))
+ ;; Finally, if we read some options lines, we parse them.
+ (or (string= gnus-newsrc-options "")
+ (gnus-newsrc-parse-options gnus-newsrc-options))))
+
(setq gnus-newsrc-alist (nreverse gnus-newsrc-alist))
(gnus-make-hashtable-from-newsrc-alist)))
"Make server dependent file name by catenating FILE and server host name."
(let* ((file (expand-file-name file nil))
(real-file (concat file "-" (nth 1 gnus-select-method))))
- (if (file-exists-p real-file)
+ (if (or (file-exists-p real-file)
+ (file-exists-p (concat real-file ".el"))
+ (file-exists-p (concat real-file ".eld")))
real-file file)))
-(defun gnus-uncompress-newsrc-assoc ()
+(defun gnus-uncompress-newsrc-alist ()
;; Uncompress all lists of marked articles in the newsrc assoc.
(let ((newsrc gnus-newsrc-alist)
marked)
(setq marked (cdr marked))))
(setq newsrc (cdr newsrc)))))
-(defun gnus-compress-newsrc-assoc ()
+(defun gnus-compress-newsrc-alist ()
;; Compress all lists of marked articles in the newsrc assoc.
(let ((newsrc gnus-newsrc-alist)
marked)
(eq 'bookmark (car (car marked)))
(eq 'killed (car (car marked)))
(setcdr (car marked)
- (gnus-compress-sequence (sort (cdr (car marked)) '<) t)))
+ (condition-case ()
+ (gnus-compress-sequence
+ (sort (cdr (car marked)) '<) t)
+ (error (cdr (car marked))))))
(setq marked (cdr marked))))
(setq newsrc (cdr newsrc)))))
(defun gnus-newsrc-to-gnus-format ()
(setq gnus-newsrc-options "")
+ (setq gnus-newsrc-options-n nil)
+
(or gnus-active-hashtb
(setq gnus-active-hashtb (make-vector 4095 0)))
(let ((buf (current-buffer))
(already-read (> (length gnus-newsrc-alist) 1))
- group level subscribed info options-symbol newsrc
+ group subscribed options-symbol newsrc Options-symbol
symbol reads num1)
(goto-char (point-min))
;; We intern the symbol `options' in the active hashtb so that we
;; can `eq' against it later.
- (setq options-symbol (intern "options" gnus-active-hashtb))
+ (set (setq options-symbol (intern "options" gnus-active-hashtb)) nil)
+ (set (setq Options-symbol (intern "Options" gnus-active-hashtb)) nil)
(while (not (eobp))
;; We first read the first word on the line by narrowing and
;; Now, the symbol we have read is either `options' or a group
;; name. If it is an options line, we just add it to a string.
(cond
- ((eq symbol options-symbol)
+ ((or (eq symbol options-symbol)
+ (eq symbol Options-symbol))
(setq gnus-newsrc-options
;; This concatting is quite inefficient, but since our
;; thorough studies show that approx 99.37% of all
(progn (beginning-of-line) (point)))
(point))))))
(symbol
+ (or (boundp symbol) (set symbol nil))
;; It was a group name.
(setq subscribed (= (following-char) ?:)
group (symbol-name symbol)
(setq reads (cons num1 reads))
(setq reads
(cons
- (cons num1 (progn
- (narrow-to-region (match-beginning 0)
- (match-end 0))
- (read buf)))
+ (cons num1
+ (progn
+ (narrow-to-region (match-beginning 0)
+ (match-end 0))
+ (read buf)))
reads))
(widen)))
;; It was just a simple number, so we add it to the
(t
;; Not numbers and not eol, so this might be a buggy
;; line...
- (or (eobp) ; If it was eob instead of ?\n, we allow it.
+ (or (eobp)
+ ;; If it was eob instead of ?\n, we allow it.
(progn
;; The line was buggy.
(setq group nil)
(1+ gnus-level-subscribed)
gnus-level-default-unsubscribed))
(nreverse reads))))
- (setq newsrc (cons info newsrc))))
- (forward-line 1))))
+ (setq newsrc (cons info newsrc))))))
+ (forward-line 1))
(setq newsrc (nreverse newsrc))
(prev gnus-newsrc-alist)
entry mentry)
(while rc
- (or (assoc (car (car rc)) newsrc)
+ (or (null (nth 4 (car rc))) ; It's a native group.
+ (assoc (car (car rc)) newsrc) ; It's already in the alist.
(if (setq entry (assoc (car (car prev)) newsrc))
(setcdr (setq mentry (memq entry newsrc))
(cons (car rc) (cdr mentry)))
;; Finally, if we read some options lines, we parse them.
(or (string= gnus-newsrc-options "")
- (gnus-newsrc-parse-options gnus-newsrc-options))
- ))
+ (gnus-newsrc-parse-options gnus-newsrc-options))))
;; Parse options lines to find "options -n !all rec.all" and stuff.
;; The return value will be a list on the form
(- (point) 2)))
(gnus-point-at-eol)))
;; Search for all "words"...
- (while (re-search-forward "[^ \t,\n-]+" eol t)
+ (while (re-search-forward "[^ \t,\n]+" eol t)
(if (= (char-after (match-beginning 0)) ?!)
;; If the word begins with a bang (!), this is a "not"
;; spec. We put this spec (minus the bang) and the
;; from the variable gnus-newsrc-alist.
(and (or gnus-newsrc-alist gnus-killed-list)
gnus-current-startup-file
- (let ((make-backup-files t)
- (version-control nil)
- (require-final-newline t)) ;Don't ask even if requested.
- ;; You can stop or change version control of backup file.
- ;; Suggested by jason@violet.berkeley.edu.
+ (progn
(run-hooks 'gnus-save-newsrc-hook)
(save-excursion
- (if (or (not gnus-dribble-buffer)
- (not (buffer-name gnus-dribble-buffer))
- (zerop (save-excursion
- (set-buffer gnus-dribble-buffer)
- (buffer-size))))
+ (if (and gnus-use-dribble-file
+ (or (not gnus-dribble-buffer)
+ (not (buffer-name gnus-dribble-buffer))
+ (zerop (save-excursion
+ (set-buffer gnus-dribble-buffer)
+ (buffer-size)))))
(gnus-message 4 "(No changes need to be saved)")
(if gnus-save-newsrc-file
(progn
gnus-current-startup-file)))
;; Quickly loadable .newsrc.
(set-buffer (get-buffer-create " *Gnus-newsrc*"))
+ (setq buffer-file-name (concat gnus-current-startup-file ".eld"))
(gnus-add-current-to-buffer-list)
(buffer-disable-undo (current-buffer))
(erase-buffer)
(gnus-message 5 "Saving %s.eld..." gnus-current-startup-file)
(gnus-gnus-to-quick-newsrc-format)
- (write-region 1 (point-max)
- (concat gnus-current-startup-file ".eld")
- nil 'nomesg)
+ (save-buffer)
(kill-buffer (current-buffer))
(gnus-message 5 "Saving %s.eld...done" gnus-current-startup-file)
(gnus-dribble-delete-file))))))
(defun gnus-gnus-to-quick-newsrc-format ()
"Insert Gnus variables such as gnus-newsrc-alist in lisp format."
- (insert ";; (ding) Gnus startup file.\n")
+ (insert ";; Gnus startup file.\n")
(insert ";; Never delete this file - touch .newsrc instead to force Gnus\n")
(insert ";; to read .newsrc.\n")
+ (insert "(setq gnus-newsrc-file-version "
+ (prin1-to-string gnus-version) ")\n")
(let ((variables gnus-variable-list)
(inhibit-quit t)
(gnus-newsrc-alist (cdr gnus-newsrc-alist))
variable)
;; insert lisp expressions.
- (gnus-compress-newsrc-assoc)
+ (gnus-compress-newsrc-alist)
(while variables
(setq variable (car variables))
(and (boundp variable)
(prin1-to-string (symbol-value variable))
")\n"))
(setq variables (cdr variables)))
- (gnus-uncompress-newsrc-assoc)))
+ (gnus-uncompress-newsrc-alist)))
(defun gnus-gnus-to-newsrc-format ()
(let ((newsrc (cdr gnus-newsrc-alist))
info ranges range)
(save-excursion
- (set-buffer (create-file-buffer gnus-startup-file))
+ (set-buffer (create-file-buffer gnus-current-startup-file))
+ (setq buffer-file-name gnus-current-startup-file)
(buffer-disable-undo (current-buffer))
(erase-buffer)
;; Write options.
(if ranges (insert ","))))))
(insert "\n")))
(setq newsrc (cdr newsrc)))
- (write-region 1 (point-max) gnus-current-startup-file nil 'nomesg)
+ ;; It has been reported that sometime the modtime on the .newsrc
+ ;; file seems to be off. We really do want to overwrite it, so
+ ;; we clear the modtime here before saving. It's a bit odd,
+ ;; though...
+ ;; sometimes the modtime clear isn't sufficient. most brute force:
+ ;; delete the silly thing entirely first. but this fails to provide
+ ;; such niceties as .newsrc~ creation.
+ (if gnus-modtime-botch
+ (delete-file gnus-startup-file)
+ (clear-visited-file-modtime))
+ (save-buffer)
(kill-buffer (current-buffer)))))
-(defun gnus-read-descriptions-file ()
- (gnus-message 5 "Reading descriptions file...")
- (cond
- ((not (or (gnus-server-opened gnus-select-method)
- (gnus-open-server gnus-select-method)))
- (gnus-message 1 "Couldn't open server")
- nil)
- ((not (gnus-request-list-newsgroups gnus-select-method))
- (gnus-message 1 "Couldn't read newsgroups descriptions")
- nil)
- (t
- (let (group)
- (setq gnus-description-hashtb
- (gnus-make-hashtable (length gnus-active-hashtb)))
- (save-excursion
- (save-restriction
- (set-buffer nntp-server-buffer)
- (goto-char (point-min))
- (if (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))))
+(defun gnus-read-all-descriptions-files ()
+ (let ((methods (cons gnus-select-method gnus-secondary-select-methods)))
+ (while methods
+ (gnus-read-descriptions-file (car methods))
+ (setq methods (cdr methods)))
+ t))
+
+(defun gnus-read-descriptions-file (&optional method)
+ (let ((method (or method gnus-select-method)))
+ ;; We create the hashtable whether we manage to read the desc file
+ ;; to avoid trying to re-read after a failed read.
+ (or gnus-description-hashtb
+ (setq gnus-description-hashtb
+ (gnus-make-hashtable (length gnus-active-hashtb))))
+ ;; Mark this method's desc file as read.
+ (gnus-sethash (gnus-group-prefixed-name "" method) "Has read"
+ gnus-description-hashtb)
+
+ (gnus-message 5 "Reading descriptions file via %s..." (car method))
+ (cond
+ ((not (gnus-check-server method))
+ (gnus-message 1 "Couldn't open server")
+ nil)
+ ((not (gnus-request-list-newsgroups method))
+ (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)
+ (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)))))
(defun gnus-group-get-description (group)
;; Get the description of a group by sending XGTITLE to the server.
It works along the same lines as a normal formatting string,
with some simple extensions.")
-(defvar gnus-server-mode-line-format "(ding) List of servers"
+(defvar gnus-server-mode-line-format "Gnus List of servers"
"The format specification for the server mode line.")
(defconst gnus-server-line-format-alist
(setcar (nthcdr 3 mode-line-format) ""))
(setq major-mode 'gnus-server-mode)
(setq mode-name "Server")
-; (gnus-group-set-mode-line)
+ ; (gnus-group-set-mode-line)
(setq mode-line-process nil)
(use-local-map gnus-server-mode-map)
(buffer-disable-undo (current-buffer))
(setq b (point))
;; Insert the text.
(insert (eval sformat))
- (add-text-properties
- b (1+ b) (list 'gnus-server (intern name)))))
+ (add-text-properties b (1+ b) (list 'gnus-server (intern name)))))
(defun gnus-server-setup-buffer ()
(if (get-buffer gnus-server-buffer)
(let ((entry
(gnus-copy-sequence
(if (equal (car method) "native") gnus-select-method
- (cdr (assoc (car method) gnus-server-alist))))))
+ (cdr (assoc (car method) gnus-server-alist))))))
(setcar (cdr entry) (concat (nth 1 entry) "+" group))
(nconc entry (cdr method))))
;; select method, and return a select method.
(cond ((stringp method)
(gnus-server-to-method method))
- ((stringp (car method))
+ ((and (stringp (car method)) group)
(gnus-server-extend-method group method))
(t
(gnus-server-add-address method))))
(or (gnus-server-goto-server server)
(if server (error "No such server: %s" server)
(error "No server on the current line")))
+ (gnus-dribble-enter "")
(let ((buffer-read-only nil))
(delete-region (progn (beginning-of-line) (point))
(progn (forward-line 1) (point))))
(and winconf (set-window-configuration winconf))
(set-buffer gnus-server-buffer)
(gnus-server-update-server (gnus-server-server-name))
+ (gnus-server-list-servers)
(gnus-server-position-cursor)))
(defun gnus-server-read-server (server)
(setq gnus-kill-files-directory
(file-name-as-directory
(or gnus-kill-files-directory "~/News/")))
- ;; If er can't read it, there's no score files.
- (if (not (file-readable-p (expand-file-name gnus-kill-files-directory)))
+ ;; If we can't read it, there are no score files.
+ (if (not (file-exists-p (expand-file-name gnus-kill-files-directory)))
(setq gnus-score-file-list nil)
(if (gnus-use-long-file-name 'not-score)
;; We want long file names.
(not (car gnus-score-file-list))
(gnus-file-newer-than gnus-kill-files-directory
(car gnus-score-file-list)))
- (setq gnus-score-file-list
- (cons (nth 5 (file-attributes gnus-kill-files-directory))
- (nreverse
- (directory-files
- gnus-kill-files-directory t
- (gnus-score-file-regexp))))))
+ (setq gnus-score-file-list
+ (cons (nth 5 (file-attributes gnus-kill-files-directory))
+ (nreverse
+ (directory-files
+ gnus-kill-files-directory t
+ (gnus-score-file-regexp))))))
;; We do not use long file names, so we have to do some
;; directory traversing.
(let ((mdir (length (expand-file-name gnus-kill-files-directory)))
(setq dir (expand-file-name
(concat gnus-kill-files-directory
(gnus-replace-chars-in-string group ?. ?/))))
+ (setq dir (gnus-replace-chars-in-string dir ?: ?/))
(setq suffix (car suffixes)
suffixes (cdr suffixes))
(if (file-exists-p (concat dir "/" suffix))
(delete-region (1+ (point)) (point-min)))
;; If short file names were used, we have to translate slashes.
(goto-char (point-min))
- (while (search-forward "/" nil t)
+ (while (re-search-forward "[/:]" nil t)
(replace-match "." t t))
;; Translate "all" to ".*".
(while (search-forward "all" nil t)
(concat gnus-kill-files-directory group "."
gnus-score-file-suffix)
(concat gnus-kill-files-directory
- (gnus-replace-chars-in-string group ?. ?/)
+ (gnus-replace-chars-in-string group ?. ?/ ?: ?/)
"/" gnus-score-file-suffix)))))
(and (member localscore ofiles)
(delete localscore ofiles))
(defun gnus-score-find-single (group)
"Return list containing the score file for GROUP."
- (list (gnus-score-file-name group)))
+ (list (gnus-score-file-name group gnus-adaptive-file-suffix)
+ (gnus-score-file-name group)))
(defun gnus-score-find-hierarchical (group)
"Return list of score files for GROUP.
(setq start (match-beginning 0))
(setq all (cons (substring group 0 start) all)))
(setq all (cons group all))
- (mapcar 'gnus-score-file-name (nreverse all))))
+ (nconc
+ (mapcar (lambda (newsgroup)
+ (gnus-score-file-name newsgroup gnus-adaptive-file-suffix))
+ (setq all (nreverse all)))
+ (mapcar 'gnus-score-file-name all))))
(defvar gnus-score-file-alist-cache nil)
score-files)
;; if this group has been seen before, return the cached entry
(if (setq score-files (assoc group gnus-score-file-alist-cache))
- (cdr score-files) ; ensures caching of groups with no matches
+ (cdr score-files) ;ensures caching groups with no matches
;; handle the multiple match alist
(while alist
(and (string-match (car (car alist)) group)
(setq score-files
- (nconc score-files (cdr (car alist)))))
+ (nconc score-files (copy-sequence (cdr (car alist))))))
(setq alist (cdr alist)))
(setq alist gnus-score-file-single-match-alist)
;; handle the single match alist
- (catch 'done
- (while alist
- (and (string-match (car (car alist)) group)
- ;; progn used just in case ("regexp") has no files
- ;; and score-files is still nil. -sj
- ;; this can be construed as a "stop searching here" feature :>
- ;; and used to simplify regexps in the single-alist
- (progn
- (setq score-files
- (nconc score-files (cdr (car alist))))
- (throw 'done nil)))
- (setq alist (cdr alist))))
+ (while alist
+ (and (string-match (car (car alist)) group)
+ ;; progn used just in case ("regexp") has no files
+ ;; and score-files is still nil. -sj
+ ;; this can be construed as a "stop searching here" feature :>
+ ;; and used to simplify regexps in the single-alist
+ (progn
+ (setq score-files
+ (nconc score-files (copy-sequence (cdr (car alist)))))
+ (setq alist nil)))
+ (setq alist (cdr alist)))
;; cache the score files
(setq gnus-score-file-alist-cache
(cons (cons group score-files) gnus-score-file-alist-cache))
(defun gnus-possibly-score-headers (&optional trace)
(let ((func gnus-score-find-score-files-function)
- score-files scores)
+ score-files)
(and func (not (listp func))
(setq func (list func)))
;; Go through all the functions for finding score files (or actual
(defun gnus-score-file-name (newsgroup &optional suffix)
"Return the name of a score file for NEWSGROUP."
(let ((suffix (or suffix gnus-score-file-suffix)))
- (cond ((or (null newsgroup)
- (string-equal newsgroup ""))
- ;; The global score file is placed at top of the directory.
- (expand-file-name
- suffix (or gnus-kill-files-directory "~/News")))
- ((gnus-use-long-file-name 'not-score)
- ;; Append ".SCORE" to newsgroup name.
- (expand-file-name (concat newsgroup "." suffix)
- (or gnus-kill-files-directory "~/News")))
- (t
- ;; Place "SCORE" under the hierarchical directory.
- (expand-file-name (concat (gnus-newsgroup-directory-form newsgroup)
- "/" suffix)
- (or gnus-kill-files-directory "~/News"))))))
+ (cond
+ ((or (null newsgroup)
+ (string-equal newsgroup ""))
+ ;; The global score file is placed at top of the directory.
+ (expand-file-name
+ suffix (or gnus-kill-files-directory "~/News")))
+ ((gnus-use-long-file-name 'not-score)
+ ;; Append ".SCORE" to newsgroup name.
+ (expand-file-name (concat (gnus-newsgroup-saveable-name newsgroup)
+ "." suffix)
+ (or gnus-kill-files-directory "~/News")))
+ (t
+ ;; Place "SCORE" under the hierarchical directory.
+ (expand-file-name (concat (gnus-newsgroup-directory-form newsgroup)
+ "/" suffix)
+ (or gnus-kill-files-directory "~/News"))))))
(defun gnus-score-search-global-directories (files)
"Scan all global score directories for score files."
projects / gnus / blobdiff