;;; 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.
"*Preferred method for posting USENET news.
If this variable is nil, Gnus will use the current method to decide
which method to use when posting. If it is non-nil, it will override
-the current method. This method will not be used in mail groups and
+the current method. This method will not be used in mail groups and
the like, only in \"real\" newsgroups.
The value must be a valid method as discussed in the documentation of
(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.
(defvar gnus-asynchronous-article-function nil
"*Function for picking articles to pre-fetch, possibly.")
+(defvar gnus-score-file-single-match-alist nil
+ "*Alist mapping regexps to lists of score files.
+Each element of this alist should be of the form
+ (\"REGEXP\" [ \"SCORE-FILE-1\" ] [ \"SCORE-FILE-2\" ] ... )
+
+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 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).")
+
+(defvar gnus-score-file-multiple-match-alist nil
+ "*Alist mapping regexps to lists of score files.
+Each element of this alist should be of the form
+ (\"REGEXP\" [ \"SCORE-FILE-1\" ] [ \"SCORE-FILE-2\" ] ... )
+
+If the name of a group is matched by REGEXP, the corresponding scorefiles
+will be used for that group.
+If multiple REGEXPs match a group, the score files corresponding to each
+match will be used (for only one match to be used, see
+gnus-score-file-single-match-alist).
+
+These score files are loaded in addition to any files returned by
+gnus-score-find-score-files-function (which see).")
+
+
(defvar gnus-score-file-suffix "SCORE"
"*Suffix of the score files.")
+(defvar gnus-adaptive-file-suffix "ADAPT"
+ "*Suffix of the adaptive score files.")
+
+(defvar gnus-score-find-score-files-function 'gnus-score-find-bnews
+ "*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.
+
+See the documentation to these functions for more information.
+
+This variable can also be a list of functions to be called. Each
+function should either return a list of score files, or a list of
+score alists.")
+
(defvar gnus-score-interactive-default-score 1000
"*Scoring commands will raise/lower the score with this number as the default.")
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.")
+ "*Default listing level.
+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:"
(defvar gnus-inhibit-startup-message nil
"*If non-nil, the startup message will not be displayed.")
+(defvar gnus-signature-separator "^-- *$"
+ "Regexp matching signature separator.")
+
(defvar gnus-auto-extend-newsgroup t
"*If non-nil, extend newsgroup forward and backward when requested.")
[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 ?-
"*There is no thread under the article.")
(defvar gnus-not-empty-thread-mark ?=
"*There is a thread under the article.")
+(defvar gnus-dummy-mark ?Z
+ "*This is a dummy article.")
(defvar gnus-view-pseudo-asynchronously nil
"*If non-nil, Gnus will view pseudo-articles asynchronously.")
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
("nnml" mail respool)
("nnmh" mail respool)
("nndir" none prompt-address address)
+ ("nneething" none prompt-address)
("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)
(defvar gnus-article-check-size nil)
(defvar gnus-current-score-file nil)
+(defvar gnus-internal-global-score-files nil)
+(defvar gnus-score-file-list nil)
+
+
(defvar gnus-current-move-group nil)
(defvar gnus-newsgroup-dependencies 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.73"
+(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
environment is, so that it will be easier to locate the bugs.
If you have found a bug that makes Emacs go \"beep\", set
-debug-on-error to t (`M-ESC (setq debug-on-error t)') and include the
-backtrace in your bug report.
+debug-on-error to t (`M-x set-variable RET debug-on-error RET t RET')
+and include the backtrace in your bug report.
Please describe the bug in annoying, painstaking detail.
(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-mail-other-window-using-mhe "gnus-mh")
(autoload 'gnus-summary-save-in-folder "gnus-mh")
+ (autoload 'gnus-summary-save-article-folder "gnus-mh")
(autoload 'gnus-Folder-save-name "gnus-mh")
(autoload 'gnus-folder-save-name "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-uu-decode-unshar-and-save "gnus-uu" nil t)
(autoload 'gnus-uu-decode-save "gnus-uu" nil t)
(autoload 'gnus-uu-decode-binhex "gnus-uu" nil t)
+ (autoload 'gnus-uu-decode-uu-view "gnus-uu" nil t)
+ (autoload 'gnus-uu-decode-uu-and-save-view "gnus-uu" nil t)
+ (autoload 'gnus-uu-decode-unshar-view "gnus-uu" nil t)
+ (autoload 'gnus-uu-decode-unshar-and-save-view "gnus-uu" nil t)
+ (autoload 'gnus-uu-decode-save-view "gnus-uu" nil t)
+ (autoload 'gnus-uu-decode-binhex-view "gnus-uu" nil t)
;; gnus-msg
(autoload 'gnus-summary-send-map "gnus-msg" nil nil 'keymap)
(autoload 'gnus-group-post-news "gnus-msg" nil t)
+ (autoload 'gnus-group-mail "gnus-msg" nil t)
(autoload 'gnus-summary-post-news "gnus-msg" nil t)
(autoload 'gnus-summary-followup "gnus-msg" nil t)
(autoload 'gnus-summary-followup-with-original "gnus-msg" nil t)
(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)
+ (autoload 'gnus-summary-save-article-vm "gnus-vm" nil t)
(autoload 'gnus-mail-forward-using-vm "gnus-vm")
(autoload 'gnus-mail-reply-using-vm "gnus-vm")
(autoload 'gnus-mail-other-window-using-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))
(point)
(goto-char p))))
+;; Delete the current line (and the next N lines.);
+(defmacro gnus-delete-line (&optional n)
+ (` (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))))
(defun gnus-narrow-to-headers ()
(widen)
(save-excursion
- (goto-char (point-min))
- (if (search-forward "\n\n")
- (narrow-to-region 1 (1- (point))))))
+ (narrow-to-region
+ (goto-char (point-min))
+ (if (search-forward "\n\n" nil t)
+ (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)))
+ (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)))
- ;; Finally, we pop to the buffer that's supposed to have point.
- (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 (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))
(setq i (* 2 i)))
(1- i)))
-;; Delete the current line (and the next N lines.);
-(defun gnus-delete-line (&optional n)
- (let ((n (or n 1)))
- (delete-region (progn (beginning-of-line) (point))
- (progn (forward-line n) (point)))))
-
;; Show message if message has a lower level than `gnus-verbose'.
;; Guide-line for numbers:
;; 1 - error messages, 3 - non-serious error messages, 5 - messages
;; 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-mode-map "<" 'beginning-of-buffer)
(define-key gnus-group-mode-map ">" 'end-of-buffer)
(define-key gnus-group-mode-map "\C-c\C-b" 'gnus-bug)
+ (define-key gnus-group-mode-map "\C-c\C-s" 'gnus-group-sort-groups)
(define-key gnus-group-mode-map "#" 'gnus-group-mark-group)
(define-key gnus-group-mode-map "\M-#" 'gnus-group-unmark-group)
(define-key gnus-group-group-map "e" 'gnus-group-edit-group-method)
(define-key gnus-group-group-map "p" 'gnus-group-edit-group-parameters)
(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)
(defun gnus-group-real-name (group)
"Find the real name of a foreign newsgroup."
- (if (string-match "^[^:]+:" group)
- (substring group (match-end 0))
+ (if (string-match ":[^:]+$" group)
+ (substring group (1+ (match-beginning 0)))
group))
(defun gnus-group-prefixed-name (group method)
(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
"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.
(let ((group (gnus-group-group-name)))
(and group (list group))))))
-
-
;; 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
+ (group method &optional activate quit-config)
+ (let ((group (if (gnus-group-foreign-p group) group
+ (gnus-group-prefixed-name group method))))
+ (gnus-sethash
+ group
+ (list t nil (list group gnus-level-default-subscribed nil nil
+ (append method
+ (list
+ (list 'quit-config
+ (if quit-config quit-config
+ (cons (current-buffer) 'summary)))))))
+ gnus-newsrc-hashtb)
+ (set-buffer gnus-group-buffer)
+ (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)
+ (quit nil))
+ (not (equal major-mode 'gnus-group-mode))))
+
(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)
"Add the current group to a virtual group."
(interactive
(list current-prefix-arg
- (completing-read "Add to virtual group: " gnus-newsrc-hashtb nil t)))
+ (completing-read "Add to virtual group: " gnus-newsrc-hashtb nil t
+ "nnvirtual:")))
(or (eq (car (gnus-find-method-for-group vgroup)) 'nnvirtual)
(error "%s is not an nnvirtual group" vgroup))
(let* ((groups (gnus-group-process-prefix n))
(lambda (s)
(gnus-group-remove-mark s)
(concat "\\(^" (regexp-quote s) "$\\)"))
- groups "\\|")))))
+ groups "\\|"))))
+ (gnus-group-position-cursor))
+
+(defun gnus-group-make-empty-virtual (group)
+ "Create a new, fresh, empty virtual group."
+ (interactive "sCreate new, empty virtual group: ")
+ (let* ((method (list 'nnvirtual "^$"))
+ (pgroup (gnus-group-prefixed-name group method)))
+ ;; Check whether it exists already.
+ (and (gnus-gethash pgroup gnus-newsrc-hashtb)
+ (error "Group %s already exists." pgroup))
+ ;; Subscribe the new group after the group on the current line.
+ (gnus-subscribe-group pgroup (gnus-group-group-name) method)
+ (gnus-group-update-group pgroup)
+ (forward-line -1)
+ (gnus-group-position-cursor)))
+
+(defun gnus-group-enter-directory (dir)
+ "Enter an ephemeral nneething group."
+ (interactive "DDirectory to read: ")
+ (let* ((method (list 'nneething dir))
+ (leaf (gnus-group-prefixed-name
+ (file-name-nondirectory (directory-file-name dir))
+ method))
+ (name (gnus-generate-new-group-name leaf)))
+ (let ((nneething-read-only t))
+ (or (gnus-group-read-ephemeral-group
+ name method t
+ (cons (current-buffer) (if (eq major-mode 'gnus-summary-mode)
+ 'summary 'group)))
+ (error "Couldn't enter %s" dir)))))
;; Group sorting commands
;; Suggested by Joe Hildebrand <hildjj@idaho.fuentez.com>.
(setq gnus-newsrc-alist
(sort (cdr gnus-newsrc-alist) gnus-group-sort-function))
(gnus-make-hashtable-from-newsrc-alist)
- (gnus-get-unread-articles (1+ gnus-level-subscribed))
- (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)
+ &n
projects / gnus / blobdiff