(eval '(run-hooks 'gnus-load-hook))
-(require 'mail-utils)
-(require 'timezone)
+(require 'custom)
+
+(defgroup gnus nil
+ "The coffee-brewing, all singing, all dancing, kitchen sink newsreader."
+ :group 'emacs)
+
+(defgroup gnus-start nil
+ "Starting your favorite newsreader."
+ :group 'gnus)
+
+(defgroup gnus-score nil
+ "Score and kill file handling."
+ :group 'gnus )
+
+(defconst gnus-version-number "0.55"
+ "Version number for this version of Gnus.")
+
+(defconst gnus-version (format "Red Gnus v%s" gnus-version-number)
+ "Version string for this version of Gnus.")
+
+(defcustom gnus-inhibit-startup-message nil
+ "*If non-nil, the startup message will not be displayed.
+This variable is used before `.gnus.el' is loaded, so it should
+be set in `.emacs' instead."
+ :group 'gnus-start
+ :type 'boolean)
+
+(defcustom gnus-play-startup-jingle nil
+ "If non-nil, play the Gnus jingle at startup."
+ :group 'gnus-start
+ :type 'boolean)
+
+;;; Kludges to help the transition from the old `custom.el'.
+
+;; XEmacs and Emacs 19.29 facep does different things.
+(defalias 'custom-facep
+ (cond ((fboundp 'find-face)
+ 'find-face)
+ ((fboundp 'facep)
+ 'facep)
+ (t
+ 'ignore)))
+
+(when (not (featurep 'gnus-xmas))
+ (progn (defalias 'gnus-make-overlay 'make-overlay)
+ (defalias 'gnus-overlay-put 'overlay-put)
+ (defalias 'gnus-move-overlay 'move-overlay)
+ (defalias 'gnus-overlay-end 'overlay-end)
+ (defalias 'gnus-extent-detached-p 'ignore)
+ (defalias 'gnus-extent-start-open 'ignore)
+ (defalias 'gnus-set-text-properties 'set-text-properties)
+ (defalias 'gnus-group-remove-excess-properties 'ignore)
+ (defalias 'gnus-topic-remove-excess-properties 'ignore)
+ (defalias 'gnus-appt-select-lowest-window 'appt-select-lowest-window)
+ (defalias 'gnus-mail-strip-quoted-names 'mail-strip-quoted-names)
+ (defalias 'gnus-make-local-hook 'make-local-hook)
+ (defalias 'gnus-add-hook 'add-hook)
+ (defalias 'gnus-character-to-event 'identity)
+ (defalias 'gnus-add-text-properties 'add-text-properties)
+ (defalias 'gnus-put-text-property 'put-text-property)
+ (defalias 'gnus-mode-line-buffer-identification 'identity)))
+
+;; The XEmacs people think this is evil, so it must go.
+(defun custom-face-lookup (&optional fg bg stipple bold italic underline)
+ "Lookup or create a face with specified attributes."
+ (let ((name (intern (format "custom-face-%s-%s-%s-%S-%S-%S"
+ (or fg "default")
+ (or bg "default")
+ (or stipple "default")
+ bold italic underline))))
+ (if (and (custom-facep name)
+ (fboundp 'make-face))
+ ()
+ (copy-face 'default name)
+ (when (and fg
+ (not (string-equal fg "default")))
+ (condition-case ()
+ (set-face-foreground name fg)
+ (error nil)))
+ (when (and bg
+ (not (string-equal bg "default")))
+ (condition-case ()
+ (set-face-background name bg)
+ (error nil)))
+ (when (and stipple
+ (not (string-equal stipple "default"))
+ (not (eq stipple 'custom:asis))
+ (fboundp 'set-face-stipple))
+ (set-face-stipple name stipple))
+ (when (and bold
+ (not (eq bold 'custom:asis)))
+ (condition-case ()
+ (make-face-bold name)
+ (error nil)))
+ (when (and italic
+ (not (eq italic 'custom:asis)))
+ (condition-case ()
+ (make-face-italic name)
+ (error nil)))
+ (when (and underline
+ (not (eq underline 'custom:asis)))
+ (condition-case ()
+ (set-face-underline-p name t)
+ (error nil))))
+ name))
+
+;;; Internal variables
+
+(defvar gnus-group-buffer "*Group*")
+
+(eval-and-compile
+ (autoload 'gnus-play-jingle "gnus-audio"))
+
+;;; Splash screen.
+
+(defface gnus-splash-face
+ '((((class color)
+ (background dark))
+ (:foreground "red"))
+ (((class color)
+ (background light))
+ (:foreground "red"))
+ (t
+ ()))
+ "Level 1 newsgroup face.")
+
+(defun gnus-splash ()
+ (save-excursion
+ (switch-to-buffer gnus-group-buffer)
+ (let ((buffer-read-only nil))
+ (erase-buffer)
+ (unless gnus-inhibit-startup-message
+ (gnus-group-startup-message)
+ (sit-for 0)
+ (when gnus-play-startup-jingle
+ (gnus-play-jingle))))))
+
+(defun gnus-indent-rigidly (start end arg)
+ "Indent rigidly using only spaces and no tabs."
+ (save-excursion
+ (save-restriction
+ (narrow-to-region start end)
+ (indent-rigidly start end arg)
+ ;; We translate tabs into spaces -- not everybody uses
+ ;; an 8-character tab.
+ (goto-char (point-min))
+ (while (search-forward "\t" nil t)
+ (replace-match " " t t)))))
+
+(defun gnus-group-startup-message (&optional x y)
+ "Insert startup message in current buffer."
+ ;; Insert the message.
+ (erase-buffer)
+ (insert
+ (format " %s
+ _ ___ _ _
+ _ ___ __ ___ __ _ ___
+ __ _ ___ __ ___
+ _ ___ _
+ _ _ __ _
+ ___ __ _
+ __ _
+ _ _ _
+ _ _ _
+ _ _ _
+ __ ___
+ _ _ _ _
+ _ _
+ _ _
+ _ _
+ _
+ __
+
+"
+ ""))
+ ;; And then hack it.
+ (gnus-indent-rigidly (point-min) (point-max)
+ (/ (max (- (window-width) (or x 46)) 0) 2))
+ (goto-char (point-min))
+ (forward-line 1)
+ (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.
+ (put-text-property (point-min) (point-max) 'face 'gnus-splash-face)
+ (goto-char (point-min))
+ (setq mode-line-buffer-identification gnus-version)
+ (set-buffer-modified-p t))
+
+(eval-when (load)
+ (let ((command (format "%s" this-command)))
+ (when (and (string-match "gnus" command)
+ (not (string-match "gnus-other-frame" command)))
+ (gnus-splash))))
+
+;;; Do the rest.
+
+(require 'custom)
+(require 'gnus-util)
(require 'nnheader)
-(require 'message)
-(eval-when-compile (require 'cl))
+(defcustom gnus-directory (or (getenv "SAVEDIR") "~/News/")
+ "*Directory variable from which all other Gnus file variables are derived."
+ :group 'gnus-start
+ :type 'directory)
-(defvar gnus-directory (or (getenv "SAVEDIR") "~/News/")
- "*Directory variable from which all other Gnus file variables are derived.")
+(defcustom gnus-default-directory nil
+ "*Default directory for all Gnus buffers."
+ :group 'gnus-start
+ :type 'directory)
;; Site dependent variables. These variables should be defined in
;; paths.el.
If you want to change servers, you should use `gnus-select-method'.
See the documentation to that variable.")
-(defvar gnus-backup-default-subscribed-newsgroups
- '("news.announce.newusers" "news.groups.questions" "gnu.emacs.gnus")
- "Default default new newsgroups the first time Gnus is run.
-Should be set in paths.el, and shouldn't be touched by the user.")
-
-(defvar gnus-local-domain nil
- "Local domain name without a host name.
-The DOMAINNAME environment variable is used instead if it is defined.
-If the `system-name' function returns the full Internet name, there is
-no need to set this variable.")
-
-(defvar gnus-local-organization nil
- "String with a description of what organization (if any) the user belongs to.
-The ORGANIZATION environment variable is used instead if it is defined.
-If this variable contains a function, this function will be called
-with the current newsgroup name as the argument. The function should
-return a string.
-
-In any case, if the string (either in the variable, in the environment
-variable, or returned by the function) is a file name, the contents of
-this file will be used as the organization.")
-
-;; Customization variables
-
;; Don't touch this variable.
(defvar gnus-nntp-service "nntp"
"*NNTP service name (\"nntp\" or 119).
name)
(kill-buffer (current-buffer))))))))
-(defvar gnus-select-method
+(defcustom gnus-select-method
(nconc
(list 'nntp (or (condition-case ()
(gnus-getenv-nntpserver)
(error nil))
- (if (and gnus-default-nntp-server
- (not (string= gnus-default-nntp-server "")))
- gnus-default-nntp-server)
+ (when (and gnus-default-nntp-server
+ (not (string= gnus-default-nntp-server "")))
+ gnus-default-nntp-server)
(system-name)))
(if (or (null gnus-nntp-service)
(equal gnus-nntp-service "nntp"))
see the manual for details.")
(defvar gnus-message-archive-method
- '(nnfolder
+ `(nnfolder
"archive"
- (nnfolder-directory (nnheader-concat message-directory "archive"))
- (nnfolder-active-file (nnheader-concat message-directory "archive/active"))
+ (nnfolder-directory ,(nnheader-concat message-directory "archive"))
+ (nnfolder-active-file
+ ,(nnheader-concat message-directory "archive/active"))
(nnfolder-get-new-mail nil)
(nnfolder-inhibit-expiry t))
"*Method used for archiving messages you've sent.
-This should be a mail method.")
+This should be a mail method.
-(defvar gnus-refer-article-method nil
- "*Preferred method for fetching an article by Message-ID.
-If you are reading news from the local spool (with nnspool), fetching
-articles by Message-ID is painfully slow. By setting this method to an
-nntp method, you might get acceptable results.
+It's probably not a very effective to change this variable once you've
+run Gnus once. After doing that, you must edit this server from the
+server buffer.")
-The value of this variable must be a valid select method as discussed
-in the documentation of `gnus-select-method'.")
+(defvar gnus-message-archive-group nil
+ "*Name of the group in which to save the messages you've written.
+This can either be a string, a list of strings; or an alist
+of regexps/functions/forms to be evaluated to return a string (or a list
+of strings). The functions are called with the name of the current
+group (or nil) as a parameter.
-(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 method (see
-`gnus-select-method').
+If you want to save your mail in one group and the news articles you
+write in another group, you could say something like:
-If, for instance, you want to read your mail with the nnml backend,
-you could set this variable:
+ \(setq gnus-message-archive-group
+ '((if (message-news-p)
+ \"misc-news\"
+ \"misc-mail\")))
-(setq gnus-secondary-select-methods '((nnml \"\")))")
+Normally the group names returned by this variable should be
+unprefixed -- which implicitly means \"store on the archive server\".
+However, you may wish to store the message on some other server. In
+that case, just return a fully prefixed name of the group --
+\"nnml+private:mail.misc\", for instance.")
(defvar gnus-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-startup-file "~/.newsrc"
- "*Your `.newsrc' file.
-`.newsrc-SERVER' will be used instead if that exists.")
+(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 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 \"\")))")
+
+(defvar gnus-backup-default-subscribed-newsgroups
+ '("news.announce.newusers" "news.groups.questions" "gnu.emacs.gnus")
+ "Default default new newsgroups the first time Gnus is run.
+Should be set in paths.el, and shouldn't be touched by the user.")
+
+(defvar gnus-local-domain nil
+ "Local domain name without a host name.
+The DOMAINNAME environment variable is used instead if it is defined.
+If the `system-name' function returns the full Internet name, there is
+no need to set this variable.")
+
+(defvar gnus-local-organization nil
+ "String with a description of what organization (if any) the user belongs to.
+The ORGANIZATION environment variable is used instead if it is defined.
+If this variable contains a function, this function will be called
+with the current newsgroup name as the argument. The function should
+return a string.
+
+In any case, if the string (either in the variable, in the environment
+variable, or returned by the function) is a file name, the contents of
+this file will be used as the organization.")
+
+;; Customization variables
+
+(defvar gnus-refer-article-method nil
+ "*Preferred method for fetching an article by Message-ID.
+If you are reading news from the local spool (with nnspool), fetching
+articles by Message-ID is painfully slow. By setting this method to an
+nntp method, you might get acceptable results.
-(defvar gnus-init-file "~/.gnus"
- "*Your Gnus elisp startup file.
-If a file with the .el or .elc suffixes exist, it will be read
-instead.")
+The value of this variable must be a valid select method as discussed
+in the documentation of `gnus-select-method'.")
(defvar gnus-group-faq-directory
'("/ftp@mirrors.aol.com:/pub/rtfm/usenet/"
"/ftp@sunsite.auc.dk:/pub/usenet/"
+ "/ftp@sunsite.doc.ic.ac.uk:/pub/usenet/news-faqs/"
"/ftp@src.doc.ic.ac.uk:/usenet/news-FAQS/"
"/ftp@ftp.seas.gwu.edu:/pub/rtfm/"
"/ftp@rtfm.mit.edu:/pub/usenet/"
fetched by ange-ftp.
This variable can also be a list of directories. In that case, the
-first element in the list will be used by default, and the others will
-be used as backup sites.
+first element in the list will be used by default. The others can
+be used when being prompted for a site.
Note that Gnus uses an aol machine as the default directory. If this
feels fundamentally unclean, just think of it as a way to finally get
hwarang.postech.ac.kr /pub/usenet
ftp.hk.super.net /mirror/faqs")
-(defvar gnus-group-archive-directory
- "/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 it is `t', Gnus will not do anything special the first time it is
-started; it'll just use the normal newsgroups subscription methods.")
-
(defvar gnus-use-cross-reference t
"*Non-nil means that cross referenced articles will be marked as read.
If nil, ignore cross references. If t, mark articles as read in
subscribed newsgroups. If neither t nor nil, mark as read in all
newsgroups.")
-(defvar gnus-single-article-buffer t
- "*If non-nil, display all articles in the same buffer.
-If nil, each group will get its own article buffer.")
-
-(defvar gnus-use-dribble-file t
- "*Non-nil means that Gnus will use a dribble file to store user updates.
-If Emacs should crash without saving the .newsrc files, complete
-information can be restored from the dribble file.")
-
-(defvar gnus-dribble-directory nil
- "*The directory where dribble files will be saved.
-If this variable is nil, the directory where the .newsrc files are
-saved will be used.")
+(defvar gnus-process-mark ?#
+ "*Process mark.")
(defvar gnus-asynchronous nil
"*If non-nil, Gnus will supply backends with data needed for async article fetching.")
-(defvar gnus-kill-summary-on-exit t
- "*If non-nil, kill the summary buffer when you exit from it.
-If nil, the summary will become a \"*Dead Summary*\" buffer, and
-it will be killed sometime later.")
-
(defvar gnus-large-newsgroup 200
"*The number of articles which indicates a large newsgroup.
If the number of articles in a newsgroup is greater than this value,
confirmation is required for selecting the newsgroup.")
-;; Suggested by Andrew Eskilsson <pi92ae@lelle.pt.hk-r.se>.
-(defvar gnus-no-groups-message "No news is horrible news"
- "*Message displayed by Gnus when no groups are available.")
-
(defvar gnus-use-long-file-name (not (memq system-type '(usg-unix-v xenix)))
"*Non-nil means that the default name of a file to save articles in is the group name.
If it's nil, the directory form of the group name is used instead.
`not-score', long file names will not be used for score files; if it
contains the element `not-save', long file names will not be used for
saving; and if it contains the element `not-kill', long file names
-will not be used for kill files.")
+will not be used for kill files.
-(defvar gnus-article-save-directory gnus-directory
- "*Name of the directory articles will be saved in (default \"~/News\").")
+Note that the default for this variable varies according to what system
+type you're using. On `usg-unix-v' and `xenix' this variable defaults
+to nil while on all other systems it defaults to t.")
(defvar gnus-kill-files-directory gnus-directory
"*Name of the directory where kill files will be stored (default \"~/News\").")
-(defvar gnus-default-article-saver 'gnus-summary-save-in-rmail
- "*A function to save articles in your favorite format.
-The function must be interactively callable (in other words, it must
-be an Emacs command).
-
-Gnus provides the following functions:
-
-* gnus-summary-save-in-rmail (Rmail format)
-* gnus-summary-save-in-mail (Unix mail format)
-* gnus-summary-save-in-folder (MH folder)
-* gnus-summary-save-in-file (article format).
-* gnus-summary-save-in-vm (use VM's folder format).")
-
-(defvar gnus-prompt-before-saving 'always
- "*This variable says how much prompting is to be done when saving articles.
-If it is nil, no prompting will be done, and the articles will be
-saved to the default files. If this variable is `always', each and
-every article that is saved will be preceded by a prompt, even when
-saving large batches of articles. If this variable is neither nil not
-`always', there the user will be prompted once for a file name for
-each invocation of the saving commands.")
-
-(defvar gnus-rmail-save-name (function gnus-plain-save-name)
- "*A function generating a file name to save articles in Rmail format.
-The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE.")
-
-(defvar gnus-mail-save-name (function gnus-plain-save-name)
- "*A function generating a file name to save articles in Unix mail format.
-The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE.")
-
-(defvar gnus-folder-save-name (function gnus-folder-save-name)
- "*A function generating a file name to save articles in MH folder.
-The function is called with NEWSGROUP, HEADERS, and optional LAST-FOLDER.")
-
-(defvar gnus-file-save-name (function gnus-numeric-save-name)
- "*A function generating a file name to save articles in article format.
-The function is called with NEWSGROUP, HEADERS, and optional
-LAST-FILE.")
-
-(defvar gnus-split-methods
- '((gnus-article-archive-name))
- "*Variable used to suggest where articles are to be saved.
-For instance, if you would like to save articles related to Gnus in
-the file \"gnus-stuff\", and articles related to VM in \"vm-stuff\",
-you could set this variable to something like:
-
- '((\"^Subject:.*gnus\\|^Newsgroups:.*gnus\" \"gnus-stuff\")
- (\"^Subject:.*vm\\|^Xref:.*vm\" \"vm-stuff\"))
-
-This variable is an alist where the where the key is the match and the
-value is a list of possible files to save in if the match is non-nil.
-
-If the match is a string, it is used as a regexp match on the
-article. If the match is a symbol, that symbol will be funcalled
-from the buffer of the article to be saved with the newsgroup as the
-parameter. If it is a list, it will be evaled in the same buffer.
-
-If this form or function returns a string, this string will be used as
-a possible file name; and if it returns a non-nil list, that list will
-be used as possible file names.")
-
-(defvar gnus-move-split-methods nil
- "*Variable used to suggest where articles are to be moved to.
-It uses the same syntax as the `gnus-split-methods' variable.")
-
(defvar gnus-save-score nil
"*If non-nil, save group scoring info.")
+(defvar gnus-use-undo t
+ "*If non-nil, allow undoing in Gnus group mode buffers.")
+
(defvar gnus-use-adaptive-scoring nil
- "*If non-nil, use some adaptive scoring scheme.")
+ "*If non-nil, use some adaptive scoring scheme.
+If a list, then the values `word' and `line' are meaningful. The
+former will perform adaption on individual words in the subject
+header while `line' will perform adaption on several headers.")
-(defvar gnus-use-cache nil
+(defvar gnus-use-cache 'passive
"*If nil, Gnus will ignore the article cache.
If `passive', it will allow entering (and reading) articles
explicitly entered into the cache. If anything else, use the
(defvar gnus-use-nocem nil
"*If non-nil, Gnus will read NoCeM cancel messages.")
+(defvar gnus-suppress-duplicates nil
+ "*If non-nil, Gnus will mark duplicate copies of the same article as read.")
+
(defvar gnus-use-demon nil
"If non-nil, Gnus might use some demons.")
(defvar gnus-use-picons nil
"*If non-nil, display picons.")
-(defvar gnus-fetch-old-headers nil
- "*Non-nil means that Gnus will try to build threads by grabbing old headers.
-If an unread article in the group refers to an older, already read (or
-just marked as read) article, the old article will not normally be
-displayed in the Summary buffer. If this variable is non-nil, Gnus
-will attempt to grab the headers to the old articles, and thereby
-build complete threads. If it has the value `some', only enough
-headers to connect otherwise loose threads will be displayed.
-This variable can also be a number. In that case, no more than that
-number of old headers will be fetched.
-
-The server has to support NOV for any of this to work.")
-
-;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-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)
(defvar gnus-novice-user t
"*Non-nil means that you are a usenet novice.
"*Non-nil means that you will never be asked for confirmation about anything.
And that means *anything*.")
-(defvar gnus-verbose 7
- "*Integer that says how verbose Gnus should be.
-The higher the number, the more messages Gnus will flash to say what
-it's doing. At zero, Gnus will be totally mute; at five, Gnus will
-display most important messages; and at ten, Gnus will keep on
-jabbering all the time.")
-
-(defvar gnus-keep-same-level nil
- "*Non-nil means that the next newsgroup after the current will be on the same level.
-When you type, for instance, `n' after reading the last article in the
-current newsgroup, you will go to the next newsgroup. If this variable
-is nil, the next newsgroup will be the next from the group
-buffer.
-If this variable is non-nil, Gnus will either put you in the
-next newsgroup with the same level, or, if no such newsgroup is
-available, the next newsgroup with the lowest possible level higher
-than the current level.
-If this variable is `best', Gnus will make the next newsgroup the one
-with the best level.")
-
-(defvar gnus-summary-make-false-root 'adopt
- "*nil means that Gnus won't gather loose threads.
-If the root of a thread has expired or been read in a previous
-session, the information necessary to build a complete thread has been
-lost. Instead of having many small sub-threads from this original thread
-scattered all over the summary buffer, Gnus can gather them.
-
-If non-nil, Gnus will try to gather all loose sub-threads from an
-original thread into one large thread.
-
-If this variable is non-nil, it should be one of `none', `adopt',
-`dummy' or `empty'.
-
-If this variable is `none', Gnus will not make a false root, but just
-present the sub-threads after another.
-If this variable is `dummy', Gnus will create a dummy root that will
-have all the sub-threads as children.
-If this variable is `adopt', Gnus will make one of the \"children\"
-the parent and mark all the step-children as such.
-If this variable is `empty', the \"children\" are printed with empty
-subject fields. (Or rather, they will be printed with a string
-given by the `gnus-summary-same-subject' variable.)")
-
-(defvar gnus-summary-gather-exclude-subject "^ *$\\|^(none)$"
- "*A regexp to match subjects to be excluded from loose thread gathering.
-As loose thread gathering is done on subjects only, that means that
-there can be many false gatherings performed. By rooting out certain
-common subjects, gathering might become saner.")
-
-(defvar gnus-summary-gather-subject-limit nil
- "*Maximum length of subject comparisons when gathering loose threads.
-Use nil to compare full subjects. Setting this variable to a low
-number will help gather threads that have been corrupted by
-newsreaders chopping off subject lines, but it might also mean that
-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 algorithm when
-comparing subjects.")
-
-(defvar gnus-simplify-ignored-prefixes nil
- "*Regexp, matches for which are removed from subject lines when simplifying.")
-
-(defvar gnus-build-sparse-threads nil
- "*If non-nil, fill in the gaps in threads.
-If `some', only fill in the gaps that are needed to tie loose threads
-together. If `more', fill in all leaf nodes that Gnus can find. If
-non-nil and non-`some', fill in all gaps that Gnus manages to guess.")
-
-(defvar gnus-summary-thread-gathering-function 'gnus-gather-threads-by-subject
- "Function used for gathering loose threads.
-There are two pre-defined functions: `gnus-gather-threads-by-subject',
-which only takes Subjects into consideration; and
-`gnus-gather-threads-by-references', which compared the References
-headers of the articles to find matches.")
-
-;; Added by Per Abrahamsen <amanda@iesd.auc.dk>.
-(defvar gnus-summary-same-subject ""
- "*String indicating that the current article has the same subject as the previous.
-This variable will only be used if the value of
-`gnus-summary-make-false-root' is `empty'.")
-
-(defvar gnus-summary-goto-unread t
- "*If non-nil, marking commands will go to the next unread article.
-If `never', \\<gnus-summary-mode-map>\\[gnus-summary-next-page] will go to the next article,
-whether it is read or not.")
-
-(defvar gnus-group-goto-unread t
- "*If non-nil, movement commands will go to the next unread and subscribed group.")
-
-(defvar gnus-goto-next-group-when-activating t
- "*If non-nil, the \\<gnus-group-mode-map>\\[gnus-group-get-new-news-this-group] command will advance point to the next group.")
-
-(defvar gnus-check-new-newsgroups t
- "*Non-nil means that Gnus will add new newsgroups at startup.
-If this variable is `ask-server', Gnus will ask the server for new
-groups since the last time it checked. This means that the killed list
-is no longer necessary, so you could set `gnus-save-killed-list' to
-nil.
-
-A variant is to have this variable be a list of select methods. Gnus
-will then use the `ask-server' method on all these select methods to
-query for new groups from all those servers.
-
-Eg.
- (setq gnus-check-new-newsgroups
- '((nntp \"some.server\") (nntp \"other.server\")))
-
-If this variable is nil, then you have to tell Gnus explicitly to
-check for new newsgroups with \\<gnus-group-mode-map>\\[gnus-find-new-newsgroups].")
-
-(defvar gnus-check-bogus-newsgroups nil
- "*Non-nil means that Gnus will check and remove bogus newsgroup at startup.
-If this variable is nil, then you have to tell Gnus explicitly to
-check for bogus newsgroups with \\<gnus-group-mode-map>\\[gnus-group-check-bogus-groups].")
-
-(defvar gnus-read-active-file t
- "*Non-nil means that Gnus will read the entire active file at startup.
-If this variable is nil, Gnus will only know about the groups in your
-`.newsrc' file.
-
-If this variable is `some', Gnus will try to only read the relevant
-parts of the active file from the server. Not all servers support
-this, and it might be quite slow with other servers, but this should
-generally be faster than both the t and nil value.
-
-If you set this variable to nil or `some', you probably still want to
-be told about new newsgroups that arrive. To do that, set
-`gnus-check-new-newsgroups' to `ask-server'. This may not work
-properly with all servers.")
-
-(defvar gnus-level-subscribed 5
- "*Groups with levels less than or equal to this variable are subscribed.")
-
-(defvar gnus-level-unsubscribed 7
- "*Groups with levels less than or equal to this variable are unsubscribed.
-Groups with levels less than `gnus-level-subscribed', which should be
-less than this variable, are subscribed.")
-
-(defvar gnus-level-zombie 8
- "*Groups with this level are zombie groups.")
-
-(defvar gnus-level-killed 9
- "*Groups with this level are killed.")
-
-(defvar gnus-level-default-subscribed 3
- "*New subscribed groups will be subscribed at this level.")
-
-(defvar gnus-level-default-unsubscribed 6
- "*New unsubscribed groups will be unsubscribed at this level.")
-
-(defvar gnus-activate-level (1+ gnus-level-subscribed)
- "*Groups higher than this level won't be activated on startup.
-Setting this variable to something log might save lots of time when
-you have many groups that you aren't interested in.")
-
-(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
-activated on startup. For instance, if you want to active all
-subscribed newsgroups, but not the rest, you'd set this variable to
-`gnus-level-subscribed'.
-
-If you subscribe to lots of newsgroups from different servers, startup
-might take a while. By setting this variable to nil, you'll save time,
-but you won't be told how many unread articles there are in the
-groups.")
-
-(defvar gnus-save-newsrc-file t
- "*Non-nil means that Gnus will save the `.newsrc' file.
-Gnus always saves its own startup file, which is called
-\".newsrc.eld\". The file called \".newsrc\" is in a format that can
-be readily understood by other newsreaders. If you don't plan on
-using other newsreaders, set this variable to nil to save some time on
-exit.")
-
-(defvar gnus-save-killed-list t
- "*If non-nil, save the list of killed groups to the startup file.
-If you set this variable to nil, you'll save both time (when starting
-and quitting) and space (both memory and disk), but it will also mean
-that Gnus has no record of which groups are new and which are old, so
-the automatic new newsgroups subscription methods become meaningless.
-
-You should always set `gnus-check-new-newsgroups' to `ask-server' or
-nil if you set this variable to nil.")
-
(defvar gnus-interactive-catchup t
"*If non-nil, require your confirmation when catching up a group.")
(defvar gnus-interactive-exit t
"*If non-nil, require your confirmation when exiting Gnus.")
-(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
-of time.")
-
(defvar gnus-extract-address-components 'gnus-extract-address-components
"*Function for extracting address components from a From header.
Two pre-defined function exist: `gnus-extract-address-components',
`mail-extract-address-components', which works much better, but is
slower.")
-(defvar gnus-summary-default-score 0
- "*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
- "*Strings to be removed when doing fuzzy matches.
-This can either be a regular expression or list of regular expressions
-that will be removed from subject strings if fuzzy subject
-simplification is selected.")
-
-(defvar gnus-permanently-visible-groups nil
- "*Regexp to match groups that should always be listed in the group buffer.
-This means that they will still be listed when there are no unread
-articles in the groups.")
-
-(defvar gnus-list-groups-with-ticked-articles t
- "*If non-nil, list groups that have only ticked articles.
-If nil, only list groups that have unread articles.")
-
-(defvar gnus-group-default-list-level gnus-level-subscribed
- "*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-group-list-inactive-groups t
- "*If non-nil, inactive groups will be listed.")
-
-(defvar gnus-show-mime nil
- "*If non-nil, do mime processing of articles.
-The articles will simply be fed to the function given by
-`gnus-show-mime-method'.")
-
-(defvar gnus-strict-mime t
- "*If nil, MIME-decode even if there is no Mime-Version header in the article.")
-
-(defvar gnus-show-mime-method 'metamail-buffer
- "*Function to process a MIME message.
-The function is called from the article buffer.")
-
-(defvar gnus-decode-encoded-word-method (lambda ())
- "*Function to decode a MIME encoded-words.
-The function is called from the article buffer.")
-
-(defvar gnus-show-threads t
- "*If non-nil, display threads in summary mode.")
-
-(defvar gnus-thread-hide-subtree nil
- "*If non-nil, hide all threads initially.
-If threads are hidden, you have to run the command
-`gnus-summary-show-thread' by hand or use `gnus-select-article-hook'
-to expose hidden threads.")
-
-(defvar gnus-thread-hide-killed t
- "*If non-nil, hide killed threads automatically.")
-
-(defvar gnus-thread-ignore-subject nil
- "*If non-nil, ignore subjects and do all threading based on the Reference header.
-If nil, which is the default, articles that have different subjects
-from their parents will start separate threads.")
-
-(defvar gnus-thread-operation-ignore-subject t
- "*If non-nil, subjects will be ignored when doing thread commands.
-This affects commands like `gnus-summary-kill-thread' and
-`gnus-summary-lower-thread'.
-
-If this variable is nil, articles in the same thread with different
-subjects will not be included in the operation in question. If this
-variable is `fuzzy', only articles that have subjects that are fuzzily
-equal will be included.")
-
-(defvar gnus-thread-indent-level 4
- "*Number that says how much each sub-thread should be indented.")
-
-(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-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.
-This variable can also be a list of regexps of headers to be ignored.
-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:\\|^Posted-To:\\|^Mail-Copies-To:\\|^Apparently-To:\\|^Gnus-Warning:\\|^Resent-"
- "*All headers that do not match this regexp will be hidden.
-This variable can also be a list of regexp of headers to remain visible.
-If this variable is non-nil, `gnus-ignored-headers' will be ignored.")
-
-(defvar gnus-sorted-header-list
- '("^From:" "^Subject:" "^Summary:" "^Keywords:" "^Newsgroups:" "^To:"
- "^Cc:" "^Date:" "^Organization:")
- "*This variable is a list of regular expressions.
-If it is non-nil, headers that match the regular expressions will
-be placed first in the article buffer in the sequence specified by
-this list.")
-
-(defvar gnus-boring-article-headers
- '(empty followup-to reply-to)
- "*Headers that are only to be displayed if they have interesting data.
-Possible values in this list are `empty', `newsgroups', `followup-to',
-`reply-to', and `date'.")
-
-(defvar gnus-show-all-headers nil
- "*If non-nil, don't hide any headers.")
-
-(defvar gnus-save-all-headers t
- "*If non-nil, don't remove any headers before saving.")
-
-(defvar gnus-saved-headers gnus-visible-headers
- "*Headers to keep if `gnus-save-all-headers' is nil.
-If `gnus-save-all-headers' is non-nil, this variable will be ignored.
-If that variable is nil, however, all headers that match this regexp
-will be kept while the rest will be deleted before saving.")
-
-(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-signature-limit nil
- "Provide a limit to what is considered a signature.
-If it is a number, no signature may not be longer (in characters) than
-that number. If it is a function, the function will be called without
-any parameters, and if it returns nil, there is no signature in the
-buffer. If it is a string, it will be used as a regexp. If it
-matches, the text in question is not a signature.")
-
-(defvar gnus-auto-extend-newsgroup t
- "*If non-nil, extend newsgroup forward and backward when requested.")
-
-(defvar gnus-auto-select-first t
- "*If nil, don't select the first unread article when entering a group.
-If this variable is `best', select the highest-scored unread article
-in the group. If neither nil nor `best', select the first unread
-article.
-
-If you want to prevent automatic selection of the first unread article
-in some newsgroups, set the variable to nil in
-`gnus-select-group-hook'.")
-
-(defvar gnus-auto-select-next t
- "*If non-nil, offer to go to the next group from the end of the previous.
-If the value is t and the next newsgroup is empty, Gnus will exit
-summary mode and go back to group mode. If the value is neither nil
-nor t, Gnus will select the following unread newsgroup. In
-particular, if the value is the symbol `quietly', the next unread
-newsgroup will be selected without any confirmation, and if it is
-`almost-quietly', the next group will be selected without any
-confirmation if you are located on the last article in the group.
-Finally, if this variable is `slightly-quietly', the `Z n' command
-will go to the next group without confirmation.")
-
-(defvar gnus-auto-select-same nil
- "*If non-nil, select the next article with the same subject.")
-
-(defvar gnus-summary-check-current nil
- "*If non-nil, consider the current article when moving.
-The \"unread\" movement commands will stay on the same line if the
-current article is unread.")
-
-(defvar gnus-auto-center-summary t
- "*If non-nil, always center the current summary buffer.
-In particular, if `vertical' do only vertical recentering. If non-nil
-and non-`vertical', do both horizontal and vertical recentering.")
-
-(defvar gnus-break-pages t
- "*If non-nil, do page breaking on articles.
-The page delimiter is specified by the `gnus-page-delimiter'
-variable.")
-
-(defvar gnus-page-delimiter "^\^L"
- "*Regexp describing what to use as article page delimiters.
-The default value is \"^\^L\", which is a form linefeed at the
-beginning of a line.")
-
-(defvar gnus-use-full-window t
- "*If non-nil, use the entire Emacs screen.")
-
-(defvar gnus-window-configuration nil
- "Obsolete variable. See `gnus-buffer-configuration'.")
-
-(defvar gnus-window-min-width 2
- "*Minimum width of Gnus buffers.")
-
-(defvar gnus-window-min-height 1
- "*Minimum height of Gnus buffers.")
-
-(defvar gnus-buffer-configuration
- '((group
- (vertical 1.0
- (group 1.0 point)
- (if gnus-carpal '(group-carpal 4))))
- (summary
- (vertical 1.0
- (summary 1.0 point)
- (if gnus-carpal '(summary-carpal 4))))
- (article
- (cond
- (gnus-use-picons
- '(frame 1.0
- (vertical 1.0
- (summary 0.25 point)
- (if gnus-carpal '(summary-carpal 4))
- (article 1.0))
- (vertical ((height . 5) (width . 15)
- (user-position . t)
- (left . -1) (top . 1))
- (picons 1.0))))
- (gnus-use-trees
- '(vertical 1.0
- (summary 0.25 point)
- (tree 0.25)
- (article 1.0)))
- (t
- '(vertical 1.0
- (summary 0.25 point)
- (if gnus-carpal '(summary-carpal 4))
- (if gnus-use-trees '(tree 0.25))
- (article 1.0)))))
- (server
- (vertical 1.0
- (server 1.0 point)
- (if gnus-carpal '(server-carpal 2))))
- (browse
- (vertical 1.0
- (browse 1.0 point)
- (if gnus-carpal '(browse-carpal 2))))
- (message
- (vertical 1.0
- (message 1.0 point)))
- (pick
- (vertical 1.0
- (article 1.0 point)))
- (info
- (vertical 1.0
- (info 1.0 point)))
- (summary-faq
- (vertical 1.0
- (summary 0.25)
- (faq 1.0 point)))
- (edit-group
- (vertical 1.0
- (group 0.5)
- (edit-group 1.0 point)))
- (edit-server
- (vertical 1.0
- (server 0.5)
- (edit-server 1.0 point)))
- (edit-score
- (vertical 1.0
- (summary 0.25)
- (edit-score 1.0 point)))
- (post
- (vertical 1.0
- (post 1.0 point)))
- (reply
- (vertical 1.0
- (article-copy 0.5)
- (message 1.0 point)))
- (forward
- (vertical 1.0
- (message 1.0 point)))
- (reply-yank
- (vertical 1.0
- (message 1.0 point)))
- (mail-bounce
- (vertical 1.0
- (article 0.5)
- (message 1.0 point)))
- (draft
- (vertical 1.0
- (draft 1.0 point)))
- (pipe
- (vertical 1.0
- (summary 0.25 point)
- (if gnus-carpal '(summary-carpal 4))
- ("*Shell Command Output*" 1.0)))
- (bug
- (vertical 1.0
- ("*Gnus Help Bug*" 0.5)
- ("*Gnus Bug*" 1.0 point)))
- (compose-bounce
- (vertical 1.0
- (article 0.5)
- (message 1.0 point))))
- "Window configuration for all possible Gnus buffers.
-This variable is a list of lists. Each of these lists has a NAME and
-a RULE. The NAMEs are commonsense names like `group', which names a
-rule used when displaying the group buffer; `summary', which names a
-rule for what happens when you enter a group and do not display an
-article buffer; and so on. See the value of this variable for a
-complete list of NAMEs.
-
-Each RULE is a list of vectors. The first element in this vector is
-the name of the buffer to be displayed; the second element is the
-percentage of the screen this buffer is to occupy (a number in the
-0.0-0.99 range); the optional third element is `point', which should
-be present to denote which buffer point is to go to after making this
-buffer configuration.")
-
-(defvar gnus-window-to-buffer
- '((group . gnus-group-buffer)
- (summary . gnus-summary-buffer)
- (article . gnus-article-buffer)
- (server . gnus-server-buffer)
- (browse . "*Gnus Browse Server*")
- (edit-group . gnus-group-edit-buffer)
- (edit-server . gnus-server-edit-buffer)
- (group-carpal . gnus-carpal-group-buffer)
- (summary-carpal . gnus-carpal-summary-buffer)
- (server-carpal . gnus-carpal-server-buffer)
- (browse-carpal . gnus-carpal-browse-buffer)
- (edit-score . gnus-score-edit-buffer)
- (message . gnus-message-buffer)
- (mail . gnus-message-buffer)
- (post-news . gnus-message-buffer)
- (faq . gnus-faq-buffer)
- (picons . "*Picons*")
- (tree . gnus-tree-buffer)
- (info . gnus-info-buffer)
- (article-copy . gnus-article-copy)
- (draft . gnus-draft-buffer))
- "Mapping from short symbols to buffer names or buffer variables.")
-
(defvar gnus-carpal nil
"*If non-nil, display clickable icons.")
-(defvar gnus-subscribe-newsgroup-method 'gnus-subscribe-zombies
- "*Function called with a group name when new group is detected.
-A few pre-made functions are supplied: `gnus-subscribe-randomly'
-inserts new groups at the beginning of the list of groups;
-`gnus-subscribe-alphabetically' inserts new groups in strict
-alphabetic order; `gnus-subscribe-hierarchically' inserts new groups
-in hierarchical newsgroup order; `gnus-subscribe-interactively' asks
-for your decision; `gnus-subscribe-killed' kills all new groups;
-`gnus-subscribe-zombies' will make all new groups into zombies.")
-
-;; Suggested by a bug report by Hallvard B Furuseth.
-;; <h.b.furuseth@usit.uio.no>.
-(defvar gnus-subscribe-options-newsgroup-method
- (function gnus-subscribe-alphabetically)
- "*This function is called to subscribe newsgroups mentioned on \"options -n\" lines.
-If, for instance, you want to subscribe to all newsgroups in the
-\"no\" and \"alt\" hierarchies, you'd put the following in your
-.newsrc file:
-
-options -n no.all alt.all
-
-Gnus will the subscribe all new newsgroups in these hierarchies with
-the subscription method in this variable.")
-
-(defvar gnus-subscribe-hierarchical-interactive nil
- "*If non-nil, Gnus will offer to subscribe hierarchically.
-When a new hierarchy appears, Gnus will ask the user:
-
-'alt.binaries': Do you want to subscribe to this hierarchy? ([d]ys):
-
-If the user pressed `d', Gnus will descend the hierarchy, `y' will
-subscribe to all newsgroups in the hierarchy and `s' will skip this
-hierarchy in its entirety.")
-
-(defvar gnus-group-sort-function 'gnus-group-sort-by-alphabet
- "*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-group-sort-by-alphabet', `gnus-group-sort-by-unread',
-`gnus-group-sort-by-level', `gnus-group-sort-by-score', and
-`gnus-group-sort-by-rank'.
-
-This variable can also be a list of sorting functions. In that case,
-the most significant sort function should be the last function in the
-list.")
-
-;; Mark variables suggested by Thomas Michanek
-;; <Thomas.Michanek@telelogic.se>.
-(defvar gnus-unread-mark ?
- "*Mark used for unread articles.")
-(defvar gnus-ticked-mark ?!
- "*Mark used for ticked articles.")
-(defvar gnus-dormant-mark ??
- "*Mark used for dormant articles.")
-(defvar gnus-del-mark ?r
- "*Mark used for del'd articles.")
-(defvar gnus-read-mark ?R
- "*Mark used for read articles.")
-(defvar gnus-expirable-mark ?E
- "*Mark used for expirable articles.")
-(defvar gnus-killed-mark ?K
- "*Mark used for killed articles.")
-(defvar gnus-souped-mark ?F
- "*Mark used for killed articles.")
-(defvar gnus-kill-file-mark ?X
- "*Mark used for articles killed by kill files.")
-(defvar gnus-low-score-mark ?Y
- "*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 ?A
- "*Mark used for articles that have been replied to.")
-(defvar gnus-cached-mark ?*
- "*Mark used for articles that are in the cache.")
-(defvar gnus-saved-mark ?S
- "*Mark used for articles that have been saved to.")
-(defvar gnus-process-mark ?#
- "*Process mark.")
-(defvar gnus-ancient-mark ?O
- "*Mark used for ancient articles.")
-(defvar gnus-sparse-mark ?Q
- "*Mark used for sparsely reffed articles.")
-(defvar gnus-canceled-mark ?G
- "*Mark used for canceled articles.")
-(defvar gnus-score-over-mark ?+
- "*Score mark used for articles with high scores.")
-(defvar gnus-score-below-mark ?-
- "*Score mark used for articles with low scores.")
-(defvar gnus-empty-thread-mark ?
- "*There is no thread under the article.")
-(defvar gnus-not-empty-thread-mark ?=
- "*There is a thread under the article.")
-
-(defvar gnus-view-pseudo-asynchronously nil
- "*If non-nil, Gnus will view pseudo-articles asynchronously.")
-
-(defvar gnus-view-pseudos nil
- "*If `automatic', pseudo-articles will be viewed automatically.
-If `not-confirm', pseudos will be viewed automatically, and the user
-will not be asked to confirm the command.")
-
-(defvar gnus-view-pseudos-separately t
- "*If non-nil, one pseudo-article will be created for each file to be viewed.
-If nil, all files that use the same viewing command will be given as a
-list of parameters to that command.")
-
-(defvar gnus-insert-pseudo-articles t
- "*If non-nil, insert pseudo-articles when decoding articles.")
-
-(defvar gnus-group-line-format "%M%S%p%P%5y: %(%g%)%l\n"
- "*Format of group lines.
-It works along the same lines as a normal formatting string,
-with some simple extensions.
-
-%M Only marked articles (character, \"*\" or \" \")
-%S Whether the group is subscribed (character, \"U\", \"K\", \"Z\" or \" \")
-%L Level of subscribedness (integer)
-%N Number of unread articles (integer)
-%I Number of dormant articles (integer)
-%i Number of ticked and dormant (integer)
-%T Number of ticked articles (integer)
-%R Number of read articles (integer)
-%t Total number of articles (integer)
-%y Number of unread, unticked articles (integer)
-%G Group name (string)
-%g Qualified group name (string)
-%D Group description (string)
-%s Select method (string)
-%o Moderated group (char, \"m\")
-%p Process mark (char)
-%O Moderated group (string, \"(m)\" or \"\")
-%P Topic indentation (string)
-%l Whether there are GroupLens predictions for this group (string)
-%n Select from where (string)
-%z A string that look like `<%s:%n>' if a foreign select method is used
-%u User defined specifier. The next character in the format string should
- be a letter. Gnus will call the function gnus-user-format-function-X,
- where X is the letter following %u. The function will be passed the
- current header as argument. The function should return a string, which
- will be inserted into the buffer just like information from any other
- group specifier.
-
-Text between %( and %) will be highlighted with `gnus-mouse-face' when
-the mouse point move inside the area. There can only be one such area.
-
-Note that this format specification is not always respected. For
-reasons of efficiency, when listing killed groups, this specification
-is ignored altogether. If the spec is changed considerably, your
-output may end up looking strange when listing both alive and killed
-groups.
-
-If you use %o or %O, reading the active file will be slower and quite
-a bit of extra memory will be used. %D will also worsen performance.
-Also note that if you change the format specification to include any
-of these specs, you must probably re-start Gnus to see them go into
-effect.")
-
-(defvar gnus-summary-line-format "%U%R%z%I%(%[%4L: %-20,20n%]%) %s\n"
- "*The format specification of the lines in the summary buffer.
-
-It works along the same lines as a normal formatting string,
-with some simple extensions.
-
-%N Article number, left padded with spaces (string)
-%S Subject (string)
-%s Subject if it is at the root of a thread, and \"\" otherwise (string)
-%n Name 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)
-%d Date of the article (string) in DD-MMM format
-%M Message-id of the article (string)
-%r References of the article (string)
-%c Number of characters in the article (integer)
-%L Number of lines in the article (integer)
-%I Indentation based on thread level (a string of spaces)
-%T A string with two possible values: 80 spaces if the article
- is on thread level two or larger and 0 spaces on level one
-%R \"A\" if this article has been replied to, \" \" otherwise (character)
-%U Status of this article (character, \"R\", \"K\", \"-\" or \" \")
-%[ Opening bracket (character, \"[\" or \"<\")
-%] Closing bracket (character, \"]\" or \">\")
-%> Spaces of length thread-level (string)
-%< Spaces of length (- 20 thread-level) (string)
-%i Article score (number)
-%z Article zcore (character)
-%t Number of articles under the current thread (number).
-%e Whether the thread is empty or not (character).
-%l GroupLens score (string).
-%u User defined specifier. The next character in the format string should
- be a letter. Gnus will call the function gnus-user-format-function-X,
- where X is the letter following %u. The function will be passed the
- current header as argument. The function should return a string, which
- will be inserted into the summary just like information from any other
- summary specifier.
-
-Text between %( and %) will be highlighted with `gnus-mouse-face'
-when the mouse point is placed inside the area. There can only be one
-such area.
-
-The %U (status), %R (replied) and %z (zcore) specs have to be handled
-with care. For reasons of efficiency, Gnus will compute what column
-these characters will end up in, and \"hard-code\" that. This means that
-it is illegal to have these specs after a variable-length spec. Well,
-you might not be arrested, but your summary buffer will look strange,
-which is bad enough.
-
-The smart choice is to have these specs as for to the left as
-possible.
-
-This restriction may disappear in later versions of Gnus.")
-
-(defvar gnus-summary-dummy-line-format
- "* %(: :%) %S\n"
- "*The format specification for the dummy roots in the summary buffer.
-It works along the same lines as a normal formatting string,
-with some simple extensions.
-
-%S The subject")
-
-(defvar gnus-summary-mode-line-format "Gnus: %%b [%A] %Z"
- "*The format specification for the summary mode line.
-It works along the same lines as a normal formatting string,
-with some simple extensions:
-
-%G Group name
-%p Unprefixed group name
-%A Current article number
-%V Gnus version
-%U Number of unread articles in the group
-%e Number of unselected articles in the group
-%Z A string with unread/unselected article counts
-%g Shortish group name
-%S Subject of the current article
-%u User-defined spec
-%s Current score file name
-%d Number of dormant articles
-%r Number of articles that have been marked as read in this session
-%E Number of articles expunged by the score files")
-
-(defvar gnus-article-mode-line-format "Gnus: %%b %S"
- "*The format specification for the article mode line.
-See `gnus-summary-mode-line-format' for a closer description.")
-
-(defvar gnus-group-mode-line-format "Gnus: %%b {%M%:%S}"
- "*The format specification for the group mode line.
-It works along the same lines as a normal formatting string,
-with some simple extensions:
-
-%S The native news server.
-%M The native select method.
-%: \":\" if %S isn't \"\".")
+(defvar gnus-shell-command-separator ";"
+ "String used to separate to shell commands.")
(defvar gnus-valid-select-methods
'(("nntp" post address prompt-address)
("nnmbox" mail respool address)
("nnml" mail respool address)
("nnmh" mail respool address)
- ("nndir" post-mail prompt-address address)
+ ("nndir" post-mail prompt-address)
("nneething" none address prompt-address)
("nndoc" none address prompt-address)
("nnbabyl" mail address respool)
- ("nnkiboze" post address virtual)
+ ("nnkiboze" post virtual)
("nnsoup" post-mail address)
("nndraft" post-mail)
- ("nnfolder" mail respool address))
+ ("nnfolder" mail respool address)
+ ("nngateway" none address prompt-address)
+ ("nnweb" none))
"An alist of valid select methods.
The first element of each list lists should be a string with the name
-of the select method. The other elements may be be the category of
-this method (ie. `post', `mail', `none' or whatever) or other
+of the select method. The other elements may be the category of
+this method (i. e., `post', `mail', `none' or whatever) or other
properties that this method has (like being respoolable).
If you implement a new select method, all you should have to change is
this variable. I think.")
If this is nil, Gnus will take space as is needed, leaving the rest
of the modeline intact.")
-;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.
-This variable is local to each summary buffer and usually set by the
-score file.")
-
-(defvar gnus-article-sort-functions '(gnus-article-sort-by-number)
- "*List of functions used for sorting articles in the summary buffer.
-This variable is only used when not using a threaded display.")
-
-(defvar gnus-thread-sort-functions '(gnus-thread-sort-by-number)
- "*List of functions used for sorting threads in the summary buffer.
-By default, threads are sorted by article number.
-
-Each function takes two threads and return non-nil if the first thread
-should be sorted before the other. If you use more than one function,
-the primary sort function should be the last. You should probably
-always include `gnus-thread-sort-by-number' in the list of sorting
-functions -- preferably first.
-
-Ready-mady functions include `gnus-thread-sort-by-number',
-`gnus-thread-sort-by-author', `gnus-thread-sort-by-subject',
-`gnus-thread-sort-by-date', `gnus-thread-sort-by-score' and
-`gnus-thread-sort-by-total-score' (see `gnus-thread-score-function').")
-
-(defvar gnus-thread-score-function '+
- "*Function used for calculating the total score of a thread.
-
-The function is called with the scores of the article and each
-subthread and should then return the score of the thread.
-
-Some functions you can use are `+', `max', or `min'.")
-
-(defvar gnus-summary-expunge-below nil
- "All articles that have a score less than this variable will be expunged.")
-
-(defvar gnus-thread-expunge-below nil
- "All threads that have a total score less than this variable will be expunged.
-See `gnus-thread-score-function' for en explanation of what a
-\"thread score\" is.")
-
-(defvar gnus-auto-subscribed-groups
- "^nnml\\|^nnfolder\\|^nnmbox\\|^nnmh\\|^nnbabyl"
- "*All new groups that match this regexp will be subscribed automatically.
-Note that this variable only deals with new groups. It has no effect
-whatsoever on old groups.")
-
-(defvar gnus-options-subscribe nil
- "*All new groups matching this regexp will be subscribed unconditionally.
-Note that this variable deals only with new newsgroups. This variable
-does not affect old newsgroups.")
-
-(defvar gnus-options-not-subscribe nil
- "*All new groups matching this regexp will be ignored.
-Note that this variable deals only with new newsgroups. This variable
-does not affect old (already subscribed) newsgroups.")
-
-(defvar gnus-auto-expirable-newsgroups nil
- "*Groups in which to automatically mark read articles as expirable.
-If non-nil, this should be a regexp that should match all groups in
-which to perform auto-expiry. This only makes sense for mail groups.")
+(defvar gnus-auto-expirable-newsgroups nil
+ "*Groups in which to automatically mark read articles as expirable.
+If non-nil, this should be a regexp that should match all groups in
+which to perform auto-expiry. This only makes sense for mail groups.")
(defvar gnus-total-expirable-newsgroups nil
"*Groups in which to perform expiry of all read articles.
(defvar gnus-group-uncollapsed-levels 1
"Number of group name elements to leave alone when making a short group name.")
-(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.")
+(defvar gnus-group-use-permanent-levels nil
+ "*If non-nil, once you set a level, Gnus will use this level.")
;; 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.
-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.")
-
-(defvar 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)
-
-(defvar gnus-summary-exit-hook nil
- "*A hook called on exit from the summary buffer.")
-
-(defvar gnus-group-catchup-group-hook nil
- "*A hook run when catching up a group from the group 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.")
-
-(defvar gnus-get-new-news-hook nil
- "*A hook run just before Gnus checks for new news.")
-
-(defvar gnus-after-getting-new-news-hook nil
- "*A hook run after Gnus checks for new news.")
-
-(defvar gnus-group-prepare-function 'gnus-group-prepare-flat
- "*A function that is called to generate the group buffer.
-The function is called with three arguments: The first is a number;
-all group with a level less or equal to that number should be listed,
-if the second is non-nil, empty groups should also be displayed. If
-the third is non-nil, it is a number. No groups with a level lower
-than this number should be displayed.
-
-The only current function implemented is `gnus-group-prepare-flat'.")
-
-(defvar gnus-group-prepare-hook nil
- "*A hook called after the group buffer has been generated.
-If you want to modify the group buffer, you can use this hook.")
-
-(defvar gnus-summary-prepare-hook nil
- "*A hook called after the summary buffer has been generated.
-If you want to modify the summary buffer, you can use this hook.")
-
-(defvar gnus-summary-generate-hook nil
- "*A hook run just before generating the summary buffer.
-This hook is commonly used to customize threading variables and the
-like.")
-
-(defvar gnus-article-prepare-hook nil
- "*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)
-;(add-hook 'gnus-article-display-hook 'gnus-article-maybe-highlight)
-
-(defvar gnus-article-x-face-command
- "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | xv -quit -"
- "String or function to be executed to display an X-Face header.
-If it is a string, the command will be executed in a sub-shell
-asynchronously. The compressed face will be piped to this command.")
-
-(defvar gnus-article-x-face-too-ugly nil
- "Regexp matching posters whose face shouldn't be shown automatically.")
-
-(defvar gnus-select-group-hook nil
- "*A hook called when a newsgroup is selected.
-
-If you'd like to simplify subjects like the
-`gnus-summary-next-same-subject' command does, you can use the
-following hook:
-
- (setq gnus-select-group-hook
- (list
- (lambda ()
- (mapcar (lambda (header)
- (mail-header-set-subject
- header
- (gnus-simplify-subject
- (mail-header-subject header) 're-only)))
- gnus-newsgroup-headers))))")
-
-(defvar gnus-select-article-hook nil
- "*A hook called when an article is selected.")
-
(defvar gnus-apply-kill-hook '(gnus-apply-kill-file)
"*A hook called to apply kill files to a group.
This hook is intended to apply a kill file to the selected newsgroup.
(gnus-kill \"Subject\" \"rmgroup\")
(gnus-expunge \"X\"))))))")
-(defvar gnus-visual-mark-article-hook
- (list 'gnus-highlight-selected-summary)
- "*Hook run after selecting an article in the summary buffer.
-It is meant to be used for highlighting the article in some way. It
-is not run if `gnus-visual' is nil.")
-
-(defvar gnus-parse-headers-hook nil
- "*A hook called before parsing the headers.")
-(add-hook 'gnus-parse-headers-hook 'gnus-decode-rfc1522)
-
-(defvar gnus-exit-group-hook nil
- "*A hook called when exiting (not quitting) summary mode.")
-
-(defvar gnus-suspend-gnus-hook nil
- "*A hook called when suspending (not exiting) Gnus.")
-
-(defvar gnus-exit-gnus-hook nil
- "*A hook called when exiting Gnus.")
-
-(defvar gnus-after-exiting-gnus-hook nil
- "*A hook called after exiting Gnus.")
-
-(defvar gnus-save-newsrc-hook nil
- "*A hook called before saving any of the newsrc files.")
-
-(defvar gnus-save-quick-newsrc-hook nil
- "*A hook called just before saving the quick newsrc file.
-Can be used to turn version control on or off.")
-
-(defvar gnus-save-standard-newsrc-hook nil
- "*A hook called just before saving the standard newsrc file.
-Can be used to turn version control on or off.")
-
-(defvar gnus-summary-update-hook
- (list 'gnus-summary-highlight-line)
- "*A hook called when a summary line is changed.
-The hook will not be called if `gnus-visual' is nil.
-
-The default function `gnus-summary-highlight-line' will
-highlight the line according to the `gnus-summary-highlight'
-variable.")
-
-(defvar gnus-group-update-hook '(gnus-group-highlight-line)
- "*A hook called when a group line is changed.
-The hook will not be called if `gnus-visual' is nil.
-
-The default function `gnus-group-highlight-line' will
-highlight the line according to the `gnus-group-highlight'
-variable.")
-
-(defvar gnus-mark-article-hook '(gnus-summary-mark-read-and-unread-as-read)
- "*A hook called when an article is selected for the first time.
-The hook is intended to mark an article as read (or unread)
-automatically when it is selected.")
-
(defvar gnus-group-change-level-function nil
"Function run when a group level is changed.
It is called with three parameters -- GROUP, LEVEL and OLDLEVEL.")
-;; 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-read-and-unread-as-read))
- (remove-hook 'gnus-article-prepare-hook
- 'hilit-rehighlight-buffer-quietly)))
+;;; Face thingies.
+
+(defvar gnus-visual
+ '(summary-highlight group-highlight article-highlight
+ mouse-face
+ summary-menu group-menu article-menu
+ tree-highlight menu highlight
+ browse-menu server-menu
+ page-marker tree-menu binary-menu pick-menu
+ grouplens-menu)
+ "Enable visual features.
+If `visual' is disabled, there will be no menus and few faces. Most of
+the visual customization options below will be ignored. Gnus will use
+less space and be faster as a result.")
+
+(defvar gnus-mouse-face
+ (condition-case ()
+ (if (gnus-visual-p 'mouse-face 'highlight)
+ (if (boundp 'gnus-mouse-face)
+ (or gnus-mouse-face 'highlight)
+ 'highlight)
+ 'default)
+ (error 'highlight))
+ "Face used for group or summary buffer mouse highlighting.
+The line beneath the mouse pointer will be highlighted with this
+face.")
+
+(defvar gnus-article-display-hook
+ (if (and (string-match "XEmacs" emacs-version)
+ (featurep 'xface))
+ '(gnus-article-hide-headers-if-wanted
+ gnus-article-hide-boring-headers
+ gnus-article-treat-overstrike
+ gnus-article-maybe-highlight
+ gnus-article-display-x-face)
+ '(gnus-article-hide-headers-if-wanted
+ gnus-article-hide-boring-headers
+ gnus-article-treat-overstrike
+ gnus-article-maybe-highlight))
+ "Controls how the article buffer will look.
+
+If you leave the list empty, the article will appear exactly as it is
+stored on the disk. The list entries will hide or highlight various
+parts of the article, making it easier to find the information you
+want.")
+
+
\f
-;; Internal variables
+;;; Internal variables
+
+(defvar gnus-group-get-parameter-function 'gnus-group-get-parameter)
+(defvar gnus-original-article-buffer " *Original Article*")
+(defvar gnus-newsgroup-name nil)
+
+(defvar gnus-current-select-method nil
+ "The current method for selecting a newsgroup.")
(defvar gnus-tree-buffer "*Tree*"
"Buffer where Gnus thread trees are displayed.")
;; Dummy variable.
(defvar gnus-use-generic-from nil)
-(defvar gnus-thread-indent-array nil)
-(defvar gnus-thread-indent-array-level gnus-thread-indent-level)
-
-(defvar gnus-newsrc-file-version nil)
-
-(defvar gnus-method-history nil)
;; Variable holding the user answers to all method prompts.
-
+(defvar gnus-method-history nil)
(defvar gnus-group-history nil)
+
+;; Variable holding the user answers to all mail method prompts.
+(defvar gnus-mail-method-history nil)
+
;; Variable holding the user answers to all group prompts.
+(defvar gnus-group-history nil)
(defvar gnus-server-alist nil
"List of available servers.")
-(defvar gnus-group-indentation-function nil)
+(defvar gnus-predefined-server-alist
+ `(("cache"
+ (nnspool "cache"
+ (nnspool-spool-directory "~/News/cache/")
+ (nnspool-nov-directory "~/News/cache/")
+ (nnspool-active-file "~/News/cache/active"))))
+ "List of predefined (convenience) servers.")
(defvar gnus-topic-indentation "") ;; Obsolete variable.
-(defvar gnus-goto-missing-group-function nil)
-
-(defvar gnus-override-subscribe-method nil)
-
-(defvar gnus-group-goto-next-group-function nil
- "Function to override finding the next group after listing groups.")
-
(defconst gnus-article-mark-lists
'((marked . tick) (replied . reply)
(expirable . expire) (killed . killed)
(bookmarks . bookmark) (dormant . dormant)
(scored . score) (saved . save)
- (cached . cache)
- ))
-
-;; Avoid highlighting in kill files.
-(defvar gnus-summary-inhibit-highlight nil)
-(defvar gnus-newsgroup-selected-overlay nil)
+ (cached . cache)))
-(defvar gnus-inhibit-hiding nil)
-(defvar gnus-group-indentation "")
-(defvar gnus-inhibit-limiting nil)
-(defvar gnus-created-frames nil)
-
-(defvar gnus-article-mode-map nil)
-(defvar gnus-dribble-buffer nil)
(defvar gnus-headers-retrieved-by nil)
(defvar gnus-article-reply nil)
(defvar gnus-override-method nil)
(defvar gnus-article-check-size nil)
-
-(defvar gnus-current-score-file nil)
-(defvar gnus-newsgroup-adaptive-score-file nil)
-(defvar gnus-scores-exclude-files nil)
-
(defvar gnus-opened-servers nil)
-(defvar gnus-current-move-group nil)
-(defvar gnus-current-copy-group nil)
-(defvar gnus-current-crosspost-group nil)
-
-(defvar gnus-newsgroup-dependencies nil)
-(defvar gnus-newsgroup-async nil)
-(defconst gnus-group-edit-buffer "*Gnus edit newsgroup*")
-
-(defvar gnus-newsgroup-adaptive nil)
-
-(defvar gnus-summary-display-table nil)
-(defvar gnus-summary-display-article-function nil)
-
-(defvar gnus-summary-highlight-line-function nil
- "Function called after highlighting a summary line.")
-
-(defvar gnus-group-line-format-alist
- `((?M gnus-tmp-marked-mark ?c)
- (?S gnus-tmp-subscribed ?c)
- (?L gnus-tmp-level ?d)
- (?N (cond ((eq number t) "*" )
- ((numberp number)
- (int-to-string
- (+ number
- (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked)))
- (gnus-range-length (cdr (assq 'tick gnus-tmp-marked))))))
- (t number)) ?s)
- (?R gnus-tmp-number-of-read ?s)
- (?t gnus-tmp-number-total ?d)
- (?y gnus-tmp-number-of-unread ?s)
- (?I (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked))) ?d)
- (?T (gnus-range-length (cdr (assq 'tick gnus-tmp-marked))) ?d)
- (?i (+ (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked)))
- (gnus-range-length (cdr (assq 'tick gnus-tmp-marked)))) ?d)
- (?g gnus-tmp-group ?s)
- (?G gnus-tmp-qualified-group ?s)
- (?c (gnus-short-group-name gnus-tmp-group) ?s)
- (?D gnus-tmp-newsgroup-description ?s)
- (?o gnus-tmp-moderated ?c)
- (?O gnus-tmp-moderated-string ?s)
- (?p gnus-tmp-process-marked ?c)
- (?s gnus-tmp-news-server ?s)
- (?n gnus-tmp-news-method ?s)
- (?P gnus-group-indentation ?s)
- (?l gnus-tmp-grouplens ?s)
- (?z gnus-tmp-news-method-string ?s)
- (?u gnus-tmp-user-defined ?s)))
-
-(defvar gnus-summary-line-format-alist
- `((?N ,(macroexpand '(mail-header-number gnus-tmp-header)) ?d)
- (?S ,(macroexpand '(mail-header-subject gnus-tmp-header)) ?s)
- (?s gnus-tmp-subject-or-nil ?s)
- (?n gnus-tmp-name ?s)
- (?A (car (cdr (funcall gnus-extract-address-components gnus-tmp-from)))
- ?s)
- (?a (or (car (funcall gnus-extract-address-components gnus-tmp-from))
- gnus-tmp-from) ?s)
- (?F gnus-tmp-from ?s)
- (?x ,(macroexpand '(mail-header-xref gnus-tmp-header)) ?s)
- (?D ,(macroexpand '(mail-header-date gnus-tmp-header)) ?s)
- (?d (gnus-dd-mmm (mail-header-date gnus-tmp-header)) ?s)
- (?M ,(macroexpand '(mail-header-id gnus-tmp-header)) ?s)
- (?r ,(macroexpand '(mail-header-references gnus-tmp-header)) ?s)
- (?c (or (mail-header-chars gnus-tmp-header) 0) ?d)
- (?L gnus-tmp-lines ?d)
- (?I gnus-tmp-indentation ?s)
- (?T (if (= gnus-tmp-level 0) "" (make-string (frame-width) ? )) ?s)
- (?R gnus-tmp-replied ?c)
- (?\[ gnus-tmp-opening-bracket ?c)
- (?\] gnus-tmp-closing-bracket ?c)
- (?\> (make-string gnus-tmp-level ? ) ?s)
- (?\< (make-string (max 0 (- 20 gnus-tmp-level)) ? ) ?s)
- (?i gnus-tmp-score ?d)
- (?z gnus-tmp-score-char ?c)
- (?l (bbb-grouplens-score gnus-tmp-header) ?s)
- (?V (gnus-thread-total-score (and (boundp 'thread) (car thread))) ?d)
- (?U gnus-tmp-unread ?c)
- (?t (gnus-summary-number-of-articles-in-thread
- (and (boundp 'thread) (car thread)) gnus-tmp-level)
- ?d)
- (?e (gnus-summary-number-of-articles-in-thread
- (and (boundp 'thread) (car thread)) gnus-tmp-level t)
- ?c)
- (?u gnus-tmp-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
-variable (string, integer, character, etc).")
-
-(defvar gnus-summary-dummy-line-format-alist
- `((?S gnus-tmp-subject ?s)
- (?N gnus-tmp-number ?d)
- (?u gnus-tmp-user-defined ?s)))
-
-(defvar gnus-summary-mode-line-format-alist
- `((?G gnus-tmp-group-name ?s)
- (?g (gnus-short-group-name gnus-tmp-group-name) ?s)
- (?p (gnus-group-real-name gnus-tmp-group-name) ?s)
- (?A gnus-tmp-article-number ?d)
- (?Z gnus-tmp-unread-and-unselected ?s)
- (?V gnus-version ?s)
- (?U gnus-tmp-unread ?d)
- (?S gnus-tmp-subject ?s)
- (?e gnus-tmp-unselected ?d)
- (?u gnus-tmp-user-defined ?s)
- (?d (length gnus-newsgroup-dormant) ?d)
- (?t (length gnus-newsgroup-marked) ?d)
- (?r (length gnus-newsgroup-reads) ?d)
- (?E gnus-newsgroup-expunged-tally ?d)
- (?s (gnus-current-score-file-nondirectory) ?s)))
-
-(defvar gnus-article-mode-line-format-alist
- gnus-summary-mode-line-format-alist)
-
-(defvar gnus-group-mode-line-format-alist
- `((?S gnus-tmp-news-server ?s)
- (?M gnus-tmp-news-method ?s)
- (?u gnus-tmp-user-defined ?s)
- (?: gnus-tmp-colon ?s)))
+(defvar gnus-current-kill-article nil)
(defvar gnus-have-read-active-file nil)
"gnus-bug@ifi.uio.no (The Gnus Bugfixing Girls + Boys)"
"The mail address of the Gnus maintainers.")
-(defconst gnus-version "September Gnus v0.90"
- "Version number for this version of Gnus.")
-
(defvar gnus-info-nodes
'((gnus-group-mode "(gnus)The Group Buffer")
(gnus-summary-mode "(gnus)The Summary Buffer")
- (gnus-article-mode "(gnus)The Article Buffer"))
- "Assoc list of major modes and related Info nodes.")
+ (gnus-article-mode "(gnus)The Article Buffer")
+ (mime/viewer-mode "(gnus)The Article Buffer")
+ (gnus-server-mode "(gnus)The Server Buffer")
+ (gnus-browse-mode "(gnus)Browse Foreign Server")
+ (gnus-tree-mode "(gnus)Tree Display"))
+ "Alist of major modes and related Info nodes.")
(defvar gnus-group-buffer "*Group*")
(defvar gnus-summary-buffer "*Summary*")
(defvar gnus-article-buffer "*Article*")
(defvar gnus-server-buffer "*Server*")
-(defvar gnus-work-buffer " *gnus work*")
-
-(defvar gnus-original-article-buffer " *Original Article*")
-(defvar gnus-original-article nil)
-
(defvar gnus-buffer-list nil
"Gnus buffers that should be killed on exit.")
(defvar gnus-slave nil
"Whether this Gnus is a slave or not.")
+(defvar gnus-batch-mode nil
+ "Whether this Gnus is running in batch mode or not.")
+
(defvar gnus-variable-list
'(gnus-newsrc-options gnus-newsrc-options-n
gnus-newsrc-last-checked-date
gnus-format-specs)
"Gnus variables saved in the quick startup file.")
-(defvar gnus-newsrc-options nil
- "Options line in the .newsrc file.")
-
-(defvar gnus-newsrc-options-n nil
- "List of regexps representing groups to be subscribed/ignored unconditionally.")
-
-(defvar gnus-newsrc-last-checked-date nil
- "Date Gnus last asked server for new newsgroups.")
-
-(defvar gnus-topic-topology nil
- "The complete topic hierarchy.")
-
-(defvar gnus-topic-alist nil
- "The complete topic-group alist.")
-
(defvar gnus-newsrc-alist nil
"Assoc list of read articles.
gnus-newsrc-hashtb should be kept so that both hold the same information.")
(defvar gnus-active-hashtb nil
"Hashtable of active articles.")
-(defvar gnus-moderated-list nil
- "List of moderated newsgroups.")
-
-(defvar gnus-group-marked nil)
-
-(defvar gnus-current-startup-file nil
- "Startup file for the current host.")
-
-(defvar gnus-last-search-regexp nil
- "Default regexp for article search command.")
-
-(defvar gnus-last-shell-command nil
- "Default shell command on article.")
-
-(defvar gnus-current-select-method nil
- "The current method for selecting a newsgroup.")
-
-(defvar gnus-group-list-mode nil)
-
-(defvar gnus-article-internal-prepare-hook nil)
-
-(defvar gnus-newsgroup-name nil)
-(defvar gnus-newsgroup-begin nil)
-(defvar gnus-newsgroup-end nil)
-(defvar gnus-newsgroup-last-rmail nil)
-(defvar gnus-newsgroup-last-mail nil)
-(defvar gnus-newsgroup-last-folder nil)
-(defvar gnus-newsgroup-last-file nil)
-(defvar gnus-newsgroup-auto-expire nil)
-(defvar gnus-newsgroup-active nil)
-
-(defvar gnus-newsgroup-data nil)
-(defvar gnus-newsgroup-data-reverse nil)
-(defvar gnus-newsgroup-limit nil)
-(defvar gnus-newsgroup-limits nil)
-
-(defvar gnus-newsgroup-unreads nil
- "List of unread articles in the current newsgroup.")
-
-(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-expunged-tally nil)
-
-(defvar gnus-newsgroup-marked nil
- "List of ticked articles in the current newsgroup (a subset of unread art).")
-
-(defvar gnus-newsgroup-killed nil
- "List of ranges of articles that have been through the scoring process.")
-
-(defvar gnus-newsgroup-cached nil
- "List of articles that come from the article cache.")
-
-(defvar gnus-newsgroup-saved nil
- "List of articles that have been saved.")
-
-(defvar gnus-newsgroup-kill-headers nil)
-
-(defvar gnus-newsgroup-replied nil
- "List of articles that have been replied to in the current newsgroup.")
-
-(defvar gnus-newsgroup-expirable nil
- "List of articles in the current newsgroup that can be expired.")
-
-(defvar gnus-newsgroup-processable nil
- "List of articles in the current newsgroup that can be processed.")
-
-(defvar gnus-newsgroup-bookmarks nil
- "List of articles in the current newsgroup that have bookmarks.")
-
-(defvar gnus-newsgroup-dormant nil
- "List of dormant articles in the current newsgroup.")
-
-(defvar gnus-newsgroup-scored nil
- "List of scored articles in the current newsgroup.")
-
-(defvar gnus-newsgroup-headers nil
- "List of article headers in the current newsgroup.")
-
-(defvar gnus-newsgroup-threads nil)
-
-(defvar gnus-newsgroup-prepared nil
- "Whether the current group has been prepared properly.")
-
-(defvar gnus-newsgroup-ancient nil
- "List of `gnus-fetch-old-headers' articles in the current newsgroup.")
-
-(defvar gnus-newsgroup-sparse nil)
-
-(defvar gnus-current-article nil)
-(defvar gnus-article-current nil)
-(defvar gnus-current-headers nil)
-(defvar gnus-have-all-headers nil)
-(defvar gnus-last-article nil)
-(defvar gnus-newsgroup-history nil)
-(defvar gnus-current-kill-article nil)
+(defvar gnus-moderated-hashtb nil
+ "Hashtable of moderated newsgroups.")
;; Save window configuration.
(defvar gnus-prev-winconf nil)
-(defvar gnus-summary-mark-positions nil)
-(defvar gnus-group-mark-positions nil)
-
(defvar gnus-reffed-article-number nil)
;;; Let the byte-compiler know that we know about this variable.
(defvar rmail-default-rmail-file)
-(defvar gnus-cache-removable-articles nil)
-
(defvar gnus-dead-summary nil)
-(defconst gnus-summary-local-variables
- '(gnus-newsgroup-name
- gnus-newsgroup-begin gnus-newsgroup-end
- gnus-newsgroup-last-rmail gnus-newsgroup-last-mail
- 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-saved
- gnus-newsgroup-replied gnus-newsgroup-expirable
- gnus-newsgroup-processable gnus-newsgroup-killed
- gnus-newsgroup-bookmarks gnus-newsgroup-dormant
- gnus-newsgroup-headers gnus-newsgroup-threads
- gnus-newsgroup-prepared gnus-summary-highlight-line-function
- gnus-current-article gnus-current-headers gnus-have-all-headers
- gnus-last-article gnus-article-internal-prepare-hook
- gnus-newsgroup-dependencies gnus-newsgroup-selected-overlay
- gnus-newsgroup-scored gnus-newsgroup-kill-headers
- gnus-newsgroup-async gnus-thread-expunge-below
- gnus-score-alist gnus-current-score-file gnus-summary-expunge-below
- gnus-summary-mark-below gnus-newsgroup-active gnus-scores-exclude-files
- gnus-newsgroup-history gnus-newsgroup-ancient
- gnus-newsgroup-sparse
- (gnus-newsgroup-adaptive . gnus-use-adaptive-scoring)
- gnus-newsgroup-adaptive-score-file
- (gnus-newsgroup-expunged-tally . 0)
- gnus-cache-removable-articles gnus-newsgroup-cached
- gnus-newsgroup-data gnus-newsgroup-data-reverse
- gnus-newsgroup-limit gnus-newsgroup-limits)
- "Variables that are buffer-local to the summary buffers.")
-
-(defconst gnus-bug-message
- "Sending a bug report to the Gnus Towers.
-========================================
-
-The buffer below is a mail buffer. When you press `C-c C-c', it will
-be sent to the Gnus Bug Exterminators.
-
-At the bottom of the buffer you'll see lots of variable settings.
-Please do not delete those. They will tell the Bug People what your
-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-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.
-
-Thank you for your help in stamping out bugs.
-")
-
;;; End of variables.
;; Define some autoload functions Gnus might use.
("hexl" hexl-hex-string-to-integer)
("pp" pp pp-to-string pp-eval-expression)
("mail-extr" mail-extract-address-components)
- ("nnmail" nnmail-split-fancy nnmail-article-group)
- ("nnvirtual" nnvirtual-catchup-group)
+ ("message" :interactive t
+ message-send-and-exit message-yank-original)
+ ("nnmail" nnmail-split-fancy nnmail-article-group nnmail-date-to-time)
+ ("nnvirtual" nnvirtual-catchup-group nnvirtual-convert-headers)
("timezone" timezone-make-date-arpa-standard timezone-fix-time
timezone-make-sortable-date timezone-make-time-string)
- ("sendmail" mail-position-on-field mail-setup)
("rmailout" rmail-output)
- ("rnewspost" news-mail-other-window news-reply-yank-original
- news-caesar-buffer-body)
("rmail" rmail-insert-rmail-file-header rmail-count-new-messages
rmail-show-message)
+ ("gnus-xmas" gnus-xmas-splash)
("gnus-soup" :interactive t
gnus-group-brew-soup gnus-brew-soup gnus-soup-add-article
gnus-soup-send-replies gnus-soup-save-areas gnus-soup-pack-packet)
("nnsoup" nnsoup-pack-replies)
- ("gnus-scomo" :interactive t gnus-score-mode)
- ("gnus-mh" gnus-mh-mail-setup gnus-summary-save-article-folder
+ ("score-mode" :interactive t gnus-score-mode)
+ ("gnus-mh" gnus-summary-save-article-folder
gnus-Folder-save-name gnus-folder-save-name)
("gnus-mh" :interactive t gnus-summary-save-in-folder)
- ("gnus-vis" gnus-group-make-menu-bar gnus-summary-make-menu-bar
- gnus-server-make-menu-bar gnus-article-make-menu-bar
- gnus-browse-make-menu-bar gnus-highlight-selected-summary
- gnus-summary-highlight-line gnus-carpal-setup-buffer
- gnus-group-highlight-line
- gnus-article-add-button gnus-insert-next-page-button
- gnus-insert-prev-page-button gnus-visual-turn-off-edit-menu)
- ("gnus-vis" :interactive t
- gnus-article-push-button gnus-article-press-button
- gnus-article-highlight gnus-article-highlight-some
- gnus-article-highlight-headers gnus-article-highlight-signature
- gnus-article-add-buttons gnus-article-add-buttons-to-head
- gnus-article-next-button gnus-article-prev-button)
("gnus-demon" gnus-demon-add-nocem gnus-demon-add-scanmail
gnus-demon-add-disconnection gnus-demon-add-handler
gnus-demon-remove-handler)
("gnus-demon" :interactive t
gnus-demon-init gnus-demon-cancel)
("gnus-salt" gnus-highlight-selected-tree gnus-possibly-generate-tree
- gnus-tree-open gnus-tree-close)
+ gnus-tree-open gnus-tree-close gnus-carpal-setup-buffer)
("gnus-nocem" gnus-nocem-scan-groups gnus-nocem-close
gnus-nocem-unwanted-article-p)
("gnus-srvr" gnus-enter-server-buffer gnus-server-set-info)
gnus-cache-retrieve-headers gnus-cache-possibly-alter-active
gnus-cache-enter-remove-article gnus-cached-article-p
gnus-cache-open gnus-cache-close gnus-cache-update-article)
- ("gnus-cache" :interactive t gnus-jog-cache gnus-cache-enter-article
- gnus-cache-remove-article)
- ("gnus-score" :interactive t
- gnus-summary-increase-score gnus-summary-lower-score
- gnus-score-flush-cache gnus-score-close
- gnus-score-raise-same-subject-and-select
- gnus-score-raise-same-subject gnus-score-default
- gnus-score-raise-thread gnus-score-lower-same-subject-and-select
- gnus-score-lower-same-subject gnus-score-lower-thread
- gnus-possibly-score-headers)
- ("gnus-score"
- (gnus-summary-score-map keymap) gnus-score-save gnus-score-headers
+ ("gnus-cache" :interactive t gnus-jog-cache gnus-cache-enter-article
+ gnus-cache-remove-article gnus-summary-insert-cached-articles)
+ ("gnus-score" :interactive t
+ gnus-summary-increase-score gnus-summary-set-score
+ gnus-summary-raise-thread gnus-summary-raise-same-subject
+ gnus-summary-raise-score gnus-summary-raise-same-subject-and-select
+ gnus-summary-lower-thread gnus-summary-lower-same-subject
+ gnus-summary-lower-score gnus-summary-lower-same-subject-and-select
+ gnus-summary-current-score gnus-score-default
+ gnus-score-flush-cache gnus-score-close
+ gnus-possibly-score-headers gnus-score-followup-article
+ gnus-score-followup-thread)
+ ("gnus-score"
+ (gnus-summary-score-map keymap) gnus-score-save gnus-score-headers
gnus-current-score-file-nondirectory gnus-score-adaptive
gnus-score-find-trace gnus-score-file-name)
- ("gnus-edit" :interactive t gnus-score-customize)
+ ("gnus-cus" :interactive t gnus-group-customize gnus-score-customize)
("gnus-topic" :interactive t gnus-topic-mode)
("gnus-topic" gnus-topic-remove-group)
("gnus-salt" :interactive t gnus-pick-mode gnus-binary-mode)
gnus-uu-decode-unshar-and-save-view gnus-uu-decode-save-view
gnus-uu-decode-binhex-view)
("gnus-msg" (gnus-summary-send-map keymap)
- gnus-mail-yank-original gnus-mail-send-and-exit
- gnus-sendmail-setup-mail gnus-article-mail
- gnus-inews-message-id gnus-new-mail gnus-mail-reply)
+ gnus-article-mail gnus-copy-article-buffer gnus-extended-version)
("gnus-msg" :interactive t
gnus-group-post-news gnus-group-mail gnus-summary-post-news
gnus-summary-followup gnus-summary-followup-with-original
- gnus-summary-followup-and-reply
- gnus-summary-followup-and-reply-with-original
gnus-summary-cancel-article gnus-summary-supersede-article
- gnus-post-news gnus-inews-news gnus-cancel-news
- gnus-summary-reply gnus-summary-reply-with-original
+ gnus-post-news gnus-summary-reply gnus-summary-reply-with-original
gnus-summary-mail-forward gnus-summary-mail-other-window
+ gnus-summary-resend-message gnus-summary-resend-bounced-mail
gnus-bug)
("gnus-picon" :interactive t gnus-article-display-picons
- gnus-group-display-picons gnus-picons-article-display-x-face)
+ gnus-group-display-picons gnus-picons-article-display-x-face
+ gnus-picons-display-x-face)
("gnus-gl" bbb-login bbb-logout bbb-grouplens-group-p
gnus-grouplens-mode)
- ("gnus-vm" gnus-vm-mail-setup)
+ ("smiley" :interactive t gnus-smiley-display)
+ ("gnus-win" gnus-configure-windows)
+ ("gnus-sum" gnus-summary-insert-line gnus-summary-read-group
+ gnus-list-of-unread-articles gnus-list-of-read-articles
+ gnus-offer-save-summaries gnus-make-thread-indent-array
+ gnus-summary-exit gnus-update-read-articles)
+ ("gnus-group" gnus-group-insert-group-line gnus-group-quit
+ gnus-group-list-groups gnus-group-first-unread-group
+ gnus-group-set-mode-line gnus-group-set-info gnus-group-save-newsrc
+ gnus-group-setup-buffer gnus-group-get-new-news
+ gnus-group-make-help-group gnus-group-update-group)
+ ("gnus-bcklg" gnus-backlog-request-article gnus-backlog-enter-article
+ gnus-backlog-remove-article)
+ ("gnus-art" gnus-article-read-summary-keys gnus-article-save
+ gnus-article-prepare gnus-article-set-window-start
+ gnus-article-next-page gnus-article-prev-page
+ gnus-request-article-this-buffer gnus-article-mode
+ gnus-article-setup-buffer gnus-narrow-to-page)
+ ("gnus-art" :interactive t
+ gnus-article-hide-headers gnus-article-hide-boring-headers
+ gnus-article-treat-overstrike gnus-article-word-wrap
+ gnus-article-remove-cr gnus-article-remove-trailing-blank-lines
+ gnus-article-display-x-face gnus-article-de-quoted-unreadable
+ gnus-article-mime-decode-quoted-printable gnus-article-hide-pgp
+ gnus-article-hide-pem gnus-article-hide-signature
+ gnus-article-strip-leading-blank-lines gnus-article-date-local
+ gnus-article-date-original gnus-article-date-lapsed
+ gnus-decode-rfc1522 gnus-article-show-all-headers
+ gnus-article-edit-mode gnus-article-edit-article
+ gnus-article-edit-done)
+ ("gnus-int" gnus-request-type)
+ ("gnus-start" gnus-newsrc-parse-options gnus-1 gnus-no-server-1
+ gnus-dribble-enter)
+ ("gnus-dup" gnus-dup-suppress-articles gnus-dup-unsuppress-article
+ gnus-dup-enter-articles)
+ ("gnus-range" gnus-copy-sequence)
+ ("gnus-eform" gnus-edit-form)
+ ("gnus-move" :interactive t
+ gnus-group-move-group-to-server gnus-change-server)
+ ("gnus-logic" gnus-score-advanced)
+ ("gnus-undo" gnus-undo-mode gnus-undo-register)
+ ("gnus-async" gnus-async-request-fetched-article gnus-async-prefetch-next
+ gnus-async-prefetch-article gnus-async-prefetch-remove-group
+ gnus-async-halt-prefetch)
+ ("article" article-decode-rfc1522)
("gnus-vm" :interactive t gnus-summary-save-in-vm
- gnus-summary-save-article-vm gnus-yank-article))))
+ gnus-summary-save-article-vm))))
+
+;;; gnus-sum.el thingies
+
+
+(defvar gnus-summary-line-format "%U\%R\%z\%I\%(%[%4L: %-20,20n%]%) %s\n"
+ "*The format specification of the lines in the summary buffer.
+
+It works along the same lines as a normal formatting string,
+with some simple extensions.
+
+%N Article number, left padded with spaces (string)
+%S Subject (string)
+%s Subject if it is at the root of a thread, and \"\" otherwise (string)
+%n Name 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)
+%d Date of the article (string) in DD-MMM format
+%M Message-id of the article (string)
+%r References of the article (string)
+%c Number of characters in the article (integer)
+%L Number of lines in the article (integer)
+%I Indentation based on thread level (a string of spaces)
+%T A string with two possible values: 80 spaces if the article
+ is on thread level two or larger and 0 spaces on level one
+%R \"A\" if this article has been replied to, \" \" otherwise (character)
+%U Status of this article (character, \"R\", \"K\", \"-\" or \" \")
+%[ Opening bracket (character, \"[\" or \"<\")
+%] Closing bracket (character, \"]\" or \">\")
+%> Spaces of length thread-level (string)
+%< Spaces of length (- 20 thread-level) (string)
+%i Article score (number)
+%z Article zcore (character)
+%t Number of articles under the current thread (number).
+%e Whether the thread is empty or not (character).
+%l GroupLens score (string).
+%P The line number (number).
+%u User defined specifier. The next character in the format string should
+ be a letter. Gnus will call the function gnus-user-format-function-X,
+ where X is the letter following %u. The function will be passed the
+ current header as argument. The function should return a string, which
+ will be inserted into the summary just like information from any other
+ summary specifier.
+
+Text between %( and %) will be highlighted with `gnus-mouse-face'
+when the mouse point is placed inside the area. There can only be one
+such area.
+
+The %U (status), %R (replied) and %z (zcore) specs have to be handled
+with care. For reasons of efficiency, Gnus will compute what column
+these characters will end up in, and \"hard-code\" that. This means that
+it is illegal to have these specs after a variable-length spec. Well,
+you might not be arrested, but your summary buffer will look strange,
+which is bad enough.
+
+The smart choice is to have these specs as for to the left as
+possible.
+
+This restriction may disappear in later versions of Gnus.")
+
+;;;
+;;; Skeleton keymaps
+;;;
+
+(defun gnus-suppress-keymap (keymap)
+ (suppress-keymap keymap)
+ (let ((keys `([delete] "\177" "\M-u"))) ;gnus-mouse-2
+ (while keys
+ (define-key keymap (pop keys) 'undefined))))
+
+(defvar gnus-article-mode-map (make-keymap))
+(gnus-suppress-keymap gnus-article-mode-map)
+(defvar gnus-summary-mode-map (make-keymap))
+(gnus-suppress-keymap gnus-summary-mode-map)
+(defvar gnus-group-mode-map (make-keymap))
+(gnus-suppress-keymap gnus-group-mode-map)
\f
(defun gnus-header-from (header)
(mail-header-from header))
-(defmacro gnus-eval-in-buffer-window (buffer &rest forms)
- "Pop to BUFFER, evaluate FORMS, and then return to the original window."
- (let ((tempvar (make-symbol "GnusStartBufferWindow"))
- (w (make-symbol "w"))
- (buf (make-symbol "buf")))
- `(let* ((,tempvar (selected-window))
- (,buf ,buffer)
- (,w (get-buffer-window ,buf 'visible)))
- (unwind-protect
- (progn
- (if ,w
- (select-window ,w)
- (pop-to-buffer ,buf))
- ,@forms)
- (select-window ,tempvar)))))
-
(defmacro gnus-gethash (string hashtable)
"Get hash value of STRING in HASHTABLE."
`(symbol-value (intern-soft ,string ,hashtable)))
(defmacro gnus-sethash (string value hashtable)
"Set hash value. Arguments are STRING, VALUE, and HASHTABLE."
`(set (intern ,string ,hashtable) ,value))
-
-(defmacro gnus-intern-safe (string hashtable)
- "Set hash value. Arguments are STRING, VALUE, and HASHTABLE."
- `(let ((symbol (intern ,string ,hashtable)))
- (or (boundp symbol)
- (set symbol nil))
- symbol))
+(put 'gnus-sethash 'edebug-form-spec '(form form form))
(defmacro gnus-group-unread (group)
"Get the currently computed number of unread articles in GROUP."
"Set GROUP's active info."
`(gnus-sethash ,group ,active gnus-active-hashtb))
-;; 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."
- (if (string-match "^[Rr][Ee]: *" subject)
- (substring subject (match-end 0))
- subject))
-
-(defsubst gnus-functionp (form)
- "Return non-nil if FORM is funcallable."
- (or (and (symbolp form) (fboundp form))
- (and (listp form) (eq (car form) 'lambda))))
-
-(defsubst gnus-goto-char (point)
- (and point (goto-char point)))
-
-(defmacro gnus-buffer-exists-p (buffer)
- `(let ((buffer ,buffer))
- (and buffer
- (funcall (if (stringp buffer) 'get-buffer 'buffer-name)
- buffer))))
-
-(defmacro gnus-kill-buffer (buffer)
- `(let ((buf ,buffer))
- (if (gnus-buffer-exists-p buf)
- (kill-buffer buf))))
-
-(defsubst gnus-point-at-bol ()
- "Return point at the beginning of the line."
- (let ((p (point)))
- (beginning-of-line)
- (prog1
- (point)
- (goto-char p))))
-
-(defsubst gnus-point-at-eol ()
- "Return point at the end of the line."
- (let ((p (point)))
- (end-of-line)
- (prog1
- (point)
- (goto-char p))))
-
(defun gnus-alive-p ()
"Say whether Gnus is running or not."
(and gnus-group-buffer
- (get-buffer gnus-group-buffer)))
-
-;; 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")))
- (condition-case var
- (load gnus-init-file nil t)
- (error
- (error "Error in %s: %s" gnus-init-file var))))))
+ (get-buffer gnus-group-buffer)
+ (save-excursion
+ (set-buffer gnus-group-buffer)
+ (eq major-mode 'gnus-group-mode))))
;; Info access macros.
`(setcar (nthcdr 1 ,info) ,rank))
(defmacro gnus-info-set-read (info read)
`(setcar (nthcdr 2 ,info) ,read))
-(defmacro gnus-info-set-marks (info marks)
- `(setcar (nthcdr 3 ,info) ,marks))
-(defmacro gnus-info-set-method (info method)
- `(setcar (nthcdr 4 ,info) ,method))
-(defmacro gnus-info-set-params (info params)
- `(setcar (nthcdr 5 ,info) ,params))
+(defmacro gnus-info-set-marks (info marks &optional extend)
+ (if extend
+ `(gnus-info-set-entry ,info ,marks 3)
+ `(setcar (nthcdr 3 ,info) ,marks)))
+(defmacro gnus-info-set-method (info method &optional extend)
+ (if extend
+ `(gnus-info-set-entry ,info ,method 4)
+ `(setcar (nthcdr 4 ,info) ,method)))
+(defmacro gnus-info-set-params (info params &optional extend)
+ (if extend
+ `(gnus-info-set-entry ,info ,params 5)
+ `(setcar (nthcdr 5 ,info) ,params)))
+
+(defun gnus-info-set-entry (info entry number)
+ ;; Extend the info until we have enough elements.
+ (while (< (length info) number)
+ (nconc info (list nil)))
+ ;; Set the entry.
+ (setcar (nthcdr number info) entry))
(defmacro gnus-info-set-level (info level)
`(let ((rank (cdr ,info)))
(defmacro gnus-get-info (group)
`(nth 2 (gnus-gethash ,group gnus-newsrc-hashtb)))
-(defun gnus-byte-code (func)
- "Return a form that can be `eval'ed based on FUNC."
- (let ((fval (symbol-function func)))
- (if (byte-code-function-p fval)
- (let ((flist (append fval nil)))
- (setcar flist 'byte-code)
- flist)
- (cons 'progn (cddr fval)))))
+;; Byte-compiler warning.
+(defvar gnus-visual)
+;; Find out whether the gnus-visual TYPE is wanted.
+(defun gnus-visual-p (&optional type class)
+ (and gnus-visual ; Has to be non-nil, at least.
+ (if (not type) ; We don't care about type.
+ gnus-visual
+ (if (listp gnus-visual) ; It's a list, so we check it.
+ (or (memq type gnus-visual)
+ (memq class gnus-visual))
+ t))))
;;; Load the compatability functions.
-(require 'gnus-cus)
(require 'gnus-ems)
\f
(when (memq symbol (cdr entry))
(funcall (car entry))))))
-\f
-
-;; Format specs. The chunks below are the machine-generated forms
-;; that are to be evaled as the result of the default format strings.
-;; We write them in here to get them byte-compiled. That way the
-;; default actions will be quite fast, while still retaining the full
-;; flexibility of the user-defined format specs.
-
-;; First we have lots of dummy defvars to let the compiler know these
-;; are really dynamic variables.
-
-(defvar gnus-tmp-unread)
-(defvar gnus-tmp-replied)
-(defvar gnus-tmp-score-char)
-(defvar gnus-tmp-indentation)
-(defvar gnus-tmp-opening-bracket)
-(defvar gnus-tmp-lines)
-(defvar gnus-tmp-name)
-(defvar gnus-tmp-closing-bracket)
-(defvar gnus-tmp-subject-or-nil)
-(defvar gnus-tmp-subject)
-(defvar gnus-tmp-marked)
-(defvar gnus-tmp-marked-mark)
-(defvar gnus-tmp-subscribed)
-(defvar gnus-tmp-process-marked)
-(defvar gnus-tmp-number-of-unread)
-(defvar gnus-tmp-group-name)
-(defvar gnus-tmp-group)
-(defvar gnus-tmp-article-number)
-(defvar gnus-tmp-unread-and-unselected)
-(defvar gnus-tmp-news-method)
-(defvar gnus-tmp-news-server)
-(defvar gnus-tmp-article-number)
-(defvar gnus-mouse-face)
-(defvar gnus-mouse-face-prop)
-
-(defun gnus-summary-line-format-spec ()
- (insert gnus-tmp-unread gnus-tmp-replied
- gnus-tmp-score-char gnus-tmp-indentation)
- (gnus-put-text-property
- (point)
- (progn
- (insert
- gnus-tmp-opening-bracket
- (format "%4d: %-20s"
- gnus-tmp-lines
- (if (> (length gnus-tmp-name) 20)
- (substring gnus-tmp-name 0 20)
- gnus-tmp-name))
- gnus-tmp-closing-bracket)
- (point))
- gnus-mouse-face-prop gnus-mouse-face)
- (insert " " gnus-tmp-subject-or-nil "\n"))
-
-(defvar gnus-summary-line-format-spec
- (gnus-byte-code 'gnus-summary-line-format-spec))
-
-(defun gnus-summary-dummy-line-format-spec ()
- (insert "* ")
- (gnus-put-text-property
- (point)
- (progn
- (insert ": :")
- (point))
- gnus-mouse-face-prop gnus-mouse-face)
- (insert " " gnus-tmp-subject "\n"))
-
-(defvar gnus-summary-dummy-line-format-spec
- (gnus-byte-code 'gnus-summary-dummy-line-format-spec))
-
-(defun gnus-group-line-format-spec ()
- (insert gnus-tmp-marked-mark gnus-tmp-subscribed
- gnus-tmp-process-marked
- gnus-group-indentation
- (format "%5s: " gnus-tmp-number-of-unread))
- (gnus-put-text-property
- (point)
- (progn
- (insert gnus-tmp-group "\n")
- (1- (point)))
- gnus-mouse-face-prop gnus-mouse-face))
-(defvar gnus-group-line-format-spec
- (gnus-byte-code 'gnus-group-line-format-spec))
-
-(defvar gnus-format-specs
- `((version . ,emacs-version)
- (group ,gnus-group-line-format ,gnus-group-line-format-spec)
- (summary-dummy ,gnus-summary-dummy-line-format
- ,gnus-summary-dummy-line-format-spec)
- (summary ,gnus-summary-line-format ,gnus-summary-line-format-spec)))
-
-(defvar gnus-article-mode-line-format-spec nil)
-(defvar gnus-summary-mode-line-format-spec nil)
-(defvar gnus-group-mode-line-format-spec nil)
-
-;;; Phew. All that gruft is over, fortunately.
-
\f
;;;
;;; Gnus Utility Functions
;;;
-(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
- ;; Fix by MORIOKA Tomohiko <morioka@jaist.ac.jp>
- ;; Linear white space is not required.
- (string-match (concat "[ \t]*<" (regexp-quote address) ">") from)
- (and (setq name (substring from 0 (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)))))
- (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-fetch-field (field)
- "Return the value of the header FIELD of current article."
- (save-excursion
- (save-restriction
- (let ((case-fold-search t)
- (inhibit-point-motion-hooks t))
- (nnheader-narrow-to-headers)
- (message-fetch-field field)))))
-
-(defun gnus-goto-colon ()
- (beginning-of-line)
- (search-forward ":" (gnus-point-at-eol) t))
-
-;;;###autoload
-(defun gnus-update-format (var)
- "Update the format specification near point."
- (interactive
- (list
- (save-excursion
- (eval-defun nil)
- ;; Find the end of the current word.
- (re-search-forward "[ \t\n]" nil t)
- ;; Search backward.
- (when (re-search-backward "\\(gnus-[-a-z]+-line-format\\)" nil t)
- (match-string 1)))))
- (let* ((type (intern (progn (string-match "gnus-\\([-a-z]+\\)-line" var)
- (match-string 1 var))))
- (entry (assq type gnus-format-specs))
- value spec)
- (when entry
- (setq gnus-format-specs (delq entry gnus-format-specs)))
- (set
- (intern (format "%s-spec" var))
- (gnus-parse-format (setq value (symbol-value (intern var)))
- (symbol-value (intern (format "%s-alist" var)))
- (not (string-match "mode" var))))
- (setq spec (symbol-value (intern (format "%s-spec" var))))
- (push (list type value spec) gnus-format-specs)
-
- (pop-to-buffer "*Gnus Format*")
- (erase-buffer)
- (lisp-interaction-mode)
- (insert (pp-to-string spec))))
-
-(defun gnus-update-format-specifications (&optional force)
- "Update all (necessary) format specifications."
- ;; Make the indentation array.
- (gnus-make-thread-indent-array)
-
- ;; See whether all the stored info needs to be flushed.
- (when (or force
- (not (equal emacs-version
- (cdr (assq 'version gnus-format-specs)))))
- (setq gnus-format-specs nil))
-
- ;; Go through all the formats and see whether they need updating.
- (let ((types '(summary summary-dummy group
- summary-mode group-mode article-mode))
- new-format entry type val)
- (while (setq type (pop types))
- ;; Jump to the proper buffer to find out the value of
- ;; the variable, if possible. (It may be buffer-local.)
- (save-excursion
- (let ((buffer (intern (format "gnus-%s-buffer" type)))
- val)
- (when (and (boundp buffer)
- (setq val (symbol-value buffer))
- (get-buffer val)
- (buffer-name (get-buffer val)))
- (set-buffer (get-buffer val)))
- (setq new-format (symbol-value
- (intern (format "gnus-%s-line-format" type))))))
- (setq entry (cdr (assq type gnus-format-specs)))
- (if (and entry
- (equal (car entry) new-format))
- ;; Use the old format.
- (set (intern (format "gnus-%s-line-format-spec" type))
- (cadr entry))
- ;; This is a new format.
- (setq val
- (if (not (stringp new-format))
- ;; This is a function call or something.
- new-format
- ;; This is a "real" format.
- (gnus-parse-format
- new-format
- (symbol-value
- (intern (format "gnus-%s-line-format-alist"
- (if (eq type 'article-mode)
- 'summary-mode type))))
- (not (string-match "mode$" (symbol-name type))))))
- ;; Enter the new format spec into the list.
- (if entry
- (progn
- (setcar (cdr entry) val)
- (setcar entry new-format))
- (push (list type new-format val) gnus-format-specs))
- (set (intern (format "gnus-%s-line-format-spec" type)) val))))
-
- (unless (assq 'version gnus-format-specs)
- (push (cons 'version emacs-version) gnus-format-specs))
-
- (gnus-update-group-mark-positions)
- (gnus-update-summary-mark-positions))
-
-(defun gnus-update-summary-mark-positions ()
- "Compute where the summary marks are to go."
- (save-excursion
- (when (and gnus-summary-buffer
- (get-buffer gnus-summary-buffer)
- (buffer-name (get-buffer gnus-summary-buffer)))
- (set-buffer gnus-summary-buffer))
- (let ((gnus-replied-mark 129)
- (gnus-score-below-mark 130)
- (gnus-score-over-mark 130)
- (thread nil)
- (gnus-visual nil)
- (spec gnus-summary-line-format-spec)
- pos)
- (save-excursion
- (gnus-set-work-buffer)
- (let ((gnus-summary-line-format-spec spec))
- (gnus-summary-insert-line
- [0 "" "" "" "" "" 0 0 ""] 0 nil 128 t nil "" nil 1)
- (goto-char (point-min))
- (setq pos (list (cons 'unread (and (search-forward "\200" nil t)
- (- (point) 2)))))
- (goto-char (point-min))
- (push (cons 'replied (and (search-forward "\201" nil t)
- (- (point) 2)))
- pos)
- (goto-char (point-min))
- (push (cons 'score (and (search-forward "\202" nil t) (- (point) 2)))
- pos)))
- (setq gnus-summary-mark-positions pos))))
-
-(defun gnus-update-group-mark-positions ()
- (save-excursion
- (let ((gnus-process-mark 128)
- (gnus-group-marked '("dummy.group"))
- (gnus-active-hashtb (make-vector 10 0)))
- (gnus-set-active "dummy.group" '(0 . 0))
- (gnus-set-work-buffer)
- (gnus-group-insert-group-line "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))))))))
-
-(defvar gnus-mouse-face-0 'highlight)
-(defvar gnus-mouse-face-1 'highlight)
-(defvar gnus-mouse-face-2 'highlight)
-(defvar gnus-mouse-face-3 'highlight)
-(defvar gnus-mouse-face-4 'highlight)
-
-(defun gnus-mouse-face-function (form type)
- `(gnus-put-text-property
- (point) (progn ,@form (point))
- gnus-mouse-face-prop
- ,(if (equal type 0)
- 'gnus-mouse-face
- `(quote ,(symbol-value (intern (format "gnus-mouse-face-%d" type)))))))
-
-(defvar gnus-face-0 'bold)
-(defvar gnus-face-1 'italic)
-(defvar gnus-face-2 'bold-italic)
-(defvar gnus-face-3 'bold)
-(defvar gnus-face-4 'bold)
-
-(defun gnus-face-face-function (form type)
- `(gnus-put-text-property
- (point) (progn ,@form (point))
- 'face ',(symbol-value (intern (format "gnus-face-%d" type)))))
-
-(defun gnus-max-width-function (el max-width)
- (or (numberp max-width) (signal 'wrong-type-argument '(numberp max-width)))
- (if (symbolp el)
- `(if (> (length ,el) ,max-width)
- (substring ,el 0 ,max-width)
- ,el)
- `(let ((val (eval ,el)))
- (if (numberp val)
- (setq val (int-to-string val)))
- (if (> (length val) ,max-width)
- (substring val 0 ,max-width)
- val))))
-
-(defun gnus-parse-format (format spec-alist &optional insert)
- ;; This function parses the FORMAT string with the help of the
- ;; SPEC-ALIST and returns a list that can be eval'ed to return the
- ;; string. If the FORMAT string contains the specifiers %( and %)
- ;; the text between them will have the mouse-face text property.
- (if (string-match
- "\\`\\(.*\\)%[0-9]?[{(]\\(.*\\)%[0-9]?[})]\\(.*\n?\\)\\'"
- format)
- (gnus-parse-complex-format format spec-alist)
- ;; This is a simple format.
- (gnus-parse-simple-format format spec-alist insert)))
-
-(defun gnus-parse-complex-format (format spec-alist)
- (save-excursion
- (gnus-set-work-buffer)
- (insert format)
- (goto-char (point-min))
- (while (re-search-forward "\"" nil t)
- (replace-match "\\\"" nil t))
- (goto-char (point-min))
- (insert "(\"")
- (while (re-search-forward "%\\([0-9]+\\)?\\([{}()]\\)" nil t)
- (let ((number (if (match-beginning 1)
- (match-string 1) "0"))
- (delim (aref (match-string 2) 0)))
- (if (or (= delim ?\() (= delim ?\{))
- (replace-match (concat "\"(" (if (= delim ?\() "mouse" "face")
- " " number " \""))
- (replace-match "\")\""))))
- (goto-char (point-max))
- (insert "\")")
- (goto-char (point-min))
- (let ((form (read (current-buffer))))
- (cons 'progn (gnus-complex-form-to-spec form spec-alist)))))
-
-(defun gnus-complex-form-to-spec (form spec-alist)
- (delq nil
- (mapcar
- (lambda (sform)
- (if (stringp sform)
- (gnus-parse-simple-format sform spec-alist t)
- (funcall (intern (format "gnus-%s-face-function" (car sform)))
- (gnus-complex-form-to-spec (cddr sform) spec-alist)
- (nth 1 sform))))
- form)))
-
-(defun gnus-parse-simple-format (format spec-alist &optional insert)
- ;; This function parses the FORMAT string with the help of the
- ;; SPEC-ALIST and returns a list that can be eval'ed to return a
- ;; string.
- (let ((max-width 0)
- spec flist fstring newspec elem beg result dontinsert)
- (save-excursion
- (gnus-set-work-buffer)
- (insert format)
- (goto-char (point-min))
- (while (re-search-forward "%[-0-9]*\\(,[0-9]+\\)?\\([^0-9]\\)\\(.\\)?"
- nil t)
- (if (= (setq spec (string-to-char (match-string 2))) ?%)
- (setq newspec "%"
- beg (1+ (match-beginning 0)))
- ;; First check if there are any specs that look anything like
- ;; "%12,12A", ie. with a "max width specification". These have
- ;; to be treated specially.
- (if (setq beg (match-beginning 1))
- (setq max-width
- (string-to-int
- (buffer-substring
- (1+ (match-beginning 1)) (match-end 1))))
- (setq max-width 0)
- (setq beg (match-beginning 2)))
- ;; Find the specification from `spec-alist'.
- (unless (setq elem (cdr (assq spec spec-alist)))
- (setq elem '("*" ?s)))
- ;; Treat user defined format specifiers specially.
- (when (eq (car elem) 'gnus-tmp-user-defined)
- (setq elem
- (list
- (list (intern (concat "gnus-user-format-function-"
- (match-string 3)))
- 'gnus-tmp-header) ?s))
- (delete-region (match-beginning 3) (match-end 3)))
- (if (not (zerop max-width))
- (let ((el (car elem)))
- (cond ((= (cadr elem) ?c)
- (setq el (list 'char-to-string el)))
- ((= (cadr elem) ?d)
- (setq el (list 'int-to-string el))))
- (setq flist (cons (gnus-max-width-function el max-width)
- flist))
- (setq newspec ?s))
- (progn
- (setq flist (cons (car elem) flist))
- (setq newspec (cadr elem)))))
- ;; Remove the old specification (and possibly a ",12" string).
- (delete-region beg (match-end 2))
- ;; Insert the new specification.
- (goto-char beg)
- (insert newspec))
- (setq fstring (buffer-substring 1 (point-max))))
- ;; Do some postprocessing to increase efficiency.
- (setq
- result
- (cond
- ;; Emptyness.
- ((string= fstring "")
- nil)
- ;; Not a format string.
- ((not (string-match "%" fstring))
- (list fstring))
- ;; A format string with just a single string spec.
- ((string= fstring "%s")
- (list (car flist)))
- ;; A single character.
- ((string= fstring "%c")
- (list (car flist)))
- ;; A single number.
- ((string= fstring "%d")
- (setq dontinsert)
- (if insert
- (list `(princ ,(car flist)))
- (list `(int-to-string ,(car flist)))))
- ;; Just lots of chars and strings.
- ((string-match "\\`\\(%[cs]\\)+\\'" fstring)
- (nreverse flist))
- ;; A single string spec at the beginning of the spec.
- ((string-match "\\`%[sc][^%]+\\'" fstring)
- (list (car flist) (substring fstring 2)))
- ;; A single string spec in the middle of the spec.
- ((string-match "\\`\\([^%]+\\)%[sc]\\([^%]+\\)\\'" fstring)
- (list (match-string 1 fstring) (car flist) (match-string 2 fstring)))
- ;; A single string spec in the end of the spec.
- ((string-match "\\`\\([^%]+\\)%[sc]\\'" fstring)
- (list (match-string 1 fstring) (car flist)))
- ;; A more complex spec.
- (t
- (list (cons 'format (cons fstring (nreverse flist)))))))
-
- (if insert
- (when result
- (if dontinsert
- result
- (cons 'insert result)))
- (cond ((stringp result)
- result)
- ((consp result)
- (cons 'concat result))
- (t "")))))
-
-(defun gnus-eval-format (format &optional alist props)
- "Eval the format variable FORMAT, using ALIST.
-If PROPS, insert the result."
- (let ((form (gnus-parse-format format alist props)))
- (if props
- (gnus-add-text-properties (point) (progn (eval form) (point)) props)
- (eval form))))
-
-(defun gnus-remove-text-with-property (prop)
- "Delete all text in the current buffer with text property PROP."
- (save-excursion
- (goto-char (point-min))
- (while (not (eobp))
- (while (get-text-property (point) prop)
- (delete-char 1))
- (goto-char (next-single-property-change (point) prop nil (point-max))))))
-
-(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)))
-
-;; Article file names when saving.
-
-(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."
- (let ((default
- (expand-file-name
- (concat (if (gnus-use-long-file-name 'not-save)
- (gnus-capitalize-newsgroup newsgroup)
- (gnus-newsgroup-directory-form newsgroup))
- "/" (int-to-string (mail-header-number headers)))
- gnus-article-save-directory)))
- (if (and last-file
- (string-equal (file-name-directory default)
- (file-name-directory last-file))
- (string-match "^[0-9]+$" (file-name-nondirectory last-file)))
- default
- (or last-file 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 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 (mail-header-number headers)))
- gnus-article-save-directory)))
- (if (and last-file
- (string-equal (file-name-directory default)
- (file-name-directory last-file))
- (string-match "^[0-9]+$" (file-name-nondirectory last-file)))
- default
- (or last-file 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 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)
- (gnus-capitalize-newsgroup newsgroup)
- (concat (gnus-newsgroup-directory-form newsgroup) "/news"))
- gnus-article-save-directory)))
-
-(defun gnus-plain-save-name (newsgroup headers &optional last-file)
- "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
-If 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)
- newsgroup
- (concat (gnus-newsgroup-directory-form newsgroup) "/news"))
- gnus-article-save-directory)))
-
-;; For subscribing new newsgroup
-
-(defun gnus-subscribe-hierarchical-interactive (groups)
- (let ((groups (sort groups 'string<))
- prefixes prefix start ans group starts)
- (while groups
- (setq prefixes (list "^"))
- (while (and groups prefixes)
- (while (not (string-match (car prefixes) (car groups)))
- (setq prefixes (cdr prefixes)))
- (setq prefix (car prefixes))
- (setq start (1- (length prefix)))
- (if (and (string-match "[^\\.]\\." (car groups) start)
- (cdr groups)
- (setq prefix
- (concat "^" (substring (car groups) 0 (match-end 0))))
- (string-match prefix (cadr groups)))
- (progn
- (setq prefixes (cons prefix prefixes))
- (message "Descend hierarchy %s? ([y]nsq): "
- (substring prefix 1 (1- (length prefix))))
- (setq ans (read-char))
- (cond ((= ans ?n)
- (while (and groups
- (string-match prefix
- (setq group (car groups))))
- (setq gnus-killed-list
- (cons group gnus-killed-list))
- (gnus-sethash group group gnus-killed-hashtb)
- (setq groups (cdr groups)))
- (setq starts (cdr starts)))
- ((= ans ?s)
- (while (and groups
- (string-match prefix
- (setq group (car groups))))
- (gnus-sethash group group gnus-killed-hashtb)
- (gnus-subscribe-alphabetically (car groups))
- (setq groups (cdr groups)))
- (setq starts (cdr starts)))
- ((= ans ?q)
- (while groups
- (setq group (car groups))
- (setq gnus-killed-list (cons group gnus-killed-list))
- (gnus-sethash group group gnus-killed-hashtb)
- (setq groups (cdr groups))))
- (t nil)))
- (message "Subscribe %s? ([n]yq)" (car groups))
- (setq ans (read-char))
- (setq group (car groups))
- (cond ((= ans ?y)
- (gnus-subscribe-alphabetically (car groups))
- (gnus-sethash group group gnus-killed-hashtb))
- ((= ans ?q)
- (while groups
- (setq group (car groups))
- (setq gnus-killed-list (cons group gnus-killed-list))
- (gnus-sethash group group gnus-killed-hashtb)
- (setq groups (cdr groups))))
- (t
- (setq gnus-killed-list (cons group gnus-killed-list))
- (gnus-sethash group group gnus-killed-hashtb)))
- (setq groups (cdr groups)))))))
-
-(defun gnus-subscribe-randomly (newsgroup)
- "Subscribe new NEWSGROUP by making it the first newsgroup."
- (gnus-subscribe-newsgroup newsgroup))
-
-(defun gnus-subscribe-alphabetically (newgroup)
- "Subscribe new NEWSGROUP and insert it in alphabetical order."
- (let ((groups (cdr gnus-newsrc-alist))
- before)
- (while (and (not before) groups)
- (if (string< newgroup (caar groups))
- (setq before (caar groups))
- (setq groups (cdr groups))))
- (gnus-subscribe-newsgroup newgroup before)))
-
-(defun gnus-subscribe-hierarchically (newgroup)
- "Subscribe new NEWSGROUP and insert it in hierarchical newsgroup order."
- ;; Basic ideas by mike-w@cs.aukuni.ac.nz (Mike Williams)
- (save-excursion
- (set-buffer (find-file-noselect gnus-current-startup-file))
- (let ((groupkey newgroup)
- before)
- (while (and (not before) groupkey)
- (goto-char (point-min))
- (let ((groupkey-re
- (concat "^\\(" (regexp-quote groupkey) ".*\\)[!:]")))
- (while (and (re-search-forward groupkey-re nil t)
- (progn
- (setq before (match-string 1))
- (string< before newgroup)))))
- ;; Remove tail of newsgroup name (eg. a.b.c -> a.b)
- (setq groupkey
- (if (string-match "^\\(.*\\)\\.[^.]+$" groupkey)
- (substring groupkey (match-beginning 1) (match-end 1)))))
- (gnus-subscribe-newsgroup newgroup before))))
-
-(defun gnus-subscribe-interactively (group)
- "Subscribe the new GROUP interactively.
-It is inserted in hierarchical newsgroup order if subscribed. If not,
-it is killed."
- (if (gnus-y-or-n-p (format "Subscribe new newsgroup: %s " group))
- (gnus-subscribe-hierarchically group)
- (push group gnus-killed-list)))
-
-(defun gnus-subscribe-zombies (group)
- "Make the new GROUP into a zombie group."
- (push group gnus-zombie-list))
-
-(defun gnus-subscribe-killed (group)
- "Make the new GROUP a killed group."
- (push group gnus-killed-list))
-
-(defun gnus-subscribe-newsgroup (newsgroup &optional next)
- "Subscribe new NEWSGROUP.
-If NEXT is non-nil, it is inserted before NEXT. Otherwise it is made
-the first newsgroup."
- ;; We subscribe the group by changing its level to `subscribed'.
- (gnus-group-change-level
- newsgroup gnus-level-default-subscribed
- gnus-level-killed (gnus-gethash (or next "dummy.group") gnus-newsrc-hashtb))
- (gnus-message 5 "Subscribe newsgroup: %s" newsgroup))
-
-;; For directories
-
-(defun gnus-newsgroup-directory-form (newsgroup)
- "Make hierarchical directory name from NEWSGROUP name."
- (let ((newsgroup (gnus-newsgroup-savable-name newsgroup))
- (len (length newsgroup))
- idx)
- ;; If this is a foreign group, we don't want to translate the
- ;; entire name.
- (if (setq idx (string-match ":" newsgroup))
- (aset newsgroup idx ?/)
- (setq idx 0))
- ;; Replace all occurrences of `.' with `/'.
- (while (< idx len)
- (if (= (aref newsgroup idx) ?.)
- (aset newsgroup idx ?/))
- (setq idx (1+ idx)))
- newsgroup))
-
-(defun gnus-newsgroup-savable-name (group)
- ;; Replace any slashes in a group name (eg. an ange-ftp nndoc group)
- ;; with dots.
- (nnheader-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 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))))
- ;; 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."
- (and (not (zerop (length newsgroup)))
- (concat (char-to-string (upcase (aref newsgroup 0)))
- (substring newsgroup 1))))
-
-;; Various... things.
-
-(defun gnus-simplify-subject (subject &optional re-only)
- "Remove `Re:' and words in parentheses.
-If RE-ONLY is non-nil, strip leading `Re:'s only."
- (let ((case-fold-search t)) ;Ignore case.
- ;; Remove `Re:', `Re^N:', `Re(n)', and `Re[n]:'.
- (when (string-match "\\`\\(re\\([[(^][0-9]+[])]?\\)?:[ \t]*\\)+" subject)
- (setq subject (substring subject (match-end 0))))
- ;; Remove uninteresting prefixes.
- (if (and (not re-only)
- gnus-simplify-ignored-prefixes
- (string-match gnus-simplify-ignored-prefixes subject))
- (setq subject (substring subject (match-end 0))))
- ;; Remove words in parentheses from end.
- (unless re-only
- (while (string-match "[ \t\n]*([^()]*)[ \t\n]*\\'" subject)
- (setq subject (substring subject 0 (match-beginning 0)))))
- ;; Return subject string.
- subject))
-
-;; Remove any leading "re:"s, any trailing paren phrases, and simplify
-;; all whitespace.
-;; Written by Stainless Steel Rat <ratinox@ccs.neu.edu>.
-(defun gnus-simplify-buffer-fuzzy ()
- (goto-char (point-min))
- (while (search-forward "\t" nil t)
- (replace-match " " t t))
- (goto-char (point-min))
- (re-search-forward "^ *\\(re\\|fwd\\)[[{(^0-9]*[])}]?[:;] *" nil t)
- (goto-char (match-beginning 0))
- (while (or
- (looking-at "^ *\\(re\\|fwd\\)[[{(^0-9]*[])}]?[:;] *")
- (looking-at "^[[].*: .*[]]$"))
- (goto-char (point-min))
- (while (re-search-forward "^ *\\(re\\|fwd\\)[[{(^0-9]*[])}]?[:;] *"
- nil t)
- (replace-match "" t t))
- (goto-char (point-min))
- (while (re-search-forward "^[[].*: .*[]]$" nil t)
- (goto-char (match-end 0))
- (delete-char -1)
- (delete-region
- (progn (goto-char (match-beginning 0)))
- (re-search-forward ":"))))
- (goto-char (point-min))
- (while (re-search-forward " *[[{(][^()\n]*[]})] *$" nil t)
- (replace-match "" t t))
- (goto-char (point-min))
- (while (re-search-forward " +" nil t)
- (replace-match " " t t))
- (goto-char (point-min))
- (while (re-search-forward " $" nil t)
- (replace-match "" t t))
- (goto-char (point-min))
- (while (re-search-forward "^ +" nil t)
- (replace-match "" t t))
- (goto-char (point-min))
- (when gnus-simplify-subject-fuzzy-regexp
- (if (listp gnus-simplify-subject-fuzzy-regexp)
- (let ((list gnus-simplify-subject-fuzzy-regexp))
- (while list
- (goto-char (point-min))
- (while (re-search-forward (car list) nil t)
- (replace-match "" t t))
- (setq list (cdr list))))
- (while (re-search-forward gnus-simplify-subject-fuzzy-regexp nil t)
- (replace-match "" t t)))))
-
-(defun gnus-simplify-subject-fuzzy (subject)
- "Siplify a subject string fuzzily."
- (save-excursion
- (gnus-set-work-buffer)
- (let ((case-fold-search t))
- (insert subject)
- (inline (gnus-simplify-buffer-fuzzy))
- (buffer-string))))
-
;; Add the current buffer to the list of buffers to be killed on exit.
(defun gnus-add-current-to-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)
- (string= s1 s2))))
-
-(defun gnus-read-active-file-p ()
- "Say whether the active file has been read from `gnus-select-method'."
- (memq gnus-select-method gnus-have-read-active-file))
-
-;;; General various misc type functions.
-
-(defun gnus-clear-system ()
- "Clear all variables and buffers."
- ;; Clear Gnus variables.
- (let ((variables gnus-variable-list))
- (while variables
- (set (car variables) nil)
- (setq variables (cdr variables))))
- ;; Clear other internal variables.
- (setq gnus-list-of-killed-groups nil
- gnus-have-read-active-file nil
- gnus-newsrc-alist nil
- gnus-newsrc-hashtb nil
- gnus-killed-list nil
- gnus-zombie-list nil
- gnus-killed-hashtb nil
- gnus-active-hashtb nil
- gnus-moderated-list nil
- gnus-description-hashtb nil
- gnus-current-headers nil
- gnus-thread-indent-array nil
- gnus-newsgroup-headers nil
- gnus-newsgroup-name nil
- gnus-server-alist nil
- gnus-group-list-mode nil
- gnus-opened-servers nil
- gnus-current-select-method nil)
- (gnus-shutdown 'gnus)
- ;; Kill the startup file.
- (and gnus-current-startup-file
- (get-file-buffer gnus-current-startup-file)
- (kill-buffer (get-file-buffer gnus-current-startup-file)))
- ;; Clear the dribble buffer.
- (gnus-dribble-clear)
- ;; Kill global KILL file buffer.
- (when (get-file-buffer (gnus-newsgroup-kill-file nil))
- (kill-buffer (get-file-buffer (gnus-newsgroup-kill-file nil))))
- (gnus-kill-buffer nntp-server-buffer)
- ;; Kill Gnus buffers.
- (while gnus-buffer-list
- (gnus-kill-buffer (pop gnus-buffer-list)))
- ;; Remove Gnus frames.
- (while gnus-created-frames
- (when (frame-live-p (car gnus-created-frames))
- ;; We slap a condition-case around this `delete-frame' to ensure
- ;; agains errors if we try do delete the single frame that's left.
- (condition-case ()
- (delete-frame (car gnus-created-frames))
- (error nil)))
- (pop gnus-created-frames)))
-
-(defun gnus-windows-old-to-new (setting)
- ;; First we take care of the really, really old Gnus 3 actions.
- (when (symbolp setting)
- (setq setting
- ;; Take care of ooold GNUS 3.x values.
- (cond ((eq setting 'SelectArticle) 'article)
- ((memq setting '(SelectSubject ExpandSubject)) 'summary)
- ((memq setting '(SelectNewsgroup ExitNewsgroup)) 'group)
- (t setting))))
- (if (or (listp setting)
- (not (and gnus-window-configuration
- (memq setting '(group summary article)))))
- setting
- (let* ((setting (if (eq setting 'group)
- (if (assq 'newsgroup gnus-window-configuration)
- 'newsgroup
- 'newsgroups) setting))
- (elem (cadr (assq setting gnus-window-configuration)))
- (total (apply '+ elem))
- (types '(group summary article))
- (pbuf (if (eq setting 'newsgroups) 'group 'summary))
- (i 0)
- perc
- out)
- (while (< i 3)
- (or (not (numberp (nth i elem)))
- (zerop (nth i elem))
- (progn
- (setq perc (/ (float (nth 0 elem)) total))
- (setq out (cons (if (eq pbuf (nth i types))
- (vector (nth i types) perc 'point)
- (vector (nth i types) perc))
- out))))
- (setq i (1+ i)))
- (list (nreverse out)))))
+ (push (current-buffer) gnus-buffer-list)))
-;;;###autoload
-(defun gnus-add-configuration (conf)
- "Add the window configuration CONF to `gnus-buffer-configuration'."
- (setq gnus-buffer-configuration
- (cons conf (delq (assq (car conf) gnus-buffer-configuration)
- gnus-buffer-configuration))))
-
-(defvar gnus-frame-list nil)
-
-(defun gnus-configure-frame (split &optional window)
- "Split WINDOW according to SPLIT."
- (unless window
- (setq window (get-buffer-window (current-buffer))))
- (select-window window)
- ;; This might be an old-stylee buffer config.
- (when (vectorp split)
- (setq split (append split nil)))
- (when (or (consp (car split))
- (vectorp (car split)))
- (push 1.0 split)
- (push 'vertical split))
- ;; The SPLIT might be something that is to be evaled to
- ;; return a new SPLIT.
- (while (and (not (assq (car split) gnus-window-to-buffer))
- (gnus-functionp (car split)))
- (setq split (eval split)))
- (let* ((type (car split))
- (subs (cddr split))
- (len (if (eq type 'horizontal) (window-width) (window-height)))
- (total 0)
- (window-min-width (or gnus-window-min-width window-min-width))
- (window-min-height (or gnus-window-min-height window-min-height))
- s result new-win rest comp-subs size sub)
- (cond
- ;; Nothing to do here.
- ((null split))
- ;; Don't switch buffers.
- ((null type)
- (and (memq 'point split) window))
- ;; This is a buffer to be selected.
- ((not (memq type '(frame horizontal vertical)))
- (let ((buffer (cond ((stringp type) type)
- (t (cdr (assq type gnus-window-to-buffer)))))
- buf)
- (unless buffer
- (error "Illegal buffer type: %s" type))
- (unless (setq buf (get-buffer (if (symbolp buffer)
- (symbol-value buffer) buffer)))
- (setq buf (get-buffer-create (if (symbolp buffer)
- (symbol-value buffer) buffer))))
- (switch-to-buffer buf)
- ;; We return the window if it has the `point' spec.
- (and (memq 'point split) window)))
- ;; This is a frame split.
- ((eq type 'frame)
- (unless gnus-frame-list
- (setq gnus-frame-list (list (window-frame
- (get-buffer-window (current-buffer))))))
- (let ((i 0)
- params frame fresult)
- (while (< i (length subs))
- ;; Frame parameter is gotten from the sub-split.
- (setq params (cadr (elt subs i)))
- ;; It should be a list.
- (unless (listp params)
- (setq params nil))
- ;; Create a new frame?
- (unless (setq frame (elt gnus-frame-list i))
- (nconc gnus-frame-list (list (setq frame (make-frame params))))
- (push frame gnus-created-frames))
- ;; Is the old frame still alive?
- (unless (frame-live-p frame)
- (setcar (nthcdr i gnus-frame-list)
- (setq frame (make-frame params))))
- ;; Select the frame in question and do more splits there.
- (select-frame frame)
- (setq fresult (or (gnus-configure-frame (elt subs i)) fresult))
- (incf i))
- ;; Select the frame that has the selected buffer.
- (when fresult
- (select-frame (window-frame fresult)))))
- ;; This is a normal split.
- (t
- (when (> (length subs) 0)
- ;; First we have to compute the sizes of all new windows.
- (while subs
- (setq sub (append (pop subs) nil))
- (while (and (not (assq (car sub) gnus-window-to-buffer))
- (gnus-functionp (car sub)))
- (setq sub (eval sub)))
- (when sub
- (push sub comp-subs)
- (setq size (cadar comp-subs))
- (cond ((equal size 1.0)
- (setq rest (car comp-subs))
- (setq s 0))
- ((floatp size)
- (setq s (floor (* size len))))
- ((integerp size)
- (setq s size))
- (t
- (error "Illegal size: %s" size)))
- ;; Try to make sure that we are inside the safe limits.
- (cond ((zerop s))
- ((eq type 'horizontal)
- (setq s (max s window-min-width)))
- ((eq type 'vertical)
- (setq s (max s window-min-height))))
- (setcar (cdar comp-subs) s)
- (incf total s)))
- ;; Take care of the "1.0" spec.
- (if rest
- (setcar (cdr rest) (- len total))
- (error "No 1.0 specs in %s" split))
- ;; The we do the actual splitting in a nice recursive
- ;; fashion.
- (setq comp-subs (nreverse comp-subs))
- (while comp-subs
- (if (null (cdr comp-subs))
- (setq new-win window)
- (setq new-win
- (split-window window (cadar comp-subs)
- (eq type 'horizontal))))
- (setq result (or (gnus-configure-frame
- (car comp-subs) window) result))
- (select-window new-win)
- (setq window new-win)
- (setq comp-subs (cdr comp-subs))))
- ;; Return the proper window, if any.
- (when result
- (select-window result))))))
-
-(defvar gnus-frame-split-p nil)
-
-(defun gnus-configure-windows (setting &optional force)
- (setq setting (gnus-windows-old-to-new setting))
- (let ((split (if (symbolp setting)
- (cadr (assq setting gnus-buffer-configuration))
- setting))
- all-visible)
-
- (setq gnus-frame-split-p nil)
-
- (unless split
- (error "No such setting: %s" setting))
-
- (if (and (setq all-visible (gnus-all-windows-visible-p split))
- (not force))
- ;; All the windows mentioned are already visible, so we just
- ;; put point in the assigned buffer, and do not touch the
- ;; winconf.
- (select-window all-visible)
-
- ;; Either remove all windows or just remove all Gnus windows.
- (let ((frame (selected-frame)))
- (unwind-protect
- (if gnus-use-full-window
- ;; We want to remove all other windows.
- (if (not gnus-frame-split-p)
- ;; This is not a `frame' split, so we ignore the
- ;; other frames.
- (delete-other-windows)
- ;; This is a `frame' split, so we delete all windows
- ;; on all frames.
- (mapcar
- (lambda (frame)
- (unless (eq (cdr (assq 'minibuffer
- (frame-parameters frame)))
- 'only)
- (select-frame frame)
- (delete-other-windows)))
- (frame-list)))
- ;; Just remove some windows.
- (gnus-remove-some-windows)
- (switch-to-buffer nntp-server-buffer))
- (select-frame frame)))
-
- (switch-to-buffer nntp-server-buffer)
- (gnus-configure-frame split (get-buffer-window (current-buffer))))))
-
-(defun gnus-all-windows-visible-p (split)
- "Say whether all buffers in SPLIT are currently visible.
-In particular, the value returned will be the window that
-should have point."
- (let ((stack (list split))
- (all-visible t)
- type buffer win buf)
- (while (and (setq split (pop stack))
- all-visible)
- ;; Be backwards compatible.
- (when (vectorp split)
- (setq split (append split nil)))
- (when (or (consp (car split))
- (vectorp (car split)))
- (push 1.0 split)
- (push 'vertical split))
- ;; The SPLIT might be something that is to be evaled to
- ;; return a new SPLIT.
- (while (and (not (assq (car split) gnus-window-to-buffer))
- (gnus-functionp (car split)))
- (setq split (eval split)))
-
- (setq type (elt split 0))
- (cond
- ;; Nothing here.
- ((null split) t)
- ;; A buffer.
- ((not (memq type '(horizontal vertical frame)))
- (setq buffer (cond ((stringp type) type)
- (t (cdr (assq type gnus-window-to-buffer)))))
- (unless buffer
- (error "Illegal buffer type: %s" type))
- (when (setq buf (get-buffer (if (symbolp buffer)
- (symbol-value buffer)
- buffer)))
- (setq win (get-buffer-window buf t)))
- (if win
- (when (memq 'point split)
- (setq all-visible win))
- (setq all-visible nil)))
- (t
- (when (eq type 'frame)
- (setq gnus-frame-split-p t))
- (setq stack (append (cddr split) stack)))))
- (unless (eq all-visible t)
- all-visible)))
-
-(defun gnus-window-top-edge (&optional window)
- (nth 1 (window-edges window)))
-
-(defun gnus-remove-some-windows ()
- (let ((buffers gnus-window-to-buffer)
- buf bufs lowest-buf lowest)
- (save-excursion
- ;; Remove windows on all known Gnus buffers.
- (while buffers
- (setq buf (cdar 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.
- (walk-windows
- (lambda (win)
- (let ((buf (window-buffer win)))
- (if (string-match "^\\*Summary" (buffer-name buf))
- (progn
- (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)
+(defun gnus-version (&optional arg)
+ "Version number of this version of Gnus.
+If ARG, insert string at point."
+ (interactive "P")
(let ((methods gnus-valid-select-methods)
(mess gnus-version)
meth)
(stringp (symbol-value meth))
(setq mess (concat mess "; " (symbol-value meth))))
(setq methods (cdr methods)))
- (gnus-message 2 mess)))
+ (if arg
+ (insert (message mess))
+ (message mess))))
+
+(defun gnus-continuum-version (version)
+ "Return VERSION as a floating point number."
+ (when (or (string-match "^\\([^ ]+\\)? ?Gnus v?\\([0-9.]+\\)$" version)
+ (string-match "^\\(.?\\)gnus-\\([0-9.]+\\)$" version))
+ (let* ((alpha (and (match-beginning 1) (match-string 1 version)))
+ (number (match-string 2 version))
+ major minor least)
+ (string-match "\\([0-9]\\)\\.\\([0-9]+\\)\\.?\\([0-9]+\\)?" number)
+ (setq major (string-to-number (match-string 1 number)))
+ (setq minor (string-to-number (match-string 2 number)))
+ (setq least (if (match-beginning 3)
+ (string-to-number (match-string 3 number))
+ 0))
+ (string-to-number
+ (if (zerop major)
+ (format "%s00%02d%02d"
+ (cond
+ ((member alpha '("(ding)" "d")) "4.99")
+ ((member alpha '("September" "s")) "5.01")
+ ((member alpha '("Red" "r")) "5.03"))
+ minor least)
+ (format "%d.%02d%02d" major minor least))))))
(defun gnus-info-find-node ()
"Find Info documentation of Gnus."
(interactive)
;; Enlarge info window if needed.
- (let ((mode major-mode)
- gnus-info-buffer)
- (Info-goto-node (cadr (assq mode gnus-info-nodes)))
+ (let (gnus-info-buffer)
+ (Info-goto-node (cadr (assq major-mode gnus-info-nodes)))
(setq gnus-info-buffer (current-buffer))
(gnus-configure-windows 'info)))
-(defun gnus-days-between (date1 date2)
- ;; Return the number of days between date1 and date2.
- (- (gnus-day-number date1) (gnus-day-number date2)))
-
-(defun gnus-day-number (date)
- (let ((dat (mapcar (lambda (s) (and s (string-to-int s)) )
- (timezone-parse-date date))))
- (timezone-absolute-from-gregorian
- (nth 1 dat) (nth 2 dat) (car dat))))
-
-(defun gnus-encode-date (date)
- "Convert DATE to internal time."
- (let* ((parse (timezone-parse-date date))
- (date (mapcar (lambda (d) (and d (string-to-int d))) parse))
- (time (mapcar 'string-to-int (timezone-parse-time (aref parse 3)))))
- (encode-time (caddr time) (cadr time) (car time)
- (caddr date) (cadr date) (car date) (nth 4 date))))
-
-(defun gnus-time-minus (t1 t2)
- "Subtract two internal times."
- (let ((borrow (< (cadr t1) (cadr t2))))
- (list (- (car t1) (car t2) (if borrow 1 0))
- (- (+ (if borrow 65536 0) (cadr t1)) (cadr t2)))))
-
-(defun gnus-file-newer-than (file date)
- (let ((fdate (nth 5 (file-attributes file))))
- (or (> (car fdate) (car date))
- (and (= (car fdate) (car date))
- (> (nth 1 fdate) (nth 1 date))))))
-
-(defmacro gnus-local-set-keys (&rest plist)
- "Set the keys in PLIST in the current keymap."
- `(gnus-define-keys-1 (current-local-map) ',plist))
-
-(defmacro gnus-define-keys (keymap &rest plist)
- "Define all keys in PLIST in KEYMAP."
- `(gnus-define-keys-1 (quote ,keymap) (quote ,plist)))
-
-(put 'gnus-define-keys 'lisp-indent-function 1)
-(put 'gnus-define-keys 'lisp-indent-hook 1)
-(put 'gnus-define-keymap 'lisp-indent-function 1)
-(put 'gnus-define-keymap 'lisp-indent-hook 1)
-
-(defmacro gnus-define-keymap (keymap &rest plist)
- "Define all keys in PLIST in KEYMAP."
- `(gnus-define-keys-1 ,keymap (quote ,plist)))
-
-(defun gnus-define-keys-1 (keymap plist)
- (when (null keymap)
- (error "Can't set keys in a null keymap"))
- (cond ((symbolp keymap)
- (setq keymap (symbol-value keymap)))
- ((keymapp keymap))
- ((listp keymap)
- (set (car keymap) nil)
- (define-prefix-command (car keymap))
- (define-key (symbol-value (caddr keymap)) (cadr keymap) (car keymap))
- (setq keymap (symbol-value (car keymap)))))
- (let (key)
- (while plist
- (when (symbolp (setq key (pop plist)))
- (setq key (symbol-value key)))
- (define-key keymap key (pop plist)))))
+;;; More various functions.
(defun gnus-group-read-only-p (&optional group)
"Check whether GROUP supports editing or not.
(defun gnus-group-total-expirable-p (group)
"Check whether GROUP is total-expirable or not."
- (let ((params (gnus-info-params (gnus-get-info group))))
- (or (memq 'total-expire params)
- (cdr (assq 'total-expire params)) ; (total-expire . t)
- (and gnus-total-expirable-newsgroups ; Check var.
- (string-match gnus-total-expirable-newsgroups group)))))
+ (let ((params (gnus-group-find-parameter group))
+ val)
+ (cond
+ ((memq 'total-expire params)
+ t)
+ ((setq val (assq 'total-expire params)) ; (auto-expire . t)
+ (cdr val))
+ (gnus-total-expirable-newsgroups ; Check var.
+ (string-match gnus-total-expirable-newsgroups group)))))
(defun gnus-group-auto-expirable-p (group)
"Check whether GROUP is total-expirable or not."
- (let ((params (gnus-info-params (gnus-get-info group))))
- (or (memq 'auto-expire params)
- (cdr (assq 'auto-expire params)) ; (auto-expire . t)
- (and gnus-auto-expirable-newsgroups ; Check var.
- (string-match gnus-auto-expirable-newsgroups group)))))
+ (let ((params (gnus-group-find-parameter group))
+ val)
+ (cond
+ ((memq 'auto-expire params)
+ t)
+ ((setq val (assq 'auto-expire params)) ; (auto-expire . t)
+ (cdr val))
+ (gnus-auto-expirable-newsgroups ; Check var.
+ (string-match gnus-auto-expirable-newsgroups group)))))
(defun gnus-virtual-group-p (group)
"Say whether GROUP is virtual or not."
(and (gnus-member-of-valid 'post-mail group) ; Combined group.
(eq (gnus-request-type group article) 'news))))
-(defsubst gnus-simplify-subject-fully (subject)
- "Simplify a subject string according to the user's wishes."
- (cond
- ((null gnus-summary-gather-subject-limit)
- (gnus-simplify-subject-re subject))
- ((eq gnus-summary-gather-subject-limit 'fuzzy)
- (gnus-simplify-subject-fuzzy subject))
- ((numberp gnus-summary-gather-subject-limit)
- (gnus-limit-string (gnus-simplify-subject-re subject)
- gnus-summary-gather-subject-limit))
- (t
- subject)))
-
-(defsubst gnus-subject-equal (s1 s2 &optional simple-first)
- "Check whether two subjects are equal. If optional argument
-simple-first is t, first argument is already simplified."
- (cond
- ((null simple-first)
- (equal (gnus-simplify-subject-fully s1)
- (gnus-simplify-subject-fully s2)))
- (t
- (equal s1
- (gnus-simplify-subject-fully s2)))))
-
;; Returns a list of writable groups.
(defun gnus-writable-groups ()
(let ((alist gnus-newsrc-alist)
(push group groups)))
(nreverse groups)))
-(defun gnus-completing-read (default prompt &rest args)
- ;; Like `completing-read', except that DEFAULT is the default argument.
- (let* ((prompt (if default
- (concat prompt " (default " default ") ")
- (concat prompt " ")))
- (answer (apply 'completing-read prompt args)))
- (if (or (null answer) (zerop (length answer)))
- default
- answer)))
-
-;; Two silly functions to ensure that all `y-or-n-p' questions clear
-;; the echo area.
-(defun gnus-y-or-n-p (prompt)
- (prog1
- (y-or-n-p prompt)
- (message "")))
-
-(defun gnus-yes-or-no-p (prompt)
- (prog1
- (yes-or-no-p prompt)
- (message "")))
-
;; Check whether to use long file names.
(defun gnus-use-long-file-name (symbol)
;; The variable has to be set...
;; return nil.
(not (memq symbol gnus-use-long-file-name)))))
-;; I suspect there's a better way, but I haven't taken the time to do
-;; it yet. -erik selberg@cs.washington.edu
-(defun gnus-dd-mmm (messy-date)
- "Return a string like DD-MMM from a big messy string"
- (let ((datevec (condition-case () (timezone-parse-date messy-date)
- (error nil))))
- (if (not datevec)
- "??-???"
- (format "%2s-%s"
- (condition-case ()
- ;; Make sure leading zeroes are stripped.
- (number-to-string (string-to-number (aref datevec 2)))
- (error "??"))
- (capitalize
- (or (car
- (nth (1- (string-to-number (aref datevec 1)))
- timezone-months-assoc))
- "???"))))))
-
-(defun gnus-mode-string-quote (string)
- "Quote all \"%\" in STRING."
- (save-excursion
- (gnus-set-work-buffer)
- (insert string)
- (goto-char (point-min))
- (while (search-forward "%" nil t)
- (insert "%"))
- (buffer-string)))
-
-;; Make a hash table (default and minimum size is 255).
-;; Optional argument HASHSIZE specifies the table size.
-(defun gnus-make-hashtable (&optional hashsize)
- (make-vector (if hashsize (max (gnus-create-hash-size hashsize) 255) 255) 0))
-
-;; Make a number that is suitable for hashing; bigger than MIN and one
-;; less than 2^x.
-(defun gnus-create-hash-size (min)
- (let ((i 1))
- (while (< i min)
- (setq i (* 2 i)))
- (1- i)))
-
-;; Show message if message has a lower level than `gnus-verbose'.
-;; Guideline for numbers:
-;; 1 - error messages, 3 - non-serious error messages, 5 - messages
-;; for things that take a long time, 7 - not very important messages
-;; on stuff, 9 - messages inside loops.
-(defun gnus-message (level &rest args)
- (if (<= level gnus-verbose)
- (apply 'message args)
- ;; We have to do this format thingy here even if the result isn't
- ;; shown - the return value has to be the same as the return value
- ;; from `message'.
- (apply 'format args)))
-
-(defun gnus-error (level &rest args)
- "Beep an error if `gnus-verbose' is on LEVEL or less."
- (when (<= (floor level) gnus-verbose)
- (apply 'message args)
- (ding)
- (let (duration)
- (when (and (floatp level)
- (not (zerop (setq duration (* 10 (- level (floor level)))))))
- (sit-for duration))))
- nil)
-
;; Generate a unique new group name.
(defun gnus-generate-new-group-name (leaf)
(let ((name leaf)
(setq name (concat leaf "<" (int-to-string (setq num (1+ num))) ">")))
name))
-(defsubst gnus-hide-text (b e props)
- "Set text PROPS on the B to E region, extending `intangible' 1 past B."
- (gnus-add-text-properties b e props)
- (when (memq 'intangible props)
- (gnus-put-text-property (max (1- b) (point-min))
- b 'intangible (cddr (memq 'intangible props)))))
-
-(defsubst gnus-unhide-text (b e)
- "Remove hidden text properties from region between B and E."
- (remove-text-properties b e gnus-hidden-properties)
- (when (memq 'intangible gnus-hidden-properties)
- (gnus-put-text-property (max (1- b) (point-min))
- b 'intangible nil)))
-
-(defun gnus-hide-text-type (b e type)
- "Hide text of TYPE between B and E."
- (gnus-hide-text b e (cons 'gnus-type (cons type gnus-hidden-properties))))
-
-;; Find out whether the gnus-visual TYPE is wanted.
-(defun gnus-visual-p (&optional type class)
- (and gnus-visual ; Has to be non-nil, at least.
- (if (not type) ; We don't care about type.
- gnus-visual
- (if (listp gnus-visual) ; It's a list, so we check it.
- (or (memq type gnus-visual)
- (memq class gnus-visual))
- t))))
-
-(defun gnus-parent-headers (headers &optional generation)
- "Return the headers of the GENERATIONeth parent of HEADERS."
- (unless generation
- (setq generation 1))
- (let (references parent)
- (while (and headers (not (zerop generation)))
- (setq references (mail-header-references headers))
- (when (and references
- (setq parent (gnus-parent-id references))
- (setq headers (car (gnus-id-to-thread parent))))
- (decf generation)))
- headers))
-
-(defun gnus-parent-id (references)
- "Return the last Message-ID in REFERENCES."
- (when (and references
- (string-match "\\(<[^\n<>]+>\\)[ \t\n]*\\'" references))
- (substring references (match-beginning 1) (match-end 1))))
-
-(defun gnus-split-references (references)
- "Return a list of Message-IDs in REFERENCES."
- (let ((beg 0)
- ids)
- (while (string-match "<[^>]+>" references beg)
- (push (substring references (match-beginning 0) (setq beg (match-end 0)))
- ids))
- (nreverse ids)))
-
-(defun gnus-buffer-live-p (buffer)
- "Say whether BUFFER is alive or not."
- (and buffer
- (get-buffer buffer)
- (buffer-name (get-buffer buffer))))
-
(defun gnus-ephemeral-group-p (group)
"Say whether GROUP is ephemeral or not."
(gnus-group-get-parameter group 'quit-config))
"Return the quit-config of GROUP."
(gnus-group-get-parameter group 'quit-config))
+(defun gnus-kill-ephemeral-group (group)
+ "Remove ephemeral GROUP from relevant structures."
+ (gnus-sethash group nil gnus-newsrc-hashtb))
+
(defun gnus-simplify-mode-line ()
"Make mode lines a bit simpler."
(setq mode-line-modified "-- ")
(when (equal (nth 3 mode-line-format) " ")
(setcar (nthcdr 3 mode-line-format) " "))))
-;;; List and range functions
-
-(defun gnus-last-element (list)
- "Return last element of LIST."
- (while (cdr list)
- (setq list (cdr list)))
- (car list))
-
-(defun gnus-copy-sequence (list)
- "Do a complete, total copy of a list."
- (if (and (consp list) (not (consp (cdr list))))
- (cons (car list) (cdr list))
- (mapcar (lambda (elem) (if (consp elem)
- (if (consp (cdr elem))
- (gnus-copy-sequence elem)
- (cons (car elem) (cdr elem)))
- elem))
- list)))
-
-(defun gnus-set-difference (list1 list2)
- "Return a list of elements of LIST1 that do not appear in LIST2."
- (let ((list1 (copy-sequence list1)))
- (while list2
- (setq list1 (delq (car list2) list1))
- (setq list2 (cdr list2)))
- list1))
-
-(defun gnus-sorted-complement (list1 list2)
- "Return a list of elements of LIST1 that do not appear in LIST2.
-Both lists have to be sorted over <."
- (let (out)
- (if (or (null list1) (null list2))
- (or list1 list2)
- (while (and list1 list2)
- (cond ((= (car list1) (car list2))
- (setq list1 (cdr list1)
- list2 (cdr list2)))
- ((< (car list1) (car list2))
- (setq out (cons (car list1) out))
- (setq list1 (cdr list1)))
- (t
- (setq out (cons (car list2) out))
- (setq list2 (cdr list2)))))
- (nconc (nreverse out) (or list1 list2)))))
-
-(defun gnus-intersection (list1 list2)
- (let ((result nil))
- (while list2
- (if (memq (car list2) list1)
- (setq result (cons (car list2) result)))
- (setq list2 (cdr list2)))
- result))
-
-(defun gnus-sorted-intersection (list1 list2)
- ;; LIST1 and LIST2 have to be sorted over <.
- (let (out)
- (while (and list1 list2)
- (cond ((= (car list1) (car list2))
- (setq out (cons (car list1) out)
- list1 (cdr list1)
- list2 (cdr list2)))
- ((< (car list1) (car list2))
- (setq list1 (cdr list1)))
- (t
- (setq list2 (cdr list2)))))
- (nreverse out)))
-
-(defun gnus-set-sorted-intersection (list1 list2)
- ;; LIST1 and LIST2 have to be sorted over <.
- ;; 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)))
-
-(defun gnus-compress-sequence (numbers &optional always-list)
- "Convert list of numbers to a list of ranges or a single range.
-If ALWAYS-LIST is non-nil, this function will always release a list of
-ranges."
- (let* ((first (car numbers))
- (last (car numbers))
- result)
- (if (null numbers)
- nil
- (if (not (listp (cdr numbers)))
- numbers
- (while numbers
- (cond ((= last (car numbers)) nil) ;Omit duplicated number
- ((= (1+ last) (car numbers)) ;Still in sequence
- (setq last (car numbers)))
- (t ;End of one sequence
- (setq result
- (cons (if (= first last) first
- (cons first last)) result))
- (setq first (car numbers))
- (setq last (car numbers))))
- (setq numbers (cdr numbers)))
- (if (and (not always-list) (null result))
- (if (= first last) (list first) (cons first last))
- (nreverse (cons (if (= first last) first (cons first last))
- result)))))))
-
-(defalias 'gnus-uncompress-sequence 'gnus-uncompress-range)
-(defun gnus-uncompress-range (ranges)
- "Expand a list of ranges into a list of numbers.
-RANGES is either a single range on the form `(num . num)' or a list of
-these ranges."
- (let (first last result)
- (cond
- ((null ranges)
- nil)
- ((not (listp (cdr ranges)))
- (setq first (car ranges))
- (setq last (cdr ranges))
- (while (<= first last)
- (setq result (cons first result))
- (setq first (1+ first)))
- (nreverse result))
- (t
- (while ranges
- (if (atom (car ranges))
- (if (numberp (car ranges))
- (setq result (cons (car ranges) result)))
- (setq first (caar ranges))
- (setq last (cdar ranges))
- (while (<= first last)
- (setq result (cons first result))
- (setq first (1+ first))))
- (setq ranges (cdr ranges)))
- (nreverse result)))))
-
-(defun gnus-add-to-range (ranges list)
- "Return a list of ranges that has all articles from both RANGES and LIST.
-Note: LIST has to be sorted over `<'."
- (if (not ranges)
- (gnus-compress-sequence list t)
- (setq list (copy-sequence list))
- (or (listp (cdr ranges))
- (setq ranges (list ranges)))
- (let ((out ranges)
- ilist lowest highest temp)
- (while (and ranges list)
- (setq ilist list)
- (setq lowest (or (and (atom (car ranges)) (car ranges))
- (caar ranges)))
- (while (and list (cdr list) (< (cadr list) lowest))
- (setq list (cdr list)))
- (if (< (car ilist) lowest)
- (progn
- (setq temp list)
- (setq list (cdr list))
- (setcdr temp nil)
- (setq out (nconc (gnus-compress-sequence ilist t) out))))
- (setq highest (or (and (atom (car ranges)) (car ranges))
- (cdar ranges)))
- (while (and list (<= (car list) highest))
- (setq list (cdr list)))
- (setq ranges (cdr ranges)))
- (if list
- (setq out (nconc (gnus-compress-sequence list t) out)))
- (setq out (sort out (lambda (r1 r2)
- (< (or (and (atom r1) r1) (car r1))
- (or (and (atom r2) r2) (car r2))))))
- (setq ranges out)
- (while ranges
- (if (atom (car ranges))
- (if (cdr ranges)
- (if (atom (cadr ranges))
- (if (= (1+ (car ranges)) (cadr ranges))
- (progn
- (setcar ranges (cons (car ranges)
- (cadr ranges)))
- (setcdr ranges (cddr ranges))))
- (if (= (1+ (car ranges)) (caadr ranges))
- (progn
- (setcar (cadr ranges) (car ranges))
- (setcar ranges (cadr ranges))
- (setcdr ranges (cddr ranges))))))
- (if (cdr ranges)
- (if (atom (cadr ranges))
- (if (= (1+ (cdar ranges)) (cadr ranges))
- (progn
- (setcdr (car ranges) (cadr ranges))
- (setcdr ranges (cddr ranges))))
- (if (= (1+ (cdar ranges)) (caadr ranges))
- (progn
- (setcdr (car ranges) (cdadr ranges))
- (setcdr ranges (cddr ranges)))))))
- (setq ranges (cdr ranges)))
- out)))
-
-(defun gnus-remove-from-range (ranges list)
- "Return a list of ranges that has all articles from LIST removed from RANGES.
-Note: LIST has to be sorted over `<'."
- ;; !!! This function shouldn't look like this, but I've got a headache.
- (gnus-compress-sequence
- (gnus-sorted-complement
- (gnus-uncompress-range ranges) list)))
-
-(defun gnus-member-of-range (number ranges)
- (if (not (listp (cdr ranges)))
- (and (>= number (car ranges))
- (<= number (cdr ranges)))
- (let ((not-stop t))
- (while (and ranges
- (if (numberp (car ranges))
- (>= number (car ranges))
- (>= number (caar ranges)))
- not-stop)
- (if (if (numberp (car ranges))
- (= number (car ranges))
- (and (>= number (caar ranges))
- (<= number (cdar ranges))))
- (setq not-stop nil))
- (setq ranges (cdr ranges)))
- (not not-stop))))
-
-(defun gnus-range-length (range)
- "Return the length RANGE would have if uncompressed."
- (length (gnus-uncompress-range range)))
-
-(defun gnus-sublist-p (list sublist)
- "Test whether all elements in SUBLIST are members of LIST."
- (let ((sublistp t))
- (while sublist
- (unless (memq (pop sublist) list)
- (setq sublistp nil
- sublist nil)))
- sublistp))
-
-\f
-;;;
-;;; Gnus group mode
-;;;
-
-(defvar gnus-group-mode-map nil)
-(put 'gnus-group-mode 'mode-class 'special)
-
-(unless gnus-group-mode-map
- (setq gnus-group-mode-map (make-keymap))
- (suppress-keymap gnus-group-mode-map)
-
- (gnus-define-keys gnus-group-mode-map
- " " gnus-group-read-group
- "=" gnus-group-select-group
- "\r" gnus-group-select-group
- "\M-\r" gnus-group-quick-select-group
- "j" gnus-group-jump-to-group
- "n" gnus-group-next-unread-group
- "p" gnus-group-prev-unread-group
- "\177" gnus-group-prev-unread-group
- [delete] gnus-group-prev-unread-group
- "N" gnus-group-next-group
- "P" gnus-group-prev-group
- "\M-n" gnus-group-next-unread-group-same-level
- "\M-p" gnus-group-prev-unread-group-same-level
- "," gnus-group-best-unread-group
- "." gnus-group-first-unread-group
- "u" gnus-group-unsubscribe-current-group
- "U" gnus-group-unsubscribe-group
- "c" gnus-group-catchup-current
- "C" gnus-group-catchup-current-all
- "l" gnus-group-list-groups
- "L" gnus-group-list-all-groups
- "m" gnus-group-mail
- "g" gnus-group-get-new-news
- "\M-g" gnus-group-get-new-news-this-group
- "R" gnus-group-restart
- "r" gnus-group-read-init-file
- "B" gnus-group-browse-foreign-server
- "b" gnus-group-check-bogus-groups
- "F" gnus-find-new-newsgroups
- "\C-c\C-d" gnus-group-describe-group
- "\M-d" gnus-group-describe-all-groups
- "\C-c\C-a" gnus-group-apropos
- "\C-c\M-\C-a" gnus-group-description-apropos
- "a" gnus-group-post-news
- "\ek" gnus-group-edit-local-kill
- "\eK" gnus-group-edit-global-kill
- "\C-k" gnus-group-kill-group
- "\C-y" gnus-group-yank-group
- "\C-w" gnus-group-kill-region
- "\C-x\C-t" gnus-group-transpose-groups
- "\C-c\C-l" gnus-group-list-killed
- "\C-c\C-x" gnus-group-expire-articles
- "\C-c\M-\C-x" gnus-group-expire-all-groups
- "V" gnus-version
- "s" gnus-group-save-newsrc
- "z" gnus-group-suspend
- "Z" gnus-group-clear-dribble
- "q" gnus-group-exit
- "Q" gnus-group-quit
- "?" gnus-group-describe-briefly
- "\C-c\C-i" gnus-info-find-node
- "\M-e" gnus-group-edit-group-method
- "^" gnus-group-enter-server-mode
- gnus-mouse-2 gnus-mouse-pick-group
- "<" beginning-of-buffer
- ">" end-of-buffer
- "\C-c\C-b" gnus-bug
- "\C-c\C-s" gnus-group-sort-groups
- "t" gnus-topic-mode
- "\C-c\M-g" gnus-activate-all-groups
- "\M-&" gnus-group-universal-argument
- "#" gnus-group-mark-group
- "\M-#" gnus-group-unmark-group)
-
- (gnus-define-keys (gnus-group-mark-map "M" gnus-group-mode-map)
- "m" gnus-group-mark-group
- "u" gnus-group-unmark-group
- "w" gnus-group-mark-region
- "m" gnus-group-mark-buffer
- "r" gnus-group-mark-regexp
- "U" gnus-group-unmark-all-groups)
-
- (gnus-define-keys (gnus-group-group-map "G" gnus-group-mode-map)
- "d" gnus-group-make-directory-group
- "h" gnus-group-make-help-group
- "a" gnus-group-make-archive-group
- "k" gnus-group-make-kiboze-group
- "m" gnus-group-make-group
- "E" gnus-group-edit-group
- "e" gnus-group-edit-group-method
- "p" gnus-group-edit-group-parameters
- "v" gnus-group-add-to-virtual
- "V" gnus-group-make-empty-virtual
- "D" gnus-group-enter-directory
- "f" gnus-group-make-doc-group
- "r" gnus-group-rename-group
- "\177" gnus-group-delete-group
- [delete] gnus-group-delete-group)
-
- (gnus-define-keys (gnus-group-soup-map "s" gnus-group-group-map)
- "b" gnus-group-brew-soup
- "w" gnus-soup-save-areas
- "s" gnus-soup-send-replies
- "p" gnus-soup-pack-packet
- "r" nnsoup-pack-replies)
-
- (gnus-define-keys (gnus-group-sort-map "S" gnus-group-group-map)
- "s" gnus-group-sort-groups
- "a" gnus-group-sort-groups-by-alphabet
- "u" gnus-group-sort-groups-by-unread
- "l" gnus-group-sort-groups-by-level
- "v" gnus-group-sort-groups-by-score
- "r" gnus-group-sort-groups-by-rank
- "m" gnus-group-sort-groups-by-method)
-
- (gnus-define-keys (gnus-group-list-map "A" gnus-group-mode-map)
- "k" gnus-group-list-killed
- "z" gnus-group-list-zombies
- "s" gnus-group-list-groups
- "u" gnus-group-list-all-groups
- "A" gnus-group-list-active
- "a" gnus-group-apropos
- "d" gnus-group-description-apropos
- "m" gnus-group-list-matching
- "M" gnus-group-list-all-matching
- "l" gnus-group-list-level)
-
- (gnus-define-keys (gnus-group-score-map "W" gnus-group-mode-map)
- "f" gnus-score-flush-cache)
-
- (gnus-define-keys (gnus-group-help-map "H" gnus-group-mode-map)
- "f" gnus-group-fetch-faq)
-
- (gnus-define-keys (gnus-group-sub-map "S" gnus-group-mode-map)
- "l" gnus-group-set-current-level
- "t" gnus-group-unsubscribe-current-group
- "s" gnus-group-unsubscribe-group
- "k" gnus-group-kill-group
- "y" gnus-group-yank-group
- "w" gnus-group-kill-region
- "\C-k" gnus-group-kill-level
- "z" gnus-group-kill-all-zombies))
-
-(defun gnus-group-mode ()
- "Major mode for reading news.
-
-All normal editing commands are switched off.
-\\<gnus-group-mode-map>
-The group buffer lists (some of) the groups available. For instance,
-`\\[gnus-group-list-groups]' will list all subscribed groups with unread articles, while `\\[gnus-group-list-zombies]'
-lists all zombie groups.
-
-Groups that are displayed can be entered with `\\[gnus-group-read-group]'. To subscribe
-to a group not displayed, type `\\[gnus-group-unsubscribe-group]'.
-
-For more in-depth information on this mode, read the manual (`\\[gnus-info-find-node]').
-
-The following commands are available:
-
-\\{gnus-group-mode-map}"
- (interactive)
- (when (and menu-bar-mode
- (gnus-visual-p 'group-menu 'menu))
- (gnus-group-make-menu-bar))
- (kill-all-local-variables)
- (gnus-simplify-mode-line)
- (setq major-mode 'gnus-group-mode)
- (setq mode-name "Group")
- (gnus-group-set-mode-line)
- (setq mode-line-process nil)
- (use-local-map gnus-group-mode-map)
- (buffer-disable-undo (current-buffer))
- (setq truncate-lines t)
- (setq buffer-read-only t)
- (run-hooks 'gnus-group-mode-hook))
-
-(defun gnus-mouse-pick-group (e)
- "Enter the group under the mouse pointer."
- (interactive "e")
- (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
- (or (setq gnus-group-use-permanent-levels
- (or level (if (numberp gnus-group-use-permanent-levels)
- gnus-group-use-permanent-levels
- (or gnus-group-default-list-level
- gnus-level-subscribed))))
- 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-slave-no-server (&optional arg)
- "Read network news as a slave, without connecting to local server"
- (interactive "P")
- (gnus-no-server arg t))
-
-;;;###autoload
-(defun gnus-no-server (&optional arg slave)
- "Read network news.
-If ARG is a positive number, Gnus will use that as the
-startup level. If ARG is nil, Gnus will be started at level 2.
-If ARG is non-nil and not a positive number, Gnus will
-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")
- (let ((val (or arg (1- gnus-level-default-subscribed))))
- (gnus val t slave)
- (make-local-variable 'gnus-group-use-permanent-levels)
- (setq gnus-group-use-permanent-levels val)))
-
-;;;###autoload
-(defun gnus-slave (&optional arg)
- "Read news as a slave."
- (interactive "P")
- (gnus arg nil 'slave))
-
-;;;###autoload
-(defun gnus-other-frame (&optional arg)
- "Pop up a frame to read news."
- (interactive "P")
- (if (get-buffer gnus-group-buffer)
- (let ((pop-up-frames t))
- (gnus arg))
- (select-frame (make-frame))
- (gnus arg)))
-
-;;;###autoload
-(defun gnus (&optional arg dont-connect slave)
- "Read network news.
-If ARG is non-nil and a positive number, Gnus will use that as the
-startup level. If ARG is non-nil and not a positive number, Gnus will
-prompt the user for the name of an NNTP server to use."
- (interactive "P")
-
- (if (get-buffer gnus-group-buffer)
- (progn
- (switch-to-buffer gnus-group-buffer)
- (gnus-group-get-new-news))
-
- (gnus-clear-system)
- (nnheader-init-server-buffer)
- (gnus-read-init-file)
- (setq gnus-slave slave)
-
- (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 (numberp arg) (> arg 0) arg))
- did-connect)
- (unwind-protect
- (progn
- (or dont-connect
- (setq did-connect
- (gnus-start-news-server (and arg (not level))))))
- (if (and (not dont-connect)
- (not did-connect))
- (gnus-group-quit)
- (run-hooks 'gnus-startup-hook)
- ;; NNTP server is successfully open.
-
- ;; Find the current startup file name.
- (setq gnus-current-startup-file
- (gnus-make-newsrc-file gnus-startup-file))
-
- ;; Read the dribble file.
- (and (or gnus-slave gnus-use-dribble-file) (gnus-dribble-read-file))
-
- ;; Allow using GroupLens predictions.
- (when gnus-use-grouplens
- (bbb-login)
- (add-hook 'gnus-summary-mode-hook 'gnus-grouplens-mode))
-
- (gnus-summary-make-display-table)
- ;; Do the actual startup.
- (gnus-setup-news nil level dont-connect)
- ;; Generate the group buffer.
- (gnus-group-list-groups level)
- (gnus-group-first-unread-group)
- (gnus-configure-windows 'group)
- (gnus-group-set-mode-line))))))
-
-(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\\|nn\\)" (caar history))
- (setq feature (cdr (assq 'provide (car history))))
- (unload-feature feature 'force))
- (setq history (cdr history)))))
-
-(defun gnus-compile ()
- "Byte-compile the user-defined format specs."
- (interactive)
- (let ((entries gnus-format-specs)
- entry gnus-tmp-func)
- (save-excursion
- (gnus-message 7 "Compiling format specs...")
-
- (while entries
- (setq entry (pop entries))
- (if (eq (car entry) 'version)
- (setq gnus-format-specs (delq entry gnus-format-specs))
- (when (and (listp (caddr entry))
- (not (eq 'byte-code (caaddr entry))))
- (fset 'gnus-tmp-func
- `(lambda () ,(caddr entry)))
- (byte-compile 'gnus-tmp-func)
- (setcar (cddr entry) (gnus-byte-code 'gnus-tmp-func)))))
-
- (push (cons 'version emacs-version) gnus-format-specs)
-
- (gnus-message 7 "Compiling user specs...done"))))
-
-(defun gnus-indent-rigidly (start end arg)
- "Indent rigidly using only spaces and no tabs."
- (save-excursion
- (save-restriction
- (narrow-to-region start end)
- (indent-rigidly start end arg)
- (goto-char (point-min))
- (while (search-forward "\t" nil t)
- (replace-match " " t t)))))
-
-(defun gnus-group-startup-message (&optional x y)
- "Insert startup message in current buffer."
- ;; Insert the message.
- (erase-buffer)
- (insert
- (format " %s
- _ ___ _ _
- _ ___ __ ___ __ _ ___
- __ _ ___ __ ___
- _ ___ _
- _ _ __ _
- ___ __ _
- __ _
- _ _ _
- _ _ _
- _ _ _
- __ ___
- _ _ _ _
- _ _
- _ _
- _ _
- _
- __
-
-"
- ""))
- ;; And then hack it.
- (gnus-indent-rigidly (point-min) (point-max)
- (/ (max (- (window-width) (or x 46)) 0) 2))
- (goto-char (point-min))
- (forward-line 1)
- (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))
- (and (search-forward "Praxis" nil t)
- (gnus-put-text-property (match-beginning 0) (match-end 0) 'face 'bold))
- (goto-char (point-min))
- (let* ((mode-string (gnus-group-set-mode-line)))
- (setq mode-line-buffer-identification
- (list (concat gnus-version (substring (car mode-string) 4))))
- (set-buffer-modified-p t)))
-
-(defun gnus-group-setup-buffer ()
- (or (get-buffer gnus-group-buffer)
- (progn
- (switch-to-buffer gnus-group-buffer)
- (gnus-add-current-to-buffer-list)
- (gnus-group-mode)
- (and gnus-carpal (gnus-carpal-setup-buffer 'group)))))
-
-(defun gnus-group-list-groups (&optional level unread lowest)
- "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 (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
- (gnus-update-format-specifications)
- (let ((case-fold-search nil)
- (props (text-properties-at (gnus-point-at-bol)))
- (group (gnus-group-group-name)))
- (set-buffer gnus-group-buffer)
- (funcall gnus-group-prepare-function level unread lowest)
- (if (zerop (buffer-size))
- (gnus-message 5 gnus-no-groups-message)
- (goto-char (point-max))
- (when (or (not gnus-group-goto-next-group-function)
- (not (funcall gnus-group-goto-next-group-function
- group props)))
- (if (not group)
- ;; Go to the first group with unread articles.
- (gnus-group-search-forward t)
- ;; Find the right group to put point on. If the current group
- ;; has disappeared in the new listing, try to find the next
- ;; one. If no next one can be found, just leave point at the
- ;; first newsgroup in the buffer.
- (if (not (gnus-goto-char
- (text-property-any
- (point-min) (point-max)
- 'gnus-group (gnus-intern-safe group gnus-active-hashtb))))
- (let ((newsrc (cdddr (gnus-gethash group gnus-newsrc-hashtb))))
- (while (and newsrc
- (not (gnus-goto-char
- (text-property-any
- (point-min) (point-max) 'gnus-group
- (gnus-intern-safe
- (caar newsrc) gnus-active-hashtb)))))
- (setq newsrc (cdr newsrc)))
- (or newsrc (progn (goto-char (point-max))
- (forward-line -1)))))))
- ;; Adjust cursor point.
- (gnus-group-position-point))))
-
-(defun gnus-group-list-level (level &optional all)
- "List groups on LEVEL.
-If ALL (the prefix), also list groups that have no unread articles."
- (interactive "nList groups on level: \nP")
- (gnus-group-list-groups level all level))
-
-(defun gnus-group-prepare-flat (level &optional all lowest regexp)
- "List all newsgroups with unread articles of level LEVEL or lower.
-If ALL is non-nil, list groups that have no unread articles.
-If LOWEST is non-nil, list all newsgroups of level LOWEST or higher.
-If REGEXP, only list groups matching REGEXP."
- (set-buffer gnus-group-buffer)
- (let ((buffer-read-only nil)
- (newsrc (cdr gnus-newsrc-alist))
- (lowest (or lowest 1))
- info clevel unread group params)
- (erase-buffer)
- (if (< lowest gnus-level-zombie)
- ;; List living groups.
- (while newsrc
- (setq info (car newsrc)
- group (gnus-info-group info)
- params (gnus-info-params info)
- newsrc (cdr newsrc)
- unread (car (gnus-gethash group gnus-newsrc-hashtb)))
- (and unread ; This group might be bogus
- (or (not regexp)
- (string-match regexp group))
- (<= (setq clevel (gnus-info-level info)) level)
- (>= clevel lowest)
- (or all ; We list all groups?
- (if (eq unread t) ; Unactivated?
- gnus-group-list-inactive-groups ; We list unactivated
- (> unread 0)) ; We list groups with unread articles
- (and gnus-list-groups-with-ticked-articles
- (cdr (assq 'tick (gnus-info-marks info))))
- ; And groups with tickeds
- ;; Check for permanent visibility.
- (and gnus-permanently-visible-groups
- (string-match gnus-permanently-visible-groups
- group))
- (memq 'visible params)
- (cdr (assq 'visible params)))
- (gnus-group-insert-group-line
- group (gnus-info-level info)
- (gnus-info-marks info) unread (gnus-info-method info)))))
-
- ;; List dead groups.
- (and (>= level gnus-level-zombie) (<= lowest gnus-level-zombie)
- (gnus-group-prepare-flat-list-dead
- (setq gnus-zombie-list (sort gnus-zombie-list 'string<))
- gnus-level-zombie ?Z
- regexp))
- (and (>= level gnus-level-killed) (<= lowest gnus-level-killed)
- (gnus-group-prepare-flat-list-dead
- (setq gnus-killed-list (sort gnus-killed-list 'string<))
- gnus-level-killed ?K regexp))
-
- (gnus-group-set-mode-line)
- (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)
- ;; List zombies and killed lists somewhat faster, which was
- ;; suggested by Jack Vinson <vinson@unagi.cis.upenn.edu>. It does
- ;; this by ignoring the group format specification altogether.
- (let (group)
- (if regexp
- ;; This loop is used when listing groups that match some
- ;; regexp.
- (while groups
- (setq group (pop groups))
- (when (string-match regexp group)
- (gnus-add-text-properties
- (point) (prog1 (1+ (point))
- (insert " " mark " *: " group "\n"))
- (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb)
- 'gnus-unread t
- 'gnus-level level))))
- ;; This loop is used when listing all groups.
- (while groups
- (gnus-add-text-properties
- (point) (prog1 (1+ (point))
- (insert " " mark " *: "
- (setq group (pop groups)) "\n"))
- (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb)
- 'gnus-unread t
- 'gnus-level level))))))
-
-(defmacro gnus-group-real-name (group)
- "Find the real name of a foreign newsgroup."
- `(let ((gname ,group))
- (if (string-match ":[^:]+$" gname)
- (substring gname (1+ (match-beginning 0)))
- gname)))
+;;; Servers and groups.
(defsubst gnus-server-add-address (method)
(let ((method-name (symbol-name (car method))))
(and (equal server "native") gnus-select-method)
;; It should be in the server alist.
(cdr (assoc server gnus-server-alist))
+ ;; It could be in the predefined server alist.
+ (cdr (assoc server gnus-predefined-server-alist))
;; If not, we look through all the opened server
;; to see whether we can find it there.
(let ((opened gnus-opened-servers))
(pop opened))
out))
+(defun gnus-archive-server-wanted-p ()
+ "Say whether the user wants to use the archive server."
+ (cond
+ ((or (not gnus-message-archive-method)
+ (not gnus-message-archive-group))
+ nil)
+ ((and gnus-message-archive-method gnus-message-archive-group)
+ t)
+ (t
+ (let ((active (cadr (assq 'nnfolder-active-file
+ gnus-message-archive-method))))
+ (and active
+ (file-exists-p active))))))
+
(defun gnus-group-prefixed-name (group method)
"Return the whole name from GROUP and METHOD."
(and (stringp method) (setq method (gnus-server-to-method method)))
- (concat (format "%s" (car method))
- (if (and
- (or (assoc (format "%s" (car method))
- (gnus-methods-using 'address))
- (gnus-server-equal method gnus-message-archive-method))
- (nth 1 method)
- (not (string= (nth 1 method) "")))
+ (if (not method)
+ group
+ (concat (format "%s" (car method))
+ (when (and
+ (or (assoc (format "%s" (car method))
+ (gnus-methods-using 'address))
+ (gnus-server-equal method gnus-message-archive-method))
+ (nth 1 method)
+ (not (string= (nth 1 method) "")))
(concat "+" (nth 1 method)))
- ":" group))
+ ":" group)))
(defun gnus-group-real-prefix (group)
"Return the prefix of the current group name."
"Say whether the group is secondary or not."
(gnus-secondary-method-p (gnus-find-method-for-group group)))
+(defun gnus-group-find-parameter (group &optional symbol)
+ "Return the group parameters for GROUP.
+If SYMBOL, return the value of that symbol in the group parameters."
+ (save-excursion
+ (set-buffer gnus-group-buffer)
+ (let ((parameters (funcall gnus-group-get-parameter-function group)))
+ (if symbol
+ (gnus-group-parameter-value parameters symbol)
+ parameters))))
+
(defun gnus-group-get-parameter (group &optional symbol)
- "Returns the group parameters for GROUP.
+ "Return the group parameters for GROUP.
If SYMBOL, return the value of that symbol in the group parameters."
(let ((params (gnus-info-params (gnus-get-info group))))
(if symbol
"Add parameter PARAM to GROUP."
(let ((info (gnus-get-info group)))
(if (not info)
- () ; This is a dead group. We just ignore it.
+ () ; This is a dead group. We just ignore it.
;; Cons the new param to the old one and update.
(gnus-group-set-info (cons param (gnus-info-params info))
group 'params))))
"Set parameter NAME to VALUE in GROUP."
(let ((info (gnus-get-info group)))
(if (not info)
- () ; This is a dead group. We just ignore it.
+ () ; This is a dead group. We just ignore it.
(let ((old-params (gnus-info-params info))
(new-params (list (cons name value))))
(while old-params
- (if (or (not (listp (car old-params)))
- (not (eq (caar old-params) name)))
- (setq new-params (append new-params (list (car old-params)))))
+ (when (or (not (listp (car old-params)))
+ (not (eq (caar old-params) name)))
+ (setq new-params (append new-params (list (car old-params)))))
(setq old-params (cdr old-params)))
(gnus-group-set-info new-params group 'params)))))
(when info
(gnus-info-set-score info (+ (gnus-info-score info) (or score 1))))))
-(defun gnus-summary-bubble-group ()
- "Increase the score of the current group.
-This is a handy function to add to `gnus-summary-exit-hook' to
-increase the score of each group you read."
- (gnus-group-add-score gnus-newsgroup-name))
-
-(defun gnus-group-set-info (info &optional method-only-group part)
- (let* ((entry (gnus-gethash
- (or method-only-group (gnus-info-group info))
- gnus-newsrc-hashtb))
- (part-info info)
- (info (if method-only-group (nth 2 entry) info))
- method)
- (when method-only-group
- (unless entry
- (error "Trying to change non-existent group %s" method-only-group))
- ;; We have received 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.
- (let ((len (length info))
- (total (if (eq part 'method) 5 6)))
- (when (< len total)
- (setcdr (nthcdr (1- len) info)
- (make-list (- total len) nil)))
- ;; Then we enter the new info.
- (setcar (nthcdr (1- total) info) part-info)))
- (unless entry
- ;; This is a new group, so we just create it.
- (save-excursion
- (set-buffer gnus-group-buffer)
- (setq method (gnus-info-method info))
- (when (gnus-server-equal method "native")
- (setq method nil))
- (save-excursion
- (set-buffer gnus-group-buffer)
- (if method
- ;; It's a foreign group...
- (gnus-group-make-group
- (gnus-group-real-name (gnus-info-group info))
- (if (stringp method) method
- (prin1-to-string (car method)))
- (and (consp method)
- (nth 1 (gnus-info-method info))))
- ;; It's a native group.
- (gnus-group-make-group (gnus-info-group info))))
- (gnus-message 6 "Note: New group created")
- (setq entry
- (gnus-gethash (gnus-group-prefixed-name
- (gnus-group-real-name (gnus-info-group info))
- (or (gnus-info-method info) gnus-select-method))
- gnus-newsrc-hashtb))))
- ;; Whether it was a new group or not, we now have the entry, so we
- ;; can do the update.
- (if entry
- (progn
- (setcar (nthcdr 2 entry) info)
- (when (and (not (eq (car entry) t))
- (gnus-active (gnus-info-group info)))
- (setcar entry (length (gnus-list-of-unread-articles (car info))))))
- (error "No such group: %s" (gnus-info-group info)))))
-
-(defun gnus-group-set-method-info (group select-method)
- (gnus-group-set-info select-method group 'method))
-
-(defun gnus-group-set-params-info (group params)
- (gnus-group-set-info params group 'params))
-
-(defun gnus-group-update-group-line ()
- "Update the current line in the group buffer."
- (let* ((buffer-read-only nil)
- (group (gnus-group-group-name))
- (entry (and group (gnus-gethash group gnus-newsrc-hashtb)))
- gnus-group-indentation)
- (and entry
- (not (gnus-ephemeral-group-p group))
- (gnus-dribble-enter
- (concat "(gnus-group-set-info '"
- (prin1-to-string (nth 2 entry)) ")")))
- (setq gnus-group-indentation (gnus-group-group-indentation))
- (gnus-delete-line)
- (gnus-group-insert-group-line-info group)
- (forward-line -1)
- (gnus-group-position-point)))
-
-(defun gnus-group-insert-group-line-info (group)
- "Insert GROUP on the current line."
- (let ((entry (gnus-gethash group gnus-newsrc-hashtb))
- active info)
- (if entry
- (progn
- ;; (Un)subscribed group.
- (setq info (nth 2 entry))
- (gnus-group-insert-group-line
- group (gnus-info-level info) (gnus-info-marks info)
- (or (car entry) t) (gnus-info-method info)))
- ;; This group is dead.
- (gnus-group-insert-group-line
- group
- (if (member group gnus-zombie-list) gnus-level-zombie gnus-level-killed)
- nil
- (if (setq active (gnus-active group))
- (- (1+ (cdr active)) (car active)) 0)
- nil))))
-
-(defun gnus-group-insert-group-line (gnus-tmp-group gnus-tmp-level
- gnus-tmp-marked number
- gnus-tmp-method)
- "Insert a group line in the group buffer."
- (let* ((gnus-tmp-active (gnus-active gnus-tmp-group))
- (gnus-tmp-number-total
- (if gnus-tmp-active
- (1+ (- (cdr gnus-tmp-active) (car gnus-tmp-active)))
- 0))
- (gnus-tmp-number-of-unread
- (if (numberp number) (int-to-string (max 0 number))
- "*"))
- (gnus-tmp-number-of-read
- (if (numberp number)
- (int-to-string (max 0 (- gnus-tmp-number-total number)))
- "*"))
- (gnus-tmp-subscribed
- (cond ((<= gnus-tmp-level gnus-level-subscribed) ? )
- ((<= gnus-tmp-level gnus-level-unsubscribed) ?U)
- ((= gnus-tmp-level gnus-level-zombie) ?Z)
- (t ?K)))
- (gnus-tmp-qualified-group (gnus-group-real-name gnus-tmp-group))
- (gnus-tmp-newsgroup-description
- (if gnus-description-hashtb
- (or (gnus-gethash gnus-tmp-group gnus-description-hashtb) "")
- ""))
- (gnus-tmp-moderated
- (if (member gnus-tmp-group gnus-moderated-list) ?m ? ))
- (gnus-tmp-moderated-string
- (if (eq gnus-tmp-moderated ?m) "(m)" ""))
- (gnus-tmp-method
- (gnus-server-get-method gnus-tmp-group gnus-tmp-method))
- (gnus-tmp-news-server (or (cadr gnus-tmp-method) ""))
- (gnus-tmp-news-method (or (car gnus-tmp-method) ""))
- (gnus-tmp-news-method-string
- (if gnus-tmp-method
- (format "(%s:%s)" (car gnus-tmp-method)
- (cadr gnus-tmp-method)) ""))
- (gnus-tmp-marked-mark
- (if (and (numberp number)
- (zerop number)
- (cdr (assq 'tick gnus-tmp-marked)))
- ?* ? ))
- (gnus-tmp-process-marked
- (if (member gnus-tmp-group gnus-group-marked)
- gnus-process-mark ? ))
- (gnus-tmp-grouplens
- (or (and gnus-use-grouplens
- (bbb-grouplens-group-p gnus-tmp-group))
- ""))
- (buffer-read-only nil)
- header gnus-tmp-header) ; passed as parameter to user-funcs.
- (beginning-of-line)
- (gnus-add-text-properties
- (point)
- (prog1 (1+ (point))
- ;; Insert the text.
- (eval gnus-group-line-format-spec))
- `(gnus-group ,(gnus-intern-safe gnus-tmp-group gnus-active-hashtb)
- gnus-unread ,(if (numberp number)
- (string-to-int gnus-tmp-number-of-unread)
- t)
- gnus-marked ,gnus-tmp-marked-mark
- gnus-indentation ,gnus-group-indentation
- gnus-level ,gnus-tmp-level))
- (when (inline (gnus-visual-p 'group-highlight 'highlight))
- (forward-line -1)
- (run-hooks 'gnus-group-update-hook)
- (forward-line))
- ;; Allow XEmacs to remove front-sticky text properties.
- (gnus-group-remove-excess-properties)))
-
-(defun gnus-group-update-group (group &optional visible-only)
- "Update all lines where GROUP appear.
-If VISIBLE-ONLY is non-nil, the group won't be displayed if it isn't
-already."
- (save-excursion
- (set-buffer gnus-group-buffer)
- ;; The buffer may be narrowed.
- (save-restriction
- (widen)
- (let ((ident (gnus-intern-safe group gnus-active-hashtb))
- (loc (point-min))
- found buffer-read-only)
- ;; Enter the current status into the dribble buffer.
- (let ((entry (gnus-gethash group gnus-newsrc-hashtb)))
- (if (and entry (not (gnus-ephemeral-group-p group)))
- (gnus-dribble-enter
- (concat "(gnus-group-set-info '" (prin1-to-string (nth 2 entry))
- ")"))))
- ;; Find all group instances. If topics are in use, each group
- ;; may be listed in more than once.
- (while (setq loc (text-property-any
- loc (point-max) 'gnus-group ident))
- (setq found t)
- (goto-char loc)
- (let ((gnus-group-indentation (gnus-group-group-indentation)))
- (gnus-delete-line)
- (gnus-group-insert-group-line-info group))
- (setq loc (1+ loc)))
- (unless (or found visible-only)
- ;; No such line in the buffer, find out where it's supposed to
- ;; go, and insert it there (or at the end of the buffer).
- (if gnus-goto-missing-group-function
- (funcall gnus-goto-missing-group-function group)
- (let ((entry (cddr (gnus-gethash group gnus-newsrc-hashtb))))
- (while (and entry (car entry)
- (not
- (gnus-goto-char
- (text-property-any
- (point-min) (point-max)
- 'gnus-group (gnus-intern-safe
- (caar entry) gnus-active-hashtb)))))
- (setq entry (cdr entry)))
- (or entry (goto-char (point-max)))))
- ;; Finally insert the line.
- (let ((gnus-group-indentation (gnus-group-group-indentation)))
- (gnus-group-insert-group-line-info group)))
- (gnus-group-set-mode-line)))))
-
-(defun gnus-group-set-mode-line ()
- "Update the mode line in the group buffer."
- (when (memq 'group gnus-updated-mode-lines)
- ;; Yes, we want to keep this mode line updated.
- (save-excursion
- (set-buffer gnus-group-buffer)
- (let* ((gformat (or gnus-group-mode-line-format-spec
- (setq gnus-group-mode-line-format-spec
- (gnus-parse-format
- gnus-group-mode-line-format
- gnus-group-mode-line-format-alist))))
- (gnus-tmp-news-server (cadr gnus-select-method))
- (gnus-tmp-news-method (car gnus-select-method))
- (gnus-tmp-colon (if (equal gnus-tmp-news-server "") "" ":"))
- (max-len 60)
- gnus-tmp-header ;Dummy binding for user-defined formats
- ;; Get the resulting string.
- (mode-string (eval gformat)))
- ;; Say whether the dribble buffer has been modified.
- (setq mode-line-modified
- (if (and gnus-dribble-buffer
- (buffer-name gnus-dribble-buffer)
- (buffer-modified-p gnus-dribble-buffer)
- (save-excursion
- (set-buffer gnus-dribble-buffer)
- (not (zerop (buffer-size)))))
- "---*- " "----- "))
- ;; If the line is too long, we chop it off.
- (when (> (length mode-string) max-len)
- (setq mode-string (substring mode-string 0 (- max-len 4))))
- (prog1
- (setq mode-line-buffer-identification
- (list mode-string))
- (set-buffer-modified-p t))))))
-
-(defun gnus-group-group-name ()
- "Get the name of the newsgroup on the current line."
- (let ((group (get-text-property (gnus-point-at-bol) 'gnus-group)))
- (and group (symbol-name group))))
-
-(defun gnus-group-group-level ()
- "Get the level of the newsgroup on the current line."
- (get-text-property (gnus-point-at-bol) 'gnus-level))
-
-(defun gnus-group-group-indentation ()
- "Get the indentation of the newsgroup on the current line."
- (or (get-text-property (gnus-point-at-bol) 'gnus-indentation)
- (and gnus-group-indentation-function
- (funcall gnus-group-indentation-function))
- ""))
-
-(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 eligible as a target."
- (let ((way (if backward -1 1))
- (low gnus-level-killed)
- (beg (point))
- pos found lev)
- (if (and backward (progn (beginning-of-line)) (bobp))
- nil
- (or first-too (forward-line way))
- (while (and
- (not (eobp))
- (not (setq
- found
- (and (or all
- (and
- (let ((unread
- (get-text-property (point) 'gnus-unread)))
- (and (numberp unread) (> unread 0)))
- (setq lev (get-text-property (point)
- 'gnus-level))
- (<= lev gnus-level-subscribed)))
- (or (not level)
- (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-point) t)
- (goto-char (or pos beg))
- (and pos t))))
-
-;;; Gnus group mode commands
-
-;; Group marking.
-
-(defun gnus-group-mark-group (n &optional unmark no-advance)
- "Mark the current group."
- (interactive "p")
- (let ((buffer-read-only nil)
- group)
- (while (and (> n 0)
- (not (eobp)))
- (when (setq group (gnus-group-group-name))
- ;; Update the mark.
- (beginning-of-line)
- (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 (delete group gnus-group-marked)))))
- (or no-advance (gnus-group-next-group 1))
- (decf n))
- (gnus-summary-position-point)
- n))
-
-(defun gnus-group-unmark-group (n)
- "Remove the mark from the current group."
- (interactive "p")
- (gnus-group-mark-group n 'unmark)
- (gnus-group-position-point))
-
-(defun gnus-group-unmark-all-groups ()
- "Unmark all groups."
- (interactive)
- (let ((groups gnus-group-marked))
- (save-excursion
- (while groups
- (gnus-group-remove-mark (pop groups)))))
- (gnus-group-position-point))
-
-(defun gnus-group-mark-region (unmark beg end)
- "Mark all groups between point and mark.
-If UNMARK, remove the mark instead."
- (interactive "P\nr")
- (let ((num (count-lines beg end)))
- (save-excursion
- (goto-char beg)
- (- num (gnus-group-mark-group num unmark)))))
-
-(defun gnus-group-mark-buffer (&optional unmark)
- "Mark all groups in the buffer.
-If UNMARK, remove the mark instead."
- (interactive "P")
- (gnus-group-mark-region unmark (point-min) (point-max)))
-
-(defun gnus-group-mark-regexp (regexp)
- "Mark all groups that match some regexp."
- (interactive "sMark (regexp): ")
- (let ((alist (cdr gnus-newsrc-alist))
- group)
- (while alist
- (when (string-match regexp (setq group (gnus-info-group (pop alist))))
- (gnus-group-set-mark group))))
- (gnus-group-position-point))
-
-(defun gnus-group-remove-mark (group)
- "Remove the process mark from GROUP and move point there.
-Return nil if the group isn't displayed."
- (if (gnus-group-goto-group group)
- (save-excursion
- (gnus-group-mark-group 1 'unmark t)
- t)
- (setq gnus-group-marked
- (delete group gnus-group-marked))
- nil))
-
-(defun gnus-group-set-mark (group)
- "Set the process mark on GROUP."
- (if (gnus-group-goto-group group)
- (save-excursion
- (gnus-group-mark-group 1 nil t))
- (setq gnus-group-marked (cons group (delete group gnus-group-marked)))))
-
-(defun gnus-group-universal-argument (arg &optional groups func)
- "Perform any command on all groups accoring to the process/prefix convention."
- (interactive "P")
- (let ((groups (or groups (gnus-group-process-prefix arg)))
- group func)
- (if (eq (setq func (or func
- (key-binding
- (read-key-sequence
- (substitute-command-keys
- "\\<gnus-group-mode-map>\\[gnus-group-universal-argument]")))))
- 'undefined)
- (gnus-error 1 "Undefined key")
- (while groups
- (gnus-group-remove-mark (setq group (pop groups)))
- (command-execute func))))
- (gnus-group-position-point))
-
-(defun gnus-group-process-prefix (n)
- "Return a list of groups to work on.
-Take into consideration N (the prefix) and the list of marked groups."
- (cond
- (n
- (setq n (prefix-numeric-value n))
- ;; There is a prefix, so we return a list of the N next
- ;; groups.
- (let ((way (if (< n 0) -1 1))
- (n (abs n))
- group groups)
- (save-excursion
- (while (and (> n 0)
- (setq group (gnus-group-group-name)))
- (setq groups (cons group groups))
- (setq n (1- n))
- (gnus-group-next-group way)))
- (nreverse groups)))
- ((and (boundp 'transient-mark-mode)
- transient-mark-mode
- (boundp 'mark-active)
- mark-active)
- ;; Work on the region between point and mark.
- (let ((max (max (point) (mark)))
- groups)
- (save-excursion
- (goto-char (min (point) (mark)))
- (while
- (and
- (push (gnus-group-group-name) groups)
- (zerop (gnus-group-next-group 1))
- (< (point) max)))
- (nreverse groups))))
- (gnus-group-marked
- ;; No prefix, but a list of marked articles.
- (reverse gnus-group-marked))
- (t
- ;; Neither marked articles or a prefix, so we return the
- ;; current group.
- (let ((group (gnus-group-group-name)))
- (and group (list group))))))
-
-;; Selecting groups.
-
-(defun gnus-group-read-group (&optional all no-article group)
- "Read news in this newsgroup.
-If the prefix argument ALL is non-nil, already read articles become
-readable. IF ALL is a number, fetch this number of articles. If the
-optional argument NO-ARTICLE is non-nil, no article will be
-auto-selected upon group entry. If GROUP is non-nil, fetch that
-group."
- (interactive "P")
- (let ((group (or group (gnus-group-group-name)))
- number active marked entry)
- (or group (error "No group on current line"))
- (setq marked (nth 3 (nth 2 (setq entry (gnus-gethash
- group gnus-newsrc-hashtb)))))
- ;; This group might be a dead group. In that case we have to get
- ;; the number of unread articles from `gnus-active-hashtb'.
- (setq number
- (cond ((numberp all) all)
- (entry (car entry))
- ((setq active (gnus-active group))
- (- (1+ (cdr active)) (car active)))))
- (gnus-summary-read-group
- group (or all (and (numberp number)
- (zerop (+ number (length (cdr (assq 'tick marked)))
- (length (cdr (assq 'dormant marked)))))))
- no-article)))
-
-(defun gnus-group-select-group (&optional all)
- "Select this newsgroup.
-No article is selected automatically.
-If ALL is non-nil, already read articles become readable.
-If ALL is a number, fetch this number of articles."
- (interactive "P")
- (gnus-group-read-group all t))
-
-(defun gnus-group-quick-select-group (&optional all)
- "Select the current group \"quickly\".
-This means that no highlighting or scoring will be performed."
- (interactive "P")
- (let (gnus-visual
- gnus-score-find-score-files-function
- gnus-apply-kill-hook
- gnus-summary-expunge-below)
- (gnus-group-read-group all t)))
-
-(defun gnus-group-visible-select-group (&optional all)
- "Select the current group without hiding any articles."
- (interactive "P")
- (let ((gnus-inhibit-limiting t))
- (gnus-group-read-group all t)))
-
-;;;###autoload
-(defun gnus-fetch-group (group)
- "Start Gnus if necessary and enter GROUP.
-Returns whether the fetching was successful or not."
- (interactive "sGroup name: ")
- (or (get-buffer gnus-group-buffer)
- (gnus))
- (gnus-group-read-group nil nil group))
-
-;; 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
- `(t nil (,group ,gnus-level-default-subscribed nil nil ,method
- ((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))))
-
-(defun gnus-group-jump-to-group (group)
- "Jump to newsgroup GROUP."
- (interactive
- (list (completing-read
- "Group: " gnus-active-hashtb nil
- (gnus-read-active-file-p)
- nil
- 'gnus-group-history)))
-
- (when (equal group "")
- (error "Empty group name"))
-
- (when (string-match "[\000-\032]" group)
- (error "Control characters in group: %s" group))
-
- (let ((b (text-property-any
- (point-min) (point-max)
- 'gnus-group (gnus-intern-safe group gnus-active-hashtb))))
- (unless (gnus-ephemeral-group-p group)
- (if b
- ;; Either go to the line in the group buffer...
- (goto-char b)
- ;; ... or insert the line.
- (or
- (gnus-active 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 (gnus-intern-safe group gnus-active-hashtb)))))
- ;; Adjust cursor point.
- (gnus-group-position-point)))
-
-(defun gnus-group-goto-group (group)
- "Goto to newsgroup GROUP."
- (when group
- (let ((b (text-property-any (point-min) (point-max)
- 'gnus-group (gnus-intern-safe
- group gnus-active-hashtb))))
- (and b (goto-char b)))))
-
-(defun gnus-group-next-group (n)
- "Go to next N'th newsgroup.
-If N is negative, search backward instead.
-Returns the difference between N and the number of skips actually
-done."
- (interactive "p")
- (gnus-group-next-unread-group n t))
-
-(defun gnus-group-next-unread-group (n &optional all level)
- "Go to next N'th unread newsgroup.
-If N is negative, search backward instead.
-If ALL is non-nil, choose any newsgroup, unread or not.
-If LEVEL is non-nil, choose the next group with level LEVEL, or, if no
-such group can be found, the next group with a level higher than
-LEVEL.
-Returns the difference between N and the number of skips actually
-made."
- (interactive "p")
- (let ((backward (< n 0))
- (n (abs n)))
- (while (and (> n 0)
- (gnus-group-search-forward
- backward (or (not gnus-group-goto-unread) all) level))
- (setq n (1- n)))
- (if (/= 0 n) (gnus-message 7 "No more%s newsgroups%s" (if all "" " unread")
- (if level " on this level or higher" "")))
- n))
-
-(defun gnus-group-prev-group (n)
- "Go to previous N'th newsgroup.
-Returns the difference between N and the number of skips actually
-done."
- (interactive "p")
- (gnus-group-next-unread-group (- n) t))
-
-(defun gnus-group-prev-unread-group (n)
- "Go to previous N'th unread newsgroup.
-Returns the difference between N and the number of skips actually
-done."
- (interactive "p")
- (gnus-group-next-unread-group (- n)))
-
-(defun gnus-group-next-unread-group-same-level (n)
- "Go to next N'th unread newsgroup on the same level.
-If N is negative, search backward instead.
-Returns the difference between N and the number of skips actually
-done."
- (interactive "p")
- (gnus-group-next-unread-group n t (gnus-group-group-level))
- (gnus-group-position-point))
-
-(defun gnus-group-prev-unread-group-same-level (n)
- "Go to next N'th unread newsgroup on the same level.
-Returns the difference between N and the number of skips actually
-done."
- (interactive "p")
- (gnus-group-next-unread-group (- n) t (gnus-group-group-level))
- (gnus-group-position-point))
-
-(defun gnus-group-best-unread-group (&optional exclude-group)
- "Go to the group with the highest level.
-If EXCLUDE-GROUP, do not go to that group."
- (interactive)
- (goto-char (point-min))
- (let ((best 100000)
- unread best-point)
- (while (not (eobp))
- (setq unread (get-text-property (point) 'gnus-unread))
- (if (and (numberp unread) (> unread 0))
- (progn
- (if (and (get-text-property (point) 'gnus-level)
- (< (get-text-property (point) 'gnus-level) best)
- (or (not exclude-group)
- (not (equal exclude-group (gnus-group-group-name)))))
- (progn
- (setq best (get-text-property (point) 'gnus-level))
- (setq best-point (point))))))
- (forward-line 1))
- (if best-point (goto-char best-point))
- (gnus-summary-position-point)
- (and best-point (gnus-group-group-name))))
-
-(defun gnus-group-first-unread-group ()
- "Go to the first group with unread articles."
- (interactive)
- (prog1
- (let ((opoint (point))
- unread)
- (goto-char (point-min))
- (if (or (eq (setq unread (gnus-group-group-unread)) t) ; Not active.
- (and (numberp unread) ; Not a topic.
- (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-point)))
-
-(defun gnus-group-enter-server-mode ()
- "Jump to the server buffer."
- (interactive)
- (gnus-enter-server-buffer))
-
-(defun gnus-group-make-group (name &optional method address)
- "Add a new newsgroup.
-The user will be prompted for a NAME, for a select METHOD, and an
-ADDRESS."
- (interactive
- (cons
- (read-string "Group name: ")
- (let ((method
- (completing-read
- "Method: " (append gnus-valid-select-methods gnus-server-alist)
- nil t nil 'gnus-method-history)))
- (cond ((assoc method gnus-valid-select-methods)
- (list method
- (if (memq 'prompt-address
- (assoc method gnus-valid-select-methods))
- (read-string "Address: ")
- "")))
- ((assoc method gnus-server-alist)
- (list method))
+;; Function written by Stainless Steel Rat <ratinox@peorth.gweep.net>
+(defun gnus-short-group-name (group &optional levels)
+ "Collapse GROUP name LEVELS.
+Select methods are stripped and any remote host name is stripped down to
+just the host name."
+ (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))))
+ ;; separate foreign select method from group name and collapse.
+ ;; if method contains a server, collapse to non-domain server name,
+ ;; otherwise collapse to select method
+ (when (string-match ":" group)
+ (cond ((string-match "+" group)
+ (let* ((plus (string-match "+" group))
+ (colon (string-match ":" group (or plus 0)))
+ (dot (string-match "\\." group)))
+ (setq foreign (concat
+ (substring group (+ 1 plus)
+ (cond ((null dot) colon)
+ ((< colon dot) colon)
+ ((< dot colon) dot)))
+ ":")
+ group (substring group (+ 1 colon)))))
(t
- (list method ""))))))
-
- (let* ((meth (and method (if address (list (intern method) address)
- method)))
- (nname (if method (gnus-group-prefixed-name name meth) name))
- backend info)
- (when (gnus-gethash nname gnus-newsrc-hashtb)
- (error "Group %s already exists" nname))
- ;; Subscribe to the new group.
- (gnus-group-change-level
- (setq info (list t nname gnus-level-default-subscribed nil nil meth))
- gnus-level-default-subscribed gnus-level-killed
- (and (gnus-group-group-name)
- (gnus-gethash (gnus-group-group-name)
- gnus-newsrc-hashtb))
- t)
- ;; Make it active.
- (gnus-set-active nname (cons 1 0))
- (or (gnus-ephemeral-group-p name)
- (gnus-dribble-enter
- (concat "(gnus-group-set-info '" (prin1-to-string (cdr info)) ")")))
- ;; Insert the line.
- (gnus-group-insert-group-line-info nname)
- (forward-line -1)
- (gnus-group-position-point)
-
- ;; Load the backend and try to make the backend create
- ;; the group as well.
- (when (assoc (symbol-name (setq backend (car (gnus-server-get-method
- nil meth))))
- gnus-valid-select-methods)
- (require backend))
- (gnus-check-server meth)
- (and (gnus-check-backend-function 'request-create-group nname)
- (gnus-request-create-group nname))
- t))
-
-(defun gnus-group-delete-group (group &optional force)
- "Delete the current group.
-If FORCE (the prefix) is non-nil, all the articles in the group will
-be deleted. This is \"deleted\" as in \"removed forever from the face
-of the Earth\". There is no undo."
- (interactive
- (list (gnus-group-group-name)
- current-prefix-arg))
- (or group (error "No group to rename"))
- (or (gnus-check-backend-function 'request-delete-group group)
- (error "This backend does not support group deletion"))
- (prog1
- (if (not (gnus-yes-or-no-p
- (format
- "Do you really want to delete %s%s? "
- group (if force " and all its contents" ""))))
- () ; Whew!
- (gnus-message 6 "Deleting group %s..." group)
- (if (not (gnus-request-delete-group group force))
- (gnus-error 3 "Couldn't delete group %s" group)
- (gnus-message 6 "Deleting group %s...done" group)
- (gnus-group-goto-group group)
- (gnus-group-kill-group 1 t)
- (gnus-sethash group nil gnus-active-hashtb)
- t))
- (gnus-group-position-point)))
-
-(defun gnus-group-rename-group (group new-name)
- (interactive
- (list
- (gnus-group-group-name)
- (progn
- (or (gnus-check-backend-function
- 'request-rename-group (gnus-group-group-name))
- (error "This backend does not support renaming groups"))
- (read-string "New group name: "))))
-
- (or (gnus-check-backend-function 'request-rename-group group)
- (error "This backend does not support renaming groups"))
-
- (or group (error "No group to rename"))
- (and (string-match "^[ \t]*$" new-name)
- (error "Not a valid group name"))
-
- ;; We find the proper prefixed name.
- (setq new-name
- (gnus-group-prefixed-name
- (gnus-group-real-name new-name)
- (gnus-info-method (gnus-get-info group))))
-
- (gnus-message 6 "Renaming group %s to %s..." group new-name)
- (prog1
- (if (not (gnus-request-rename-group group new-name))
- (gnus-error 3 "Couldn't rename group %s to %s" group new-name)
- ;; We rename the group internally by killing it...
- (gnus-group-goto-group group)
- (gnus-group-kill-group)
- ;; ... changing its name ...
- (setcar (cdar gnus-list-of-killed-groups) new-name)
- ;; ... and then yanking it. Magic!
- (gnus-group-yank-group)
- (gnus-set-active new-name (gnus-active group))
- (gnus-message 6 "Renaming group %s to %s...done" group new-name)
- new-name)
- (gnus-group-position-point)))
-
-(defun gnus-group-edit-group (group &optional part)
- "Edit the group on the current line."
- (interactive (list (gnus-group-group-name)))
- (let* ((part (or part 'info))
- (done-func `(lambda ()
- "Exit editing mode and update the information."
- (interactive)
- (gnus-group-edit-group-done ',part ,group)))
- (winconf (current-window-configuration))
- info)
- (or group (error "No group on current line"))
- (or (setq info (gnus-get-info group))
- (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)
- (emacs-lisp-mode)
- ;; Suggested by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>.
- (use-local-map (copy-keymap emacs-lisp-mode-map))
- (local-set-key "\C-c\C-c" done-func)
- (make-local-variable 'gnus-prev-winconf)
- (setq gnus-prev-winconf winconf)
- (erase-buffer)
- (insert
- (cond
- ((eq part 'method)
- ";; Type `C-c C-c' after editing the select method.\n\n")
- ((eq part 'params)
- ";; Type `C-c C-c' after editing the group parameters.\n\n")
- ((eq part 'info)
- ";; Type `C-c C-c' after editing the group info.\n\n")))
- (insert
- (pp-to-string
- (cond ((eq part 'method)
- (or (gnus-info-method info) "native"))
- ((eq part 'params)
- (gnus-info-params info))
- (t info)))
- "\n")))
-
-(defun gnus-group-edit-group-method (group)
- "Edit the select method of GROUP."
- (interactive (list (gnus-group-group-name)))
- (gnus-group-edit-group group 'method))
-
-(defun gnus-group-edit-group-parameters (group)
- "Edit the group parameters of GROUP."
- (interactive (list (gnus-group-group-name)))
- (gnus-group-edit-group group 'params))
-
-(defun gnus-group-edit-group-done (part group)
- "Get info from buffer, update variables and jump to the group buffer."
- (set-buffer (get-buffer-create gnus-group-edit-buffer))
- (goto-char (point-min))
- (let* ((form (read (current-buffer)))
- (winconf gnus-prev-winconf)
- (method (cond ((eq part 'info) (nth 4 form))
- ((eq part 'method) form)
- (t nil)))
- (info (cond ((eq part 'info) form)
- ((eq part 'method) (gnus-get-info group))
- (t nil)))
- (new-group (if info
- (if (or (not method)
- (gnus-server-equal
- gnus-select-method method))
- (gnus-group-real-name (car info))
- (gnus-group-prefixed-name
- (gnus-group-real-name (car info)) method))
- nil)))
- (when (and new-group
- (not (equal new-group group)))
- (when (gnus-group-goto-group group)
- (gnus-group-kill-group 1))
- (gnus-activate-group new-group))
- ;; Set the info.
- (if (and info new-group)
- (progn
- (setq info (gnus-copy-sequence info))
- (setcar info new-group)
- (unless (gnus-server-equal method "native")
- (unless (nthcdr 3 info)
- (nconc info (list nil nil)))
- (unless (nthcdr 4 info)
- (nconc info (list nil)))
- (gnus-info-set-method info method))
- (gnus-group-set-info info))
- (gnus-group-set-info form (or new-group group) part))
- (kill-buffer (current-buffer))
- (and winconf (set-window-configuration winconf))
- (set-buffer gnus-group-buffer)
- (gnus-group-update-group (or new-group group))
- (gnus-group-position-point)))
-
-(defun gnus-group-make-help-group ()
- "Create the Gnus documentation group."
- (interactive)
- (let ((path load-path)
- (name (gnus-group-prefixed-name "gnus-help" '(nndoc "gnus-help")))
- file dir)
- (and (gnus-gethash name gnus-newsrc-hashtb)
- (error "Documentation group already exists"))
- (while path
- (setq dir (file-name-as-directory (expand-file-name (pop path)))
- file nil)
- (when (or (file-exists-p (setq file (concat dir "gnus-tut.txt")))
- (file-exists-p
- (setq file (concat (file-name-directory
- (directory-file-name dir))
- "etc/gnus-tut.txt"))))
- (setq path nil)))
- (if (not file)
- (gnus-message 1 "Couldn't find doc group")
- (gnus-group-make-group
- (gnus-group-real-name name)
- (list 'nndoc "gnus-help"
- (list 'nndoc-address file)
- (list 'nndoc-article-type 'mbox)))))
- (gnus-group-position-point))
-
-(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: ")
- (and current-prefix-arg 'ask)))
- (when (eq type 'ask)
- (let ((err "")
- char found)
- (while (not found)
- (message
- "%sFile type (mbox, babyl, digest, forward, mmfd, guess) [mbdfag]: "
- err)
- (setq found (cond ((= (setq char (read-char)) ?m) 'mbox)
- ((= char ?b) 'babyl)
- ((= char ?d) 'digest)
- ((= char ?f) 'forward)
- ((= char ?a) 'mmfd)
- (t (setq err (format "%c unknown. " char))
- nil))))
- (setq type 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 (file-name-nondirectory file)
- (list 'nndoc-address file)
- (list 'nndoc-article-type (or type 'guess))))))
-
-(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)
- (list 'nndir (if all "hpc" "edu")
- (list 'nndir-directory
- (if all gnus-group-archive-directory
- gnus-group-recent-archive-directory))))))
-
-(defun gnus-group-make-directory-group (dir)
- "Create an nndir group.
-The user will be prompted for a directory. The contents of this
-directory will be used as a newsgroup. The directory should contain
-mail messages or news articles in files that have numeric names."
- (interactive
- (list (read-file-name "Create group from directory: ")))
- (or (file-exists-p dir) (error "No such directory"))
- (or (file-directory-p dir) (error "Not a directory"))
- (let ((ext "")
- (i 0)
- group)
- (while (or (not group) (gnus-gethash group gnus-newsrc-hashtb))
- (setq group
- (gnus-group-prefixed-name
- (concat (file-name-as-directory (directory-file-name dir))
- ext)
- '(nndir "")))
- (setq ext (format "<%d>" (setq i (1+ i)))))
- (gnus-group-make-group
- (gnus-group-real-name group)
- (list 'nndir group (list 'nndir-directory dir)))))
-
-(defun gnus-group-make-kiboze-group (group address scores)
- "Create an nnkiboze group.
-The user will be prompted for a name, a regexp to match groups, and
-score file entries for articles to include in the group."
- (interactive
- (list
- (read-string "nnkiboze group name: ")
- (read-string "Source groups (regexp): ")
- (let ((headers (mapcar (lambda (group) (list group))
- '("subject" "from" "number" "date" "message-id"
- "references" "chars" "lines" "xref"
- "followup" "all" "body" "head")))
- scores header regexp regexps)
- (while (not (equal "" (setq header (completing-read
- "Match on header: " headers nil t))))
- (setq regexps nil)
- (while (not (equal "" (setq regexp (read-string
- (format "Match on %s (string): "
- header)))))
- (setq regexps (cons (list regexp nil nil 'r) regexps)))
- (setq scores (cons (cons header regexps) scores)))
- scores)))
- (gnus-group-make-group group "nnkiboze" address)
- (nnheader-temp-write (gnus-score-file-name (concat "nnkiboze:" group))
- (let (emacs-lisp-mode-hook)
- (pp scores (current-buffer)))))
-
-(defun gnus-group-add-to-virtual (n vgroup)
- "Add the current group to a virtual group."
- (interactive
- (list current-prefix-arg
- (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))
- (method (gnus-info-method (gnus-get-info vgroup))))
- (setcar (cdr method)
- (concat
- (nth 1 method) "\\|"
- (mapconcat
- (lambda (s)
- (gnus-group-remove-mark s)
- (concat "\\(^" (regexp-quote s) "$\\)"))
- groups "\\|"))))
- (gnus-group-position-point))
-
-(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-point)))
-
-(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>.
-
-(defun gnus-group-sort-groups (func &optional reverse)
- "Sort the group buffer according to FUNC.
-If REVERSE, reverse the sorting order."
- (interactive (list gnus-group-sort-function
- current-prefix-arg))
- (let ((func (cond
- ((not (listp func)) func)
- ((null func) func)
- ((= 1 (length func)) (car func))
- (t `(lambda (t1 t2)
- ,(gnus-make-sort-function
- (reverse func)))))))
- ;; We peel off the dummy group from the alist.
- (when func
- (when (equal (car (gnus-info-group gnus-newsrc-alist)) "dummy.group")
- (pop gnus-newsrc-alist))
- ;; Do the sorting.
- (setq gnus-newsrc-alist
- (sort gnus-newsrc-alist func))
- (when reverse
- (setq gnus-newsrc-alist (nreverse gnus-newsrc-alist)))
- ;; Regenerate the hash table.
- (gnus-make-hashtable-from-newsrc-alist)
- (gnus-group-list-groups))))
-
-(defun gnus-group-sort-groups-by-alphabet (&optional reverse)
- "Sort the group buffer alphabetically by group name.
-If REVERSE, sort in reverse order."
- (interactive "P")
- (gnus-group-sort-groups 'gnus-group-sort-by-alphabet reverse))
+ (let* ((colon (string-match ":" group)))
+ (setq foreign (concat (substring group 0 (+ 1 colon)))
+ group (substring group (+ 1 colon)))))))
+ ;; collapse group name leaving LEVELS uncollapsed elements
+ (while group
+ (if (and (string-match "\\." group) (> levels 0))
+ (setq name (concat name (substring group 0 1))
+ group (substring group (match-end 0))
+ levels (- levels 1)
+ name (concat name "."))
+ (setq name (concat foreign name group)
+ group nil)))
+ name))
-(defun gnus-group-sort-groups-by-unread (&optional reverse)
- "Sort the group buffer by number of unread articles.
-If REVERSE, sort in reverse order."
- (interactive "P")
- (gnus-group-sort-groups 'gnus-group-sort-by-unread reverse))
+\f
+;;;
+;;; Kill file handling.
+;;;
-(defun gnus-group-sort-groups-by-level (&optional reverse)
- "Sort the group buffer by group level.
-If REVERSE, sort in reverse order."
- (interactive "P")
- (gnus-group-sort-groups 'gnus-group-sort-by-level reverse))
+(defun gnus-apply-kill-file ()
+ "Apply a kill file to the current newsgroup.
+Returns the number of articles marked as read."
+ (if (or (file-exists-p (gnus-newsgroup-kill-file nil))
+ (file-exists-p (gnus-newsgroup-kill-file gnus-newsgroup-name)))
+ (gnus-apply-kill-file-internal)
+ 0))
-(defun gnus-group-sort-groups-by-score (&optional reverse)
- "Sort the group buffer by group score.
-If REVERSE, sort in reverse order."
- (interactive "P")
- (gnus-group-sort-groups 'gnus-group-sort-by-score reverse))
+(defun gnus-kill-save-kill-buffer ()
+ (let ((file (gnus-newsgroup-kill-file gnus-newsgroup-name)))
+ (when (get-file-buffer file)
+ (save-excursion
+ (set-buffer (get-file-buffer file))
+ (when (buffer-modified-p)
+ (save-buffer))
+ (kill-buffer (current-buffer))))))
-(defun gnus-group-sort-groups-by-rank (&optional reverse)
- "Sort the group buffer by group rank.
-If REVERSE, sort in reverse order."
- (interactive "P")
- (gnus-group-sort-groups 'gnus-group-sort-by-rank reverse))
+(defcustom gnus-kill-file-name "KILL"
+ "Suffix of the kill files."
+ :group 'gnus-score
+ :type 'string)
-(defun gnus-group-sort-groups-by-method (&optional reverse)
- "Sort the group buffer alphabetically by backend name.
-If REVERSE, sort in reverse order."
- (interactive "P")
- (gnus-group-sort-groups 'gnus-group-sort-by-method reverse))
-
-(defun gnus-group-sort-by-alphabet (info1 info2)
- "Sort alphabetically."
- (string< (gnus-info-group info1) (gnus-info-group info2)))
-
-(defun gnus-group-sort-by-unread (info1 info2)
- "Sort by number of unread articles."
- (let ((n1 (car (gnus-gethash (gnus-info-group info1) gnus-newsrc-hashtb)))
- (n2 (car (gnus-gethash (gnus-info-group info2) gnus-newsrc-hashtb))))
- (< (or (and (numberp n1) n1) 0)
- (or (and (numberp n2) n2) 0))))
-
-(defun gnus-group-sort-by-level (info1 info2)
- "Sort by level."
- (< (gnus-info-level info1) (gnus-info-level info2)))
-
-(defun gnus-group-sort-by-method (info1 info2)
- "Sort alphabetically by backend name."
- (string< (symbol-name (car (gnus-find-method-for-group
- (gnus-info-group info1) info1)))
- (symbol-name (car (gnus-find-method-for-group
- (gnus-info-group info2) info2)))))
-
-(defun gnus-group-sort-by-score (info1 info2)
- "Sort by group score."
- (< (gnus-info-score info1) (gnus-info-score info2)))
-
-(defun gnus-group-sort-by-rank (info1 info2)
- "Sort by level and score."
- (let ((level1 (gnus-info-level info1))
- (level2 (gnus-info-level info2)))
- (or (< level1 level2)
- (and (= level1 level2)
- (> (gnus-info-score info1) (gnus-info-score info2))))))
-
-;; Group catching up.
-
-(defun gnus-group-clear-data (n)
- "Clear all marks and read ranges from the current group."
- (interactive "P")
- (let ((groups (gnus-group-process-prefix n))
- group info)
- (while (setq group (pop groups))
- (setq info (gnus-get-info group))
- (gnus-info-set-read info nil)
- (when (gnus-info-marks info)
- (gnus-info-set-marks info nil))
- (gnus-get-unread-articles-in-group info (gnus-active group) t)
- (when (gnus-group-goto-group group)
- (gnus-group-remove-mark group)
- (gnus-group-update-group-line)))))
-
-(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
-read. Cross references (Xref: header) of articles are ignored.
-The difference between N and actual number of newsgroups that were
-caught up is returned."
- (interactive "P")
- (if (not (or (not gnus-interactive-catchup) ;Without confirmation?
- gnus-expert-user
- (gnus-y-or-n-p
- (if all
- "Do you really want to mark all articles as read? "
- "Mark all unread articles as read? "))))
- n
- (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 (>= (gnus-group-group-level) gnus-level-zombie)
- (gnus-message 2 "Dead groups can't be caught up")
- (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 (&optional n)
- "Mark all articles in current newsgroup as read.
-Cross references (Xref: header) of articles are ignored."
- (interactive "P")
- (gnus-group-catchup-current n 'all))
-
-(defun gnus-group-catchup (group &optional all)
- "Mark all articles in GROUP as read.
-If ALL is non-nil, all articles are marked as read.
-The return value is the number of articles that were marked as read,
-or nil if no action could be taken."
- (let* ((entry (gnus-gethash group gnus-newsrc-hashtb))
- (num (car entry)))
- ;; Do the updating only if the newsgroup isn't killed.
- (if (not (numberp (car entry)))
- (gnus-message 1 "Can't catch up; non-active group")
- ;; Do auto-expirable marks if that's required.
- (when (gnus-group-auto-expirable-p group)
- (gnus-add-marked-articles
- group 'expire (gnus-list-of-unread-articles group))
- (when all
- (let ((marks (nth 3 (nth 2 entry))))
- (gnus-add-marked-articles
- group 'expire (gnus-uncompress-range (cdr (assq 'tick marks))))
- (gnus-add-marked-articles
- group 'expire (gnus-uncompress-range (cdr (assq 'tick marks)))))))
- (when entry
- (gnus-update-read-articles group nil)
- ;; Also nix out the lists of marks and dormants.
- (when all
- (gnus-add-marked-articles group 'tick nil nil 'force)
- (gnus-add-marked-articles group 'dormant nil nil 'force))
- (run-hooks 'gnus-group-catchup-group-hook)
- num))))
-
-(defun gnus-group-expire-articles (&optional n)
- "Expire all expirable articles in the current newsgroup."
- (interactive "P")
- (let ((groups (gnus-group-process-prefix n))
- group)
- (unless groups
- (error "No groups to expire"))
- (while (setq group (pop groups))
- (gnus-group-remove-mark group)
- (when (gnus-check-backend-function 'request-expire-articles group)
- (gnus-message 6 "Expiring articles in %s..." group)
- (let* ((info (gnus-get-info group))
- (expirable (if (gnus-group-total-expirable-p group)
- (cons nil (gnus-list-of-read-articles group))
- (assq 'expire (gnus-info-marks info))))
- (expiry-wait (gnus-group-get-parameter group 'expiry-wait)))
- (when expirable
- (setcdr
- expirable
- (gnus-compress-sequence
- (if expiry-wait
- ;; We set the expiry variables to the groupp
- ;; parameter.
- (let ((nnmail-expiry-wait-function nil)
- (nnmail-expiry-wait expiry-wait))
- (gnus-request-expire-articles
- (gnus-uncompress-sequence (cdr expirable)) group))
- ;; Just expire using the normal expiry values.
- (gnus-request-expire-articles
- (gnus-uncompress-sequence (cdr expirable)) group)))))
- (gnus-message 6 "Expiring articles in %s...done" group)))
- (gnus-group-position-point))))
-
-(defun gnus-group-expire-all-groups ()
- "Expire all expirable articles in all newsgroups."
- (interactive)
- (save-excursion
- (gnus-message 5 "Expiring...")
- (let ((gnus-group-marked (mapcar (lambda (info) (gnus-info-group info))
- (cdr gnus-newsrc-alist))))
- (gnus-group-expire-articles nil)))
- (gnus-group-position-point)
- (gnus-message 5 "Expiring...done"))
-
-(defun gnus-group-set-current-level (n level)
- "Set the level of the next N groups to LEVEL."
- (interactive
- (list
- current-prefix-arg
- (string-to-int
- (let ((s (read-string
- (format "Level (default %s): "
- (or (gnus-group-group-level)
- gnus-level-default-subscribed)))))
- (if (string-match "^\\s-*$" s)
- (int-to-string (or (gnus-group-group-level)
- gnus-level-default-subscribed))
- s)))))
- (or (and (>= level 1) (<= level gnus-level-killed))
- (error "Illegal level: %d" level))
- (let ((groups (gnus-group-process-prefix n))
- group)
- (while (setq group (pop groups))
- (gnus-group-remove-mark group)
- (gnus-message 6 "Changed level of %s from %d to %d"
- group (or (gnus-group-group-level) gnus-level-killed)
- level)
- (gnus-group-change-level
- group level (or (gnus-group-group-level) gnus-level-killed))
- (gnus-group-update-group-line)))
- (gnus-group-position-point))
-
-(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 ((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) t)
- (gnus-group-update-group-line))
- (gnus-group-next-group 1)))
-
-(defun gnus-group-unsubscribe-group (group &optional level silent)
- "Toggle subscription to GROUP.
-Killed newsgroups are subscribed. If SILENT, don't try to update the
-group line."
- (interactive
- (list (completing-read
- "Group: " gnus-active-hashtb nil
- (gnus-read-active-file-p)
- nil
- 'gnus-group-history)))
- (let ((newsrc (gnus-gethash group gnus-newsrc-hashtb)))
- (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)))
- (unless silent
- (gnus-group-update-group group)))
- ((and (stringp group)
- (or (not (gnus-read-active-file-p))
- (gnus-active group)))
- ;; 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)))
- (unless silent
- (gnus-group-update-group group)))
- (t (error "No such newsgroup: %s" group)))
- (gnus-group-position-point)))
-
-(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 returned."
- (interactive "p")
- (or (gnus-group-group-name)
- (error "No group on current line"))
- (gnus-group-kill-group 1)
- (prog1
- (forward-line (- n))
- (gnus-group-yank-group)
- (gnus-group-position-point)))
-
-(defun gnus-group-kill-all-zombies ()
- "Kill all zombie newsgroups."
- (interactive)
- (setq gnus-killed-list (nconc gnus-zombie-list gnus-killed-list))
- (setq gnus-zombie-list nil)
- (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
- ;; 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 (&optional n discard)
- "Kill 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
-groups or zombie groups can't be yanked.
-The return value is the name of the group that was killed, or a list
-of groups killed."
- (interactive "P")
- (let ((buffer-read-only nil)
- (groups (gnus-group-process-prefix n))
- group entry level out)
- (if (< (length groups) 10)
- ;; This is faster when there are few groups.
- (while groups
- (push (setq group (pop groups)) out)
- (gnus-group-remove-mark group)
- (setq level (gnus-group-group-level))
- (gnus-delete-line)
- (when (and (not discard)
- (setq entry (gnus-gethash group gnus-newsrc-hashtb)))
- (push (cons (car entry) (nth 2 entry))
- gnus-list-of-killed-groups))
- (gnus-group-change-level
- (if entry entry group) gnus-level-killed (if entry nil level)))
- ;; If there are lots and lots of groups to be killed, we use
- ;; this thing instead.
- (let (entry)
- (setq groups (nreverse groups))
- (while groups
- (gnus-group-remove-mark (setq group (pop groups)))
- (gnus-delete-line)
- (cond
- ((setq entry (gnus-gethash group gnus-newsrc-hashtb))
- (push (cons (car entry) (nth 2 entry))
- gnus-list-of-killed-groups)
- (setcdr (cdr entry) (cdddr entry)))
- ((member group gnus-zombie-list)
- (setq gnus-zombie-list (delete group gnus-zombie-list)))))
- (gnus-make-hashtable-from-newsrc-alist)))
-
- (gnus-group-position-point)
- (if (< (length out) 2) (car out) (nreverse out))))
-
-(defun gnus-group-yank-group (&optional arg)
- "Yank the last newsgroups killed with \\[gnus-group-kill-group],
-inserting it before the current newsgroup. The numeric ARG specifies
-how many newsgroups are to be yanked. The name of the newsgroup yanked
-is returned, or (if several groups are yanked) a list of yanked groups
-is returned."
- (interactive "p")
- (setq arg (or arg 1))
- (let (info group prev out)
- (while (>= (decf arg) 0)
- (if (not (setq info (pop gnus-list-of-killed-groups)))
- (error "No more newsgroups to yank"))
- (push (setq group (nth 1 info)) out)
- ;; Find which newsgroup to insert this one before - search
- ;; backward until something suitable is found. If there are no
- ;; other newsgroups in this buffer, just make this newsgroup the
- ;; first newsgroup.
- (setq prev (gnus-group-group-name))
- (gnus-group-change-level
- info (gnus-info-level (cdr info)) gnus-level-killed
- (and prev (gnus-gethash prev gnus-newsrc-hashtb))
- t)
- (gnus-group-insert-group-line-info group))
- (forward-line -1)
- (gnus-group-position-point)
- (if (< (length out) 2) (car out) (nreverse out))))
-
-(defun gnus-group-kill-level (level)
- "Kill all groups that is on a certain LEVEL."
- (interactive "nKill all groups on level: ")
- (cond
- ((= level gnus-level-zombie)
- (setq gnus-killed-list
- (nconc gnus-zombie-list gnus-killed-list))
- (setq gnus-zombie-list nil))
- ((and (< level gnus-level-zombie)
- (> level 0)
- (or gnus-expert-user
- (gnus-yes-or-no-p
- (format
- "Do you really want to kill all groups on level %d? "
- level))))
- (let* ((prev gnus-newsrc-alist)
- (alist (cdr prev)))
- (while alist
- (if (= (gnus-info-level level) level)
- (setcdr prev (cdr alist))
- (setq prev alist))
- (setq alist (cdr alist)))
- (gnus-make-hashtable-from-newsrc-alist)
- (gnus-group-list-groups)))
+(defun gnus-newsgroup-kill-file (newsgroup)
+ "Return the name of a kill file name for NEWSGROUP.
+If NEWSGROUP is nil, return the global kill file name instead."
+ (cond
+ ;; The global KILL file is placed at top of the directory.
+ ((or (null newsgroup)
+ (string-equal newsgroup ""))
+ (expand-file-name gnus-kill-file-name
+ gnus-kill-files-directory))
+ ;; Append ".KILL" to newsgroup name.
+ ((gnus-use-long-file-name 'not-kill)
+ (expand-file-name (concat (gnus-newsgroup-savable-name newsgroup)
+ "." gnus-kill-file-name)
+ gnus-kill-files-directory))
+ ;; Place "KILL" under the hierarchical directory.
(t
- (error "Can't kill; illegal level: %d" level))))
-
-(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")
- (gnus-group-list-groups (or arg gnus-level-unsubscribed) t))
-
-;; Redefine this to list ALL killed groups if prefix arg used.
-;; Rewritten by engstrom@src.honeywell.com (Eric Engstrom).
-(defun gnus-group-list-killed (&optional arg)
- "List all killed newsgroups in the group buffer.
-If ARG is non-nil, list ALL killed groups known to Gnus. This may
-entail asking the server for the groups."
- (interactive "P")
- ;; Find all possible killed newsgroups if arg.
- (when arg
- (gnus-get-killed-groups))
- (if (not gnus-killed-list)
- (gnus-message 6 "No killed groups")
- (let (gnus-group-list-mode)
- (funcall gnus-group-prepare-function
- gnus-level-killed t gnus-level-killed))
- (goto-char (point-min)))
- (gnus-group-position-point))
-
-(defun gnus-group-list-zombies ()
- "List all zombie newsgroups in the group buffer."
- (interactive)
- (if (not gnus-zombie-list)
- (gnus-message 6 "No zombie groups")
- (let (gnus-group-list-mode)
- (funcall gnus-group-prepare-function
- gnus-level-zombie t gnus-level-zombie))
- (goto-char (point-min)))
- (gnus-group-position-point))
-
-(defun gnus-group-list-active ()
- "List all groups that are available from the server(s)."
- (interactive)
- ;; First we make sure that we have really read the active file.
- (unless (gnus-read-active-file-p)
- (let ((gnus-read-active-file t))
- (gnus-read-active-file)))
- ;; Find all groups and sort them.
- (let ((groups
- (sort
- (let (list)
- (mapatoms
- (lambda (sym)
- (and (boundp sym)
- (symbol-value sym)
- (setq list (cons (symbol-name sym) list))))
- gnus-active-hashtb)
- list)
- 'string<))
- (buffer-read-only nil))
- (erase-buffer)
- (while groups
- (gnus-group-insert-group-line-info (pop groups)))
- (goto-char (point-min))))
-
-(defun gnus-activate-all-groups (level)
- "Activate absolutely all groups."
- (interactive (list 7))
- (let ((gnus-activate-level level)
- (gnus-activate-foreign-newsgroups level))
- (gnus-group-get-new-news)))
-
-(defun gnus-group-get-new-news (&optional arg)
- "Get newly arrived articles.
-If ARG is a number, it specifies which levels you are interested in
-re-scanning. If ARG is non-nil and not a number, this will force
-\"hard\" re-reading of the active files from all servers."
- (interactive "P")
- (run-hooks 'gnus-get-new-news-hook)
- ;; We might read in new NoCeM messages here.
- (when (and gnus-use-nocem
- (null arg))
- (gnus-nocem-scan-groups))
- ;; If ARG is not a number, then we read the active file.
- (when (and arg (not (numberp arg)))
- (let ((gnus-read-active-file t))
- (gnus-read-active-file))
- (setq arg nil))
-
- (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 arg))
- (let ((gnus-read-active-file (if arg nil gnus-read-active-file)))
- (gnus-get-unread-articles arg)))
- (run-hooks 'gnus-after-getting-new-news-hook)
- (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))
- (beg (unless n (point)))
- group)
- (while (setq group (pop groups))
- (gnus-group-remove-mark group)
- (if (gnus-activate-group group 'scan)
- (progn
- (gnus-get-unread-articles-in-group
- (gnus-get-info group) (gnus-active group) t)
- (unless (gnus-virtual-group-p group)
- (gnus-close-group group))
- (gnus-group-update-group group))
- (gnus-error 3 "%s error: %s" group (gnus-status-message group))))
- (when beg (goto-char beg))
- (when gnus-goto-next-group-when-activating
- (gnus-group-next-unread-group 1 t))
- (gnus-summary-position-point)
- ret))
-
-(defun gnus-group-fetch-faq (group &optional faq-dir)
- "Fetch the FAQ for the current group."
- (interactive
- (list
- (gnus-group-real-name (gnus-group-group-name))
- (cond (current-prefix-arg
- (completing-read
- "Faq dir: " (and (listp gnus-group-faq-directory)
- gnus-group-faq-directory))))))
- (or faq-dir
- (setq faq-dir (if (listp gnus-group-faq-directory)
- (car gnus-group-faq-directory)
- gnus-group-faq-directory)))
- (or group (error "No group name given"))
- (let ((file (concat (file-name-as-directory faq-dir)
- (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 (list current-prefix-arg (gnus-group-group-name)))
- (and force (setq gnus-description-hashtb nil))
- (let ((method (gnus-find-method-for-group group))
- desc)
- (or group (error "No group name given"))
- (and (or (and gnus-description-hashtb
- ;; We check whether this group's method has been
- ;; queried for a description file.
- (gnus-gethash
- (gnus-group-prefixed-name "" method)
- gnus-description-hashtb))
- (setq desc (gnus-group-get-description group))
- (gnus-read-descriptions-file method))
- (gnus-message 1
- (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 (&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-all-descriptions-files)))
- (error "Couldn't request descriptions file"))
- (let ((buffer-read-only nil)
- b)
- (erase-buffer)
- (mapatoms
- (lambda (group)
- (setq b (point))
- (insert (format " *: %-20s %s\n" (symbol-name group)
- (symbol-value group)))
- (gnus-add-text-properties
- b (1+ b) (list 'gnus-group group
- 'gnus-unread t 'gnus-marked nil
- 'gnus-level (1+ gnus-level-subscribed))))
- gnus-description-hashtb)
- (goto-char (point-min))
- (gnus-group-position-point)))
-
-;; Suggested by by Daniel Quinlan <quinlan@best.com>.
-(defun gnus-group-apropos (regexp &optional search-description)
- "List all newsgroups that have names that match a regexp."
- (interactive "sGnus apropos (regexp): ")
- (let ((prev "")
- (obuf (current-buffer))
- groups des)
- ;; Go through all newsgroups that are known to Gnus.
- (mapatoms
- (lambda (group)
- (and (symbol-name group)
- (string-match regexp (symbol-name group))
- (setq groups (cons (symbol-name group) groups))))
- gnus-active-hashtb)
- ;; Also go through all descriptions that are known to Gnus.
- (when search-description
- (mapatoms
- (lambda (group)
- (and (string-match regexp (symbol-value group))
- (gnus-active (symbol-name group))
- (setq groups (cons (symbol-name group) groups))))
- gnus-description-hashtb))
- (if (not groups)
- (gnus-message 3 "No groups matched \"%s\"." regexp)
- ;; Print out all the groups.
- (save-excursion
- (pop-to-buffer "*Gnus Help*")
- (buffer-disable-undo (current-buffer))
- (erase-buffer)
- (setq groups (sort groups 'string<))
- (while groups
- ;; Groups may be entered twice into the list of groups.
- (if (not (string= (car groups) prev))
- (progn
- (insert (setq prev (car groups)) "\n")
- (if (and gnus-description-hashtb
- (setq des (gnus-gethash (car groups)
- gnus-description-hashtb)))
- (insert " " des "\n"))))
- (setq groups (cdr groups)))
- (goto-char (point-min))))
- &
projects / gnus / blobdiff