;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to
-;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
;;; Commentary:
(require 'mail-utils)
(require 'timezone)
(require 'nnheader)
+(require 'message)
+(require 'nnmail)
+(require 'backquote)
(eval-when-compile (require 'cl))
+;;;###autoload
+(defvar gnus-directory (or (getenv "SAVEDIR") "~/News/")
+ "*Directory variable from which all other Gnus file variables are derived.")
+
;; Site dependent variables. These variables should be defined in
;; paths.el.
variable, or returned by the function) is a file name, the contents of
this file will be used as the organization.")
-(defvar gnus-use-generic-from nil
- "If nil, the full host name will be the system name prepended to the domain name.
-If this is a string, the full host name will be this string.
-If this is non-nil, non-string, the domain name will be used as the
-full host name.")
-
-(defvar gnus-use-generic-path nil
- "If nil, use the NNTP server name in the Path header.
-If stringp, use this; if non-nil, use no host name (user name only).")
-
-
;; Customization variables
;; Don't touch this variable.
see the manual for details.")
(defvar gnus-message-archive-method
- '(nnfolder "archive" (nnfolder-directory "~/Mail/archive/")
- (nnfolder-active-file "~/Mail/archive/active")
- (nnfolder-get-new-mail nil)
- (nnfolder-inhibit-expiry t))
+ `(nnfolder
+ "archive"
+ (nnfolder-directory ,(nnheader-concat message-directory "archive"))
+ (nnfolder-active-file
+ ,(nnheader-concat message-directory "archive/active"))
+ (nnfolder-get-new-mail nil)
+ (nnfolder-inhibit-expiry t))
"*Method used for archiving messages you've sent.
This should be a mail method.")
nntp method, you might get acceptable results.
The value of this variable must be a valid select method as discussed
-in the documentation of `gnus-select-method'")
+in the documentation of `gnus-select-method'.")
(defvar gnus-secondary-select-methods nil
"*A list of secondary methods that will be used for reading news.
(defvar gnus-group-faq-directory
'("/ftp@mirrors.aol.com:/pub/rtfm/usenet/"
-; "/ftp@ftp.uu.net:/usenet/news.answers/"
+ "/ftp@sunsite.auc.dk:/pub/usenet/"
+ "/ftp@src.doc.ic.ac.uk:/usenet/news-FAQS/"
"/ftp@ftp.seas.gwu.edu:/pub/rtfm/"
- "/ftp@rtfm.mit.edu:/pub/usenet/news.answers/"
+ "/ftp@rtfm.mit.edu:/pub/usenet/"
"/ftp@ftp.uni-paderborn.de:/pub/FAQ/"
-; "/ftp@ftp.Germany.EU.net:/pub/newsarchive/news.answers/"
"/ftp@ftp.sunet.se:/pub/usenet/"
"/ftp@nctuccca.edu.tw:/USENET/FAQ/"
- "/ftp@hwarang.postech.ac.kr:/pub/usenet/news.answers/"
+ "/ftp@hwarang.postech.ac.kr:/pub/usenet/"
"/ftp@ftp.hk.super.net:/mirror/faqs/")
"*Directory where the group FAQs are stored.
This will most commonly be on a remote machine, and the file will be
North America: mirrors.aol.com /pub/rtfm/usenet
ftp.seas.gwu.edu /pub/rtfm
- rtfm.mit.edu /pub/usenet/news.answers
+ rtfm.mit.edu /pub/usenet
Europe: ftp.uni-paderborn.de /pub/FAQ
+ src.doc.ic.ac.uk /usenet/news-FAQS
ftp.sunet.se /pub/usenet
+ sunsite.auc.dk /pub/usenet
Asia: nctuccca.edu.tw /USENET/FAQ
- hwarang.postech.ac.kr /pub/usenet/news.answers
+ hwarang.postech.ac.kr /pub/usenet
ftp.hk.super.net /mirror/faqs")
(defvar gnus-group-archive-directory
saving; and if it contains the element `not-kill', long file names
will not be used for kill files.")
-(defvar gnus-article-save-directory (or (getenv "SAVEDIR") "~/News/")
- "*Name of the directory articles will be saved in (default \"~/News\").
-Initialized from the SAVEDIR environment variable.")
+(defvar gnus-article-save-directory gnus-directory
+ "*Name of the directory articles will be saved in (default \"~/News\").")
-(defvar gnus-kill-files-directory (or (getenv "SAVEDIR") "~/News/")
- "*Name of the directory where kill files will be stored (default \"~/News\").
-Initialized from the SAVEDIR environment variable.")
+(defvar gnus-kill-files-directory gnus-directory
+ "*Name of the directory where kill files will be stored (default \"~/News\").")
(defvar gnus-default-article-saver 'gnus-summary-save-in-rmail
"*A function to save articles in your favorite format.
(defvar gnus-use-adaptive-scoring nil
"*If non-nil, use some adaptive scoring scheme.")
-(defvar gnus-use-cache nil
+(defvar gnus-use-cache 'passive
"*If nil, Gnus will ignore the article cache.
If `passive', it will allow entering (and reading) articles
explicitly entered into the cache. If anything else, use the
(defvar gnus-use-trees nil
"*If non-nil, display a thread tree buffer.")
+(defvar gnus-use-grouplens nil
+ "*If non-nil, use GroupLens ratings.")
+
(defvar gnus-keep-backlog nil
"*If non-nil, Gnus will keep read articles for later re-retrieval.
If it is a number N, then Gnus will only keep the last N articles
(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 non-nil and non-`some', fill in all gaps that Gnus
-manages to guess.")
+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.
(defvar gnus-interactive-catchup t
"*If non-nil, require your confirmation when catching up a group.")
-(defvar gnus-interactive-post t
- "*If non-nil, group name will be asked for when posting.")
-
(defvar gnus-interactive-exit t
"*If non-nil, require your confirmation when exiting Gnus.")
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-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.")
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.")
+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.")
current article is unread.")
(defvar gnus-auto-center-summary t
- "*If non-nil, always center the current summary buffer.")
+ "*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.
(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))
+ (vertical ((height . 5) (width . 15)
+ (user-position . t)
+ (left . -1) (top . 1))
(picons 1.0))))
(gnus-use-trees
'(vertical 1.0
(vertical 1.0
(browse 1.0 point)
(if gnus-carpal '(browse-carpal 2))))
- (group-mail
- (vertical 1.0
- (mail 1.0 point)))
- (summary-mail
+ (message
(vertical 1.0
- (mail 1.0 point)))
- (summary-reply
- (vertical 1.0
- (article 0.5)
- (mail 1.0 point)))
+ (message 1.0 point)))
(pick
(vertical 1.0
(article 1.0 point)))
(info
(vertical 1.0
- (nil 1.0 point)))
+ (info 1.0 point)))
(summary-faq
(vertical 1.0
(summary 0.25)
(post 1.0 point)))
(reply
(vertical 1.0
- (article 0.5)
- (mail 1.0 point)))
- (mail-forward
- (vertical 1.0
- (mail 1.0 point)))
- (post-forward
+ (article-copy 0.5)
+ (message 1.0 point)))
+ (forward
(vertical 1.0
- (post 1.0 point)))
+ (message 1.0 point)))
(reply-yank
(vertical 1.0
- (mail 1.0 point)))
+ (message 1.0 point)))
(mail-bounce
(vertical 1.0
(article 0.5)
- (mail 1.0 point)))
+ (message 1.0 point)))
(draft
(vertical 1.0
(draft 1.0 point)))
(summary 0.25 point)
(if gnus-carpal '(summary-carpal 4))
("*Shell Command Output*" 1.0)))
- (followup
+ (bug
(vertical 1.0
- (article 0.5)
- (post 1.0 point)))
- (followup-yank
+ ("*Gnus Help Bug*" 0.5)
+ ("*Gnus Bug*" 1.0 point)))
+ (compose-bounce
(vertical 1.0
- (post 1.0 point))))
+ (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
(server-carpal . gnus-carpal-server-buffer)
(browse-carpal . gnus-carpal-browse-buffer)
(edit-score . gnus-score-edit-buffer)
- (mail . gnus-mail-buffer)
- (post . gnus-post-news-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.")
`gnus-subscribe-alphabetically' inserts new groups in strict
alphabetic order; `gnus-subscribe-hierarchically' inserts new groups
in hierarchical newsgroup order; `gnus-subscribe-interactively' asks
-for your decision; `gnus-subscribe-killed' kills all new groups.")
+for your decision; `gnus-subscribe-killed' kills all new groups;
+`gnus-subscribe-zombies' will make all new groups into zombies.")
;; Suggested by a bug report by Hallvard B Furuseth.
;; <h.b.furuseth@usit.uio.no>.
(defvar gnus-insert-pseudo-articles t
"*If non-nil, insert pseudo-articles when decoding articles.")
-(defvar gnus-group-line-format "%M%S%p%P%5y: %(%g%)\n"
+(defvar gnus-group-line-format "%M%S%p%P%5y: %(%g%)%l\n"
"*Format of group lines.
It works along the same lines as a normal formatting string,
with some simple extensions.
%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
%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
This restriction may disappear in later versions of Gnus.")
(defvar gnus-summary-dummy-line-format
- "* %(: :%) %S\n"
+ "* %(: :%) %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.
"*The format specification for the article mode line.
See `gnus-summary-mode-line-format' for a closer description.")
-(defvar gnus-group-mode-line-format "Gnus: %%b {%M:%S}"
+(defvar gnus-group-mode-line-format "Gnus: %%b {%M%:%S}"
"*The format specification for the group mode line.
It works along the same lines as a normal formatting string,
with some simple extensions:
%S The native news server.
-%M The native select method.")
+%M The native select method.
+%: \":\" if %S isn't \"\".")
(defvar gnus-valid-select-methods
'(("nntp" post address prompt-address)
- ("nnspool" post)
+ ("nnspool" post address)
("nnvirtual" post-mail virtual prompt-address)
- ("nnmbox" mail respool)
- ("nnml" mail respool)
- ("nnmh" mail respool)
+ ("nnmbox" mail respool address)
+ ("nnml" mail respool address)
+ ("nnmh" mail respool address)
("nndir" post-mail prompt-address address)
- ("nneething" none prompt-address)
- ("nndoc" none prompt-address)
- ("nnbabyl" mail respool)
- ("nnkiboze" post virtual)
- ("nnsoup" post-mail)
- ("nnfolder" mail respool))
+ ("nneething" none address prompt-address)
+ ("nndoc" none address prompt-address)
+ ("nnbabyl" mail address respool)
+ ("nnkiboze" post address virtual)
+ ("nnsoup" post-mail address)
+ ("nndraft" post-mail)
+ ("nnfolder" mail respool address))
"An alist of valid select methods.
The first element of each list lists should be a string with the name
of the select method. The other elements may be be the category of
; "*Face used for mouse highlighting in Gnus.
;No mouse highlights will be done if `gnus-visual' is nil.")
-(defvar gnus-summary-mark-below nil
+(defvar gnus-summary-mark-below 0
"*Mark all articles with a score below this variable as read.
This variable is local to each summary buffer and usually set by the
score file.")
(say) one week. (This only goes for mail groups and the like, of
course.)")
+(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.")
+ "*Non-nil means .newsrc should be deleted prior to save.
+Its use is due to the bogus appearance that .newsrc was modified on
+disc.")
;; Hooks.
(defvar gnus-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-group-update-group-hook nil
+ "*A hook called when updating group lines.")
+
(defvar gnus-open-server-hook nil
"*A hook called just before opening connection to the news server.")
(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;
(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-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.")
highlight the line according to the `gnus-summary-highlight'
variable.")
-(defvar gnus-mark-article-hook (list 'gnus-summary-mark-unread-as-read)
+(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.")
(remove-hook 'gnus-summary-prepare-hook
'hilit-rehighlight-buffer-quietly)
(remove-hook 'gnus-summary-prepare-hook 'hilit-install-line-hooks)
- (setq gnus-mark-article-hook '(gnus-summary-mark-unread-as-read))
+ (setq gnus-mark-article-hook
+ '(gnus-summary-mark-read-and-unread-as-read))
(remove-hook 'gnus-article-prepare-hook
'hilit-rehighlight-buffer-quietly)))
-
\f
;; Internal variables
+(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-group-history nil)
+;; Variable holding the user answers to all group prompts.
+
+(defvar gnus-server-alist nil
+ "List of available servers.")
+
+(defvar gnus-group-indentation-function nil)
+
+(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)))
+ (cached . cache)
+ ))
;; Avoid highlighting in kill files.
(defvar gnus-summary-inhibit-highlight nil)
(defvar gnus-newsgroup-selected-overlay nil)
(defvar gnus-inhibit-hiding nil)
-(defvar gnus-topic-indentation "")
+(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-override-method nil)
(defvar gnus-article-check-size nil)
-(defvar gnus-nocem-hashtb 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)
`((?M gnus-tmp-marked-mark ?c)
(?S gnus-tmp-subscribed ?c)
(?L gnus-tmp-level ?d)
- (?N gnus-tmp-number ?s)
+ (?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 ?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)
(?p gnus-tmp-process-marked ?c)
(?s gnus-tmp-news-server ?s)
(?n gnus-tmp-news-method ?s)
- (?P gnus-topic-indentation ?s)
+ (?P gnus-group-indentation ?s)
+ (?l gnus-tmp-grouplens ?s)
(?z gnus-tmp-news-method-string ?s)
(?u gnus-tmp-user-defined ?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
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))))
+ `((?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))))
+ `((?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))))
+ `((?S gnus-tmp-news-server ?s)
+ (?M gnus-tmp-news-method ?s)
+ (?u gnus-tmp-user-defined ?s)
+ (?: gnus-tmp-colon ?s)))
(defvar gnus-have-read-active-file nil)
"gnus-bug@ifi.uio.no (The Gnus Bugfixing Girls + Boys)"
"The mail address of the Gnus maintainers.")
-(defconst gnus-version "September Gnus v0.27"
+(defconst gnus-version-number "5.2.6"
"Version number for this version of Gnus.")
+(defconst gnus-version (format "Gnus v%s" gnus-version-number)
+ "Version string for this version of Gnus.")
+
(defvar gnus-info-nodes
- '((gnus-group-mode "(gnus)The Group Buffer")
- (gnus-summary-mode "(gnus)The Summary Buffer")
- (gnus-article-mode "(gnus)The Article Buffer"))
- "Assoc list of major modes and related Info nodes.")
+ '((gnus-group-mode "(gnus)The Group Buffer")
+ (gnus-summary-mode "(gnus)The Summary Buffer")
+ (gnus-article-mode "(gnus)The Article Buffer"))
+ "Alist of major modes and related Info nodes.")
(defvar gnus-group-buffer "*Group*")
(defvar gnus-summary-buffer "*Summary*")
(defvar gnus-buffer-list nil
"Gnus buffers that should be killed on exit.")
-(defvar gnus-server-alist nil
- "List of available servers.")
-
(defvar gnus-slave nil
"Whether this Gnus is a slave or not.")
;;; Let the byte-compiler know that we know about this variable.
(defvar rmail-default-rmail-file)
-(defvar gnus-cache-removeable-articles nil)
+(defvar gnus-cache-removable-articles nil)
(defvar gnus-dead-summary nil)
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-newsgroup-async gnus-thread-expunge-below
gnus-score-alist gnus-current-score-file gnus-summary-expunge-below
- gnus-summary-mark-below gnus-newsgroup-active gnus-scores-exclude-files
+ (gnus-summary-mark-below . global)
+ gnus-newsgroup-active gnus-scores-exclude-files
gnus-newsgroup-history gnus-newsgroup-ancient
gnus-newsgroup-sparse
(gnus-newsgroup-adaptive . gnus-use-adaptive-scoring)
gnus-newsgroup-adaptive-score-file
(gnus-newsgroup-expunged-tally . 0)
- gnus-cache-removeable-articles gnus-newsgroup-cached
+ 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.")
("nnvirtual" nnvirtual-catchup-group)
("timezone" timezone-make-date-arpa-standard timezone-fix-time
timezone-make-sortable-date timezone-make-time-string)
- ("sendmail" mail-position-on-field mail-setup)
("rmailout" rmail-output)
- ("rnewspost" news-mail-other-window news-reply-yank-original
- news-caesar-buffer-body)
("rmail" rmail-insert-rmail-file-header rmail-count-new-messages
rmail-show-message)
("gnus-soup" :interactive t
gnus-group-brew-soup gnus-brew-soup gnus-soup-add-article
gnus-soup-send-replies gnus-soup-save-areas gnus-soup-pack-packet)
("nnsoup" nnsoup-pack-replies)
+ ("gnus-scomo" :interactive t gnus-score-mode)
("gnus-mh" gnus-mh-mail-setup gnus-summary-save-article-folder
gnus-Folder-save-name gnus-folder-save-name)
("gnus-mh" :interactive t gnus-summary-save-in-folder)
gnus-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-demon-init gnus-demon-cancel)
("gnus-salt" gnus-highlight-selected-tree gnus-possibly-generate-tree
gnus-tree-open gnus-tree-close)
- ("gnus-nocem" gnus-nocem-scan-groups gnus-nocem-close)
+ ("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-srvr" gnus-browse-foreign-server)
("gnus-cite" :interactive t
gnus-article-highlight-citation gnus-article-hide-citation-maybe
- gnus-article-hide-citation gnus-article-fill-cited-article)
+ gnus-article-hide-citation gnus-article-fill-cited-article
+ gnus-article-hide-citation-in-followups)
("gnus-kill" gnus-kill gnus-apply-kill-file-internal
gnus-kill-file-edit-file gnus-kill-file-raise-followups-to-author
gnus-execute gnus-expunge)
gnus-cache-possibly-remove-articles gnus-cache-request-article
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-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-score-raise-same-subject gnus-score-default
gnus-score-raise-thread gnus-score-lower-same-subject-and-select
gnus-score-lower-same-subject gnus-score-lower-thread
- gnus-possibly-score-headers)
+ gnus-possibly-score-headers gnus-summary-raise-score
+ gnus-summary-set-score gnus-summary-current-score)
("gnus-score"
(gnus-summary-score-map keymap) gnus-score-save gnus-score-headers
gnus-current-score-file-nondirectory gnus-score-adaptive
("gnus-edit" :interactive t gnus-score-customize)
("gnus-topic" :interactive t gnus-topic-mode)
("gnus-topic" gnus-topic-remove-group)
- ("gnus-salt" :interactive t gnus-pick-mode)
+ ("gnus-salt" :interactive t gnus-pick-mode gnus-binary-mode)
("gnus-uu" (gnus-uu-extract-map keymap) (gnus-uu-mark-map keymap))
("gnus-uu" :interactive t
gnus-uu-digest-mail-forward gnus-uu-digest-post-forward
- gnus-uu-mark-series gnus-uu-mark-region
+ gnus-uu-mark-series gnus-uu-mark-region gnus-uu-mark-buffer
gnus-uu-mark-by-regexp gnus-uu-mark-all
gnus-uu-mark-sparse gnus-uu-mark-thread gnus-uu-decode-uu
gnus-uu-decode-uu-and-save gnus-uu-decode-unshar
("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-summary-mail-forward gnus-summary-mail-other-window
gnus-bug)
- ("gnus-picon" gnus-article-display-picons)
+ ("gnus-picon" :interactive t gnus-article-display-picons
+ gnus-group-display-picons gnus-picons-article-display-x-face)
+ ("gnus-gl" bbb-login bbb-logout bbb-grouplens-group-p
+ gnus-grouplens-mode)
("gnus-vm" gnus-vm-mail-setup)
("gnus-vm" :interactive t gnus-summary-save-in-vm
gnus-summary-save-article-vm gnus-yank-article))))
;;; Various macros and substs.
+(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 ((GnusStartBufferWindow (selected-window)))
- (unwind-protect
- (progn
- (pop-to-buffer ,buffer)
- ,@forms)
- (select-window GnusStartBufferWindow))))
+ (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."
"Get the currently computed number of unread articles in GROUP."
`(car (gnus-gethash ,group gnus-newsrc-hashtb)))
+(defmacro gnus-group-entry (group)
+ "Get the newsrc entry for GROUP."
+ `(gnus-gethash ,group gnus-newsrc-hashtb))
+
(defmacro gnus-active (group)
"Get active info on GROUP."
`(gnus-gethash ,group gnus-active-hashtb))
(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)
- `(and ,buffer
- (funcall (if (stringp ,buffer) 'get-buffer 'buffer-name)
- ,buffer)))
+ `(let ((buffer ,buffer))
+ (and buffer
+ (funcall (if (stringp buffer) 'get-buffer 'buffer-name)
+ buffer))))
(defmacro gnus-kill-buffer (buffer)
`(let ((buf ,buffer))
(point)
(goto-char p))))
+(defun gnus-alive-p ()
+ "Say whether Gnus is running or not."
+ (and gnus-group-buffer
+ (get-buffer gnus-group-buffer)))
+
+(defun gnus-delete-first (elt list)
+ "Delete by side effect the first occurrence of ELT as a member of LIST."
+ (if (equal (car list) elt)
+ (cdr list)
+ (let ((total list))
+ (while (and (cdr list)
+ (not (equal (cadr list) elt)))
+ (setq list (cdr list)))
+ (when (cdr list)
+ (setcdr list (cddr list)))
+ total)))
+
;; Delete the current line (and the next N lines.);
(defmacro gnus-delete-line (&optional n)
`(delete-region (progn (beginning-of-line) (point))
(let ((flist (append fval nil)))
(setcar flist 'byte-code)
flist)
- (cons 'progn (cdr (cdr fval))))))
+ (cons 'progn (cddr fval)))))
;;; Load the compatability functions.
(require 'gnus-cus)
(require 'gnus-ems)
+\f
+;;;
+;;; Shutdown
+;;;
+
+(defvar gnus-shutdown-alist nil)
+
+(defun gnus-add-shutdown (function &rest symbols)
+ "Run FUNCTION whenever one of SYMBOLS is shut down."
+ (push (cons function symbols) gnus-shutdown-alist))
+
+(defun gnus-shutdown (symbol)
+ "Shut down everything that waits for SYMBOL."
+ (let ((alist gnus-shutdown-alist)
+ entry)
+ (while (setq entry (pop alist))
+ (when (memq symbol (cdr entry))
+ (funcall (car entry))))))
+
\f
;; Format specs. The chunks below are the machine-generated forms
(defun gnus-summary-line-format-spec ()
(insert gnus-tmp-unread gnus-tmp-replied
gnus-tmp-score-char gnus-tmp-indentation)
- (put-text-property
+ (gnus-put-text-property
(point)
(progn
(insert
(defun gnus-summary-dummy-line-format-spec ()
(insert "* ")
- (put-text-property
+ (gnus-put-text-property
(point)
(progn
(insert ": :")
(defun gnus-group-line-format-spec ()
(insert gnus-tmp-marked-mark gnus-tmp-subscribed
gnus-tmp-process-marked
- gnus-topic-indentation
+ gnus-group-indentation
(format "%5s: " gnus-tmp-number-of-unread))
- (put-text-property
+ (gnus-put-text-property
(point)
(progn
(insert gnus-tmp-group "\n")
"Return the value of the header FIELD of current article."
(save-excursion
(save-restriction
- (let ((case-fold-search t))
+ (let ((case-fold-search t)
+ (inhibit-point-motion-hooks t))
(nnheader-narrow-to-headers)
- (mail-fetch-field field)))))
+ (message-fetch-field field)))))
(defun gnus-goto-colon ()
(beginning-of-line)
(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
- (and (assq 'version gnus-format-specs)
- (not (equal emacs-version
- (cdr (assq 'version gnus-format-specs))))))
+ (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))
- old-format new-format entry type val)
- (while types
- (setq type (pop types))
- (setq new-format (symbol-value
- (intern (format "gnus-%s-line-format" type))))
+ 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))
- (car (cdr entry)))
+ (cadr entry))
+ ;; This is a new format.
(setq val
(if (not (stringp new-format))
;; This is a function call or something.
(if (eq type 'article-mode)
'summary-mode type))))
(not (string-match "mode$" (symbol-name type))))))
- (set (intern (format "gnus-%s-line-format-spec" type)) val)
+ ;; Enter the new format spec into the list.
(if entry
- (setcar (cdr entry) val)
- (push (list type new-format val) gnus-format-specs)))))
+ (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))))
- (gnus-update-group-mark-positions)
- (gnus-update-summary-mark-positions)
+ (unless (assq 'version gnus-format-specs)
+ (push (cons 'version emacs-version) gnus-format-specs))
- (if (and (string-match "%[-,0-9]*D" gnus-group-line-format)
- (not gnus-description-hashtb)
- gnus-read-active-file)
- (gnus-read-all-descriptions-files)))
+ (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)
- (gnus-set-work-buffer)
- (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))
- (setq pos (cons (cons 'replied (and (search-forward "\201" nil t)
- (- (point) 2))) pos))
- (goto-char (point-min))
- (setq pos (cons (cons 'score (and (search-forward "\202" nil t)
- (- (point) 2))) 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-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)
(defvar gnus-mouse-face-4 'highlight)
(defun gnus-mouse-face-function (form type)
- `(put-text-property
+ `(gnus-put-text-property
(point) (progn ,@form (point))
gnus-mouse-face-prop
,(if (equal type 0)
(defvar gnus-face-4 'bold)
(defun gnus-face-face-function (form type)
- `(put-text-property
+ `(gnus-put-text-property
(point) (progn ,@form (point))
'face ',(symbol-value (intern (format "gnus-face-%d" type)))))
(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
- (cdr (cdr sform)) spec-alist)
+ (funcall (intern (format "gnus-%s-face-function" (car sform)))
+ (gnus-complex-form-to-spec (cddr sform) spec-alist)
(nth 1 sform))))
form)))
(delete-region (match-beginning 3) (match-end 3)))
(if (not (zerop max-width))
(let ((el (car elem)))
- (cond ((= (car (cdr elem)) ?c)
+ (cond ((= (cadr elem) ?c)
(setq el (list 'char-to-string el)))
- ((= (car (cdr elem)) ?d)
+ ((= (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 (car (cdr elem))))))
+ (setq newspec (cadr elem)))))
;; Remove the old specification (and possibly a ",12" string).
(delete-region beg (match-end 2))
;; Insert the new specification.
If PROPS, insert the result."
(let ((form (gnus-parse-format format alist props)))
(if props
- (add-text-properties (point) (progn (eval form) (point)) props)
+ (gnus-add-text-properties (point) (progn (eval form) (point)) props)
(eval form))))
(defun gnus-remove-text-with-property (prop)
(gnus-capitalize-newsgroup newsgroup)
(gnus-newsgroup-directory-form newsgroup))
"/" (int-to-string (mail-header-number headers)))
- (or gnus-article-save-directory "~/News"))))
+ gnus-article-save-directory)))
(if (and last-file
(string-equal (file-name-directory default)
(file-name-directory last-file))
newsgroup
(gnus-newsgroup-directory-form newsgroup))
"/" (int-to-string (mail-header-number headers)))
- (or gnus-article-save-directory "~/News"))))
+ gnus-article-save-directory)))
(if (and last-file
(string-equal (file-name-directory default)
(file-name-directory last-file))
(if (gnus-use-long-file-name 'not-save)
(gnus-capitalize-newsgroup newsgroup)
(concat (gnus-newsgroup-directory-form newsgroup) "/news"))
- (or gnus-article-save-directory "~/News"))))
+ gnus-article-save-directory)))
(defun gnus-plain-save-name (newsgroup headers &optional last-file)
"Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
(if (gnus-use-long-file-name 'not-save)
newsgroup
(concat (gnus-newsgroup-directory-form newsgroup) "/news"))
- (or gnus-article-save-directory "~/News"))))
+ gnus-article-save-directory)))
;; For subscribing new newsgroup
(cdr groups)
(setq prefix
(concat "^" (substring (car groups) 0 (match-end 0))))
- (string-match prefix (car (cdr groups))))
+ (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))
+ (while (not (memq (setq ans (read-char)) '(?y ?\n ?n ?s ?q)))
+ (ding)
+ (message "Descend hierarchy %s? ([y]nsq): "
+ (substring prefix 1 (1- (length prefix)))))
(cond ((= ans ?n)
(while (and groups
(string-match prefix
(setq groups (cdr groups))))
(t nil)))
(message "Subscribe %s? ([n]yq)" (car groups))
- (setq ans (read-char))
+ (while (not (memq (setq ans (read-char)) '(?y ?\n ?q ?n)))
+ (ding)
+ (message "Subscribe %s? ([n]yq)" (car groups)))
(setq group (car groups))
(cond ((= ans ?y)
(gnus-subscribe-alphabetically (car groups))
(let ((groups (cdr gnus-newsrc-alist))
before)
(while (and (not before) groups)
- (if (string< newgroup (car (car groups)))
- (setq before (car (car groups)))
+ (if (string< newgroup (caar groups))
+ (setq before (caar groups))
(setq groups (cdr groups))))
(gnus-subscribe-newsgroup newgroup before)))
(defun gnus-newsgroup-directory-form (newsgroup)
"Make hierarchical directory name from NEWSGROUP name."
- (let ((newsgroup (gnus-newsgroup-saveable-name newsgroup))
+ (let ((newsgroup (gnus-newsgroup-savable-name newsgroup))
(len (length newsgroup))
idx)
;; If this is a foreign group, we don't want to translate the
(setq idx (1+ idx)))
newsgroup))
-(defun gnus-newsgroup-saveable-name (group)
+(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 ?/ ?.))
;; 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 "^[ \t]*\\(re\\|fwd\\)[[{(^0-9]*[])}]?[:;][ \t]*")
- (looking-at "^[[].*:[ \t].*[]]$"))
+ (looking-at "^ *\\(re\\|fwd\\)[[{(^0-9]*[])}]?[:;] *")
+ (looking-at "^[[].*: .*[]]$"))
(goto-char (point-min))
- (while (re-search-forward "^[ \t]*\\(re\\|fwd\\)[[{(^0-9]*[])}]?[:;][ \t]*"
+ (while (re-search-forward "^ *\\(re\\|fwd\\)[[{(^0-9]*[])}]?[:;] *"
nil t)
(replace-match "" t t))
(goto-char (point-min))
- (while (re-search-forward "^[[].*:[ \t].*[]]$" nil t)
+ (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 "[ \t\n]*([^()]*)[ \t]*$" nil t)
+ (while (re-search-forward " *[[{(][^()\n]*[]})] *$" nil t)
(replace-match "" t t))
(goto-char (point-min))
- (while (re-search-forward "[ \t]+" nil t)
+ (while (re-search-forward " +" nil t)
(replace-match " " t t))
(goto-char (point-min))
- (while (re-search-forward "[ \t]+$" nil t)
+ (while (re-search-forward " $" nil t)
(replace-match "" t t))
(goto-char (point-min))
- (while (re-search-forward "^[ \t]+" nil t)
+ (while (re-search-forward "^ +" nil t)
(replace-match "" t t))
(goto-char (point-min))
- (if 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)))))
+ (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."
- (let ((case-fold-search t))
- (save-excursion
- (gnus-set-work-buffer)
+ (save-excursion
+ (gnus-set-work-buffer)
+ (let ((case-fold-search t))
(insert subject)
(inline (gnus-simplify-buffer-fuzzy))
(buffer-string))))
(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 ()
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)
- ;; Reset any score variables.
- (and gnus-use-scoring (gnus-score-close))
+ (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)))
- ;; Save any cache buffers.
- (and gnus-use-cache (gnus-cache-save-buffers))
;; Clear the dribble buffer.
(gnus-dribble-clear)
- ;; Close down NoCeM.
- (and gnus-use-nocem (gnus-nocem-close))
- ;; Shut down the demons.
- (and gnus-use-demon (gnus-demon-cancel))
;; Kill global KILL file buffer.
- (if (get-file-buffer (gnus-newsgroup-kill-file nil))
- (kill-buffer (get-file-buffer (gnus-newsgroup-kill-file nil))))
+ (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)
- ;; Backlog.
- (and gnus-keep-backlog (gnus-backlog-shutdown))
;; Kill Gnus buffers.
(while gnus-buffer-list
- (gnus-kill-buffer (car gnus-buffer-list))
- (setq gnus-buffer-list (cdr 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.
- (if (symbolp setting)
- (setq setting
- (cond ((memq setting '(SelectArticle))
- 'article)
- ((memq setting '(SelectSubject ExpandSubject))
- 'summary)
- ((memq setting '(SelectNewsgroup ExitNewsgroup))
- 'group)
- (t setting))))
+ (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)))))
(if (assq 'newsgroup gnus-window-configuration)
'newsgroup
'newsgroups) setting))
- (elem (car (cdr (assq setting gnus-window-configuration))))
+ (elem (cadr (assq setting gnus-window-configuration)))
(total (apply '+ elem))
(types '(group summary article))
(pbuf (if (eq setting 'newsgroups) 'group 'summary))
(setq i (1+ i)))
(list (nreverse out)))))
+;;;###autoload
(defun gnus-add-configuration (conf)
"Add the window configuration CONF to `gnus-buffer-configuration'."
(setq gnus-buffer-configuration
(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)))))
+ (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)
(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)
- (car (cdr (assq setting gnus-buffer-configuration)))
+ (cadr (assq setting gnus-buffer-configuration))
setting))
- (in-buf (current-buffer))
- rule val w height hor ohor heights sub jump-buffer
- rel total to-buf all-visible)
+ all-visible)
+
+ (setq gnus-frame-split-p nil)
(unless split
(error "No such setting: %s" setting))
- (if (and (not force) (setq all-visible (gnus-all-windows-visible-p split)))
+ (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.
- (if gnus-use-full-window
- (delete-other-windows)
- (gnus-remove-some-windows)
- (switch-to-buffer nntp-server-buffer))
+ (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)
- (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 (elt split 0)))
- (cond
- ((null split)
- t)
- ((not (or (eq type 'horizontal) (eq type 'vertical)))
- (let ((buffer (cond ((stringp type) type)
- (t (cdr (assq type gnus-window-to-buffer)))))
- win buf)
+ "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)
+ (when (setq buf (get-buffer (if (symbolp buffer)
+ (symbol-value buffer)
buffer)))
- (setq win (get-buffer-window buf)))
- (when win
- (if (memq 'point split)
- win
- t))))
- (t
- (let ((n (mapcar 'gnus-all-windows-visible-p
- (cdr (cdr split))))
- (win t))
- (while n
- (cond ((windowp (car n))
- (setq win (car n)))
- ((null (car n))
- (setq win nil)))
- (setq n (cdr n)))
- win)))))
+ (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)))
(save-excursion
;; Remove windows on all known Gnus buffers.
(while buffers
- (setq buf (cdr (car buffers)))
+ (setq buf (cdar buffers))
(if (symbolp buf)
(setq buf (and (boundp buf) (symbol-value buf))))
(and buf
(setq lowest-buf buf)))))
(setq buffers (cdr buffers)))
;; Remove windows on *all* summary buffers.
- (let (wins)
- (walk-windows
- (lambda (win)
- (let ((buf (window-buffer win)))
- (if (string-match "^\\*Summary" (buffer-name buf))
- (progn
- (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))))))))))
+ (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)
(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)
;; currently in use will have their message numbers taken into
;; consideration.
(while methods
- (setq meth (intern (concat (car (car methods)) "-version")))
+ (setq meth (intern (concat (caar methods) "-version")))
(and (boundp meth)
(stringp (symbol-value meth))
(setq mess (concat mess "; " (symbol-value meth))))
(setq methods (cdr methods)))
- (gnus-message 2 mess)))
+ (if arg
+ (insert (message mess))
+ (message mess))))
(defun gnus-info-find-node ()
"Find Info documentation of Gnus."
(interactive)
;; Enlarge info window if needed.
- (let ((mode major-mode))
- (gnus-configure-windows 'info)
- (Info-goto-node (car (cdr (assq mode gnus-info-nodes))))))
+ (let ((mode major-mode)
+ gnus-info-buffer)
+ (Info-goto-node (cadr (assq 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.
(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))
(memq 'virtual (assoc (symbol-name (car (gnus-find-method-for-group group)))
gnus-valid-select-methods)))
+(defun gnus-news-group-p (group &optional article)
+ "Return non-nil if GROUP (and ARTICLE) come from a news server."
+ (or (gnus-member-of-valid 'post group) ; Ordinary news group.
+ (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
;; Returns a list of writable groups.
(defun gnus-writable-groups ()
(let ((alist gnus-newsrc-alist)
- groups)
- (while alist
- (or (gnus-group-read-only-p (car (car alist)))
- (setq groups (cons (car (car alist)) groups)))
- (setq alist (cdr alist)))
+ groups group)
+ (while (setq group (car (pop alist)))
+ (unless (gnus-group-read-only-p group)
+ (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)
;; it yet. -erik selberg@cs.washington.edu
(defun gnus-dd-mmm (messy-date)
"Return a string like DD-MMM from a big messy string"
- (let ((datevec (timezone-parse-date messy-date)))
- (format "%2s-%s"
- (or (aref datevec 2) "??")
- (capitalize
- (or (car
- (nth (1- (string-to-number (aref datevec 1)))
- timezone-months-assoc))
- "???")))))
+ (let ((datevec (condition-case () (timezone-parse-date messy-date)
+ (error nil))))
+ (if (not datevec)
+ "??-???"
+ (format "%2s-%s"
+ (condition-case ()
+ ;; Make sure leading zeroes are stripped.
+ (number-to-string (string-to-number (aref datevec 2)))
+ (error "??"))
+ (capitalize
+ (or (car
+ (nth (1- (string-to-number (aref datevec 1)))
+ timezone-months-assoc))
+ "???"))))))
+
+(defun gnus-mode-string-quote (string)
+ "Quote all \"%\" in STRING."
+ (save-excursion
+ (gnus-set-work-buffer)
+ (insert string)
+ (goto-char (point-min))
+ (while (search-forward "%" nil t)
+ (insert "%"))
+ (buffer-string)))
;; Make a hash table (default and minimum size is 255).
;; Optional argument HASHSIZE specifies the table size.
(defun gnus-message (level &rest args)
(if (<= level gnus-verbose)
(apply 'message args)
- ;; We have to do this format thingie here even if the result isn't
+ ;; 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-functionp (form)
- "Return non-nil if FORM is funcallable."
- (or (and (symbolp form) (fboundp form))
- (and (listp form) (eq (car form) 'lambda))))
+(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)
(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.
(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 "\\(<[^<>]+>\\)[ \t\n]*\\'" references))
+ (string-match "\\(<[^\n<>]+>\\)[ \t\n]*\\'" references))
(substring references (match-beginning 1) (match-end 1))))
(defun gnus-split-references (references)
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."
- (assoc 'quit-config (gnus-find-method-for-group group)))
+ (gnus-group-get-parameter group 'quit-config))
(defun gnus-group-quit-config (group)
"Return the quit-config of GROUP."
- (nth 1 (assoc 'quit-config (gnus-find-method-for-group group))))
+ (gnus-group-get-parameter group 'quit-config))
(defun gnus-simplify-mode-line ()
"Make mode lines a bit simpler."
(if (atom (car ranges))
(if (numberp (car ranges))
(setq result (cons (car ranges) result)))
- (setq first (car (car ranges)))
- (setq last (cdr (car ranges)))
+ (setq first (caar ranges))
+ (setq last (cdar ranges))
(while (<= first last)
(setq result (cons first result))
(setq first (1+ first))))
(while (and ranges list)
(setq ilist list)
(setq lowest (or (and (atom (car ranges)) (car ranges))
- (car (car ranges))))
- (while (and list (cdr list) (< (car (cdr list)) lowest))
+ (caar ranges)))
+ (while (and list (cdr list) (< (cadr list) lowest))
(setq list (cdr list)))
(if (< (car ilist) lowest)
(progn
(setcdr temp nil)
(setq out (nconc (gnus-compress-sequence ilist t) out))))
(setq highest (or (and (atom (car ranges)) (car ranges))
- (cdr (car ranges))))
+ (cdar ranges)))
(while (and list (<= (car list) highest))
(setq list (cdr list)))
(setq ranges (cdr ranges)))
(while ranges
(if (atom (car ranges))
(if (cdr ranges)
- (if (atom (car (cdr ranges)))
- (if (= (1+ (car ranges)) (car (cdr ranges)))
+ (if (atom (cadr ranges))
+ (if (= (1+ (car ranges)) (cadr ranges))
(progn
(setcar ranges (cons (car ranges)
- (car (cdr ranges))))
- (setcdr ranges (cdr (cdr ranges)))))
- (if (= (1+ (car ranges)) (car (car (cdr ranges))))
+ (cadr ranges)))
+ (setcdr ranges (cddr ranges))))
+ (if (= (1+ (car ranges)) (caadr ranges))
(progn
- (setcar (car (cdr ranges)) (car ranges))
- (setcar ranges (car (cdr ranges)))
- (setcdr ranges (cdr (cdr ranges)))))))
+ (setcar (cadr ranges) (car ranges))
+ (setcar ranges (cadr ranges))
+ (setcdr ranges (cddr ranges))))))
(if (cdr ranges)
- (if (atom (car (cdr ranges)))
- (if (= (1+ (cdr (car ranges))) (car (cdr ranges)))
+ (if (atom (cadr ranges))
+ (if (= (1+ (cdar ranges)) (cadr ranges))
(progn
- (setcdr (car ranges) (car (cdr ranges)))
- (setcdr ranges (cdr (cdr ranges)))))
- (if (= (1+ (cdr (car ranges))) (car (car (cdr ranges))))
+ (setcdr (car ranges) (cadr ranges))
+ (setcdr ranges (cddr ranges))))
+ (if (= (1+ (cdar ranges)) (caadr ranges))
(progn
- (setcdr (car ranges) (cdr (car (cdr ranges))))
- (setcdr ranges (cdr (cdr ranges))))))))
+ (setcdr (car ranges) (cdadr ranges))
+ (setcdr ranges (cddr ranges)))))))
(setq ranges (cdr ranges)))
out)))
(while (and ranges
(if (numberp (car ranges))
(>= number (car ranges))
- (>= number (car (car ranges))))
+ (>= number (caar ranges)))
not-stop)
(if (if (numberp (car ranges))
(= number (car ranges))
- (and (>= number (car (car ranges)))
- (<= number (cdr (car ranges)))))
+ (and (>= number (caar ranges))
+ (<= number (cdar ranges))))
(setq not-stop nil))
(setq ranges (cdr ranges)))
(not not-stop))))
(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
- "\M- " gnus-group-unhidden-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
- "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
- "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)
-
- (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))
+ (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.
(buffer-disable-undo (current-buffer))
(setq truncate-lines t)
(setq buffer-read-only t)
+ (gnus-make-local-hook 'post-command-hook)
+ (gnus-add-hook 'post-command-hook 'gnus-clear-inboxes-moved nil t)
(run-hooks 'gnus-group-mode-hook))
+(defun gnus-clear-inboxes-moved ()
+ (setq nnmail-moved-inboxes nil))
+
(defun gnus-mouse-pick-group (e)
"Enter the group under the mouse pointer."
(interactive "e")
(defun gnus-group-default-level (&optional level number-or-nil)
(cond
(gnus-group-use-permanent-levels
- (setq gnus-group-default-list-level
- (or level gnus-group-default-list-level))
- (or gnus-group-default-list-level gnus-level-subscribed))
+ (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
prompt the user for the name of an NNTP server to use.
As opposed to `gnus', this command will not connect to the local server."
(interactive "P")
- (make-local-variable 'gnus-group-use-permanent-levels)
- (setq gnus-group-use-permanent-levels t)
- (gnus (or arg (1- gnus-level-default-subscribed)) t slave))
+ (let ((val (or arg (1- gnus-level-default-subscribed))))
+ (gnus val t slave)
+ (make-local-variable 'gnus-group-use-permanent-levels)
+ (setq gnus-group-use-permanent-levels val)))
;;;###autoload
(defun gnus-slave (&optional arg)
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-make-newsrc-file gnus-startup-file))
;; Read the dribble file.
- (and (or gnus-slave gnus-use-dribble-file) (gnus-dribble-read-file))
+ (when (or gnus-slave gnus-use-dribble-file)
+ (gnus-dribble-read-file))
+
+ ;; Allow using GroupLens predictions.
+ (when gnus-use-grouplens
+ (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)
+ (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))))))
(let ((history load-history)
feature)
(while history
- (and (string-match "^gnus" (car (car history)))
+ (and (string-match "^\\(gnus\\|nn\\)" (caar history))
(setq feature (cdr (assq 'provide (car history))))
(unload-feature feature 'force))
(setq history (cdr history)))))
;; Fontify some.
(goto-char (point-min))
(and (search-forward "Praxis" nil t)
- (put-text-property (match-beginning 0) (match-end 0) 'face 'bold))
+ (gnus-put-text-property (match-beginning 0) (match-end 0) 'face 'bold))
(goto-char (point-min))
(let* ((mode-string (gnus-group-set-mode-line)))
(setq mode-line-buffer-identification
(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-min))
- (if (not group)
- ;; Go to the first group with unread articles.
- (gnus-group-search-forward nil nil nil t)
- ;; Find the right group to put point on. If the current group
- ;; has disapeared 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 (nthcdr 3 (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
- (car (car newsrc)) gnus-active-hashtb)))))
- (setq newsrc (cdr newsrc)))
- (or newsrc (progn (goto-char (point-max))
- (forward-line -1))))))
+ (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))))
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)
- (setq gnus-topic-indentation "")
(let ((buffer-read-only nil)
(newsrc (cdr gnus-newsrc-alist))
(lowest (or lowest 1))
(<= (setq clevel (gnus-info-level info)) level)
(>= clevel lowest)
(or all ; We list all groups?
- (and gnus-group-list-inactive-groups
- (eq unread t)) ; We list unactivated groups
- (> unread 0) ; We list groups with unread articles
- (cdr (assq 'tick (gnus-info-marks info)))
+ (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
(run-hooks 'gnus-group-prepare-hook)))
(defun gnus-group-prepare-flat-list-dead (groups level mark regexp)
- ;; List zombies and killed lists somehwat faster, which was
+ ;; 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 beg)
+ (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)
- (add-text-properties
+ (gnus-add-text-properties
(point) (prog1 (1+ (point))
(insert " " mark " *: " group "\n"))
(list 'gnus-group (gnus-intern-safe group gnus-active-hashtb)
'gnus-level level))))
;; This loop is used when listing all groups.
(while groups
- (add-text-properties
+ (gnus-add-text-properties
(point) (prog1 (1+ (point))
(insert " " mark " *: "
(setq group (pop groups)) "\n"))
;; select method, and return a select method.
(cond ((stringp method)
(gnus-server-to-method method))
+ ((equal method gnus-select-method)
+ gnus-select-method)
((and (stringp (car method)) group)
(gnus-server-extend-method group method))
+ ((and method (not group)
+ (equal (cadr method) ""))
+ method)
(t
(gnus-server-add-address method))))
(defun gnus-server-to-method (server)
"Map virtual server names to select methods."
- (or (and (equal server "native") gnus-select-method)
- (cdr (assoc server gnus-server-alist))))
-
-(defmacro gnus-server-equal (ss1 ss2)
+ (or
+ ;; Is this a method, perhaps?
+ (and server (listp server) server)
+ ;; Perhaps this is the native server?
+ (and (equal server "native") gnus-select-method)
+ ;; It should be in the server alist.
+ (cdr (assoc server gnus-server-alist))
+ ;; If not, we look through all the opened server
+ ;; to see whether we can find it there.
+ (let ((opened gnus-opened-servers))
+ (while (and opened
+ (not (equal server (format "%s:%s" (caaar opened)
+ (cadaar opened)))))
+ (pop opened))
+ (caar opened))))
+
+(defmacro gnus-method-equal (ss1 ss2)
"Say whether two servers are equal."
`(let ((s1 ,ss1)
(s2 ,ss2))
(setq s1 (cdr s1)))
(null s1))))))
+(defun gnus-server-equal (m1 m2)
+ "Say whether two methods are equal."
+ (let ((m1 (cond ((null m1) gnus-select-method)
+ ((stringp m1) (gnus-server-to-method m1))
+ (t m1)))
+ (m2 (cond ((null m2) gnus-select-method)
+ ((stringp m2) (gnus-server-to-method m2))
+ (t m2))))
+ (gnus-method-equal m1 m2)))
+
+(defun gnus-servers-using-backend (backend)
+ "Return a list of known servers using BACKEND."
+ (let ((opened gnus-opened-servers)
+ out)
+ (while opened
+ (when (eq backend (caaar opened))
+ (push (caar opened) out))
+ (pop opened))
+ out))
+
(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
- (assoc (format "%s" (car method)) (gnus-methods-using 'address))
+ (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))
(substring group 0 (match-end 0))
""))
-(defun gnus-group-method-name (group)
- "Return the method used for selecting GROUP."
+(defun gnus-group-method (group)
+ "Return the server or method used for selecting GROUP."
(let ((prefix (gnus-group-real-prefix group)))
(if (equal prefix "")
gnus-select-method
- (if (string-match "^[^\\+]+\\+" prefix)
- (list (intern (substring prefix 0 (1- (match-end 0))))
- (substring prefix (match-end 0) (1- (length prefix))))
- (list (intern (substring prefix 0 (1- (length prefix)))) "")))))
+ (let ((servers gnus-opened-servers)
+ (server "")
+ backend possible found)
+ (if (string-match "^[^\\+]+\\+" prefix)
+ (setq backend (intern (substring prefix 0 (1- (match-end 0))))
+ server (substring prefix (match-end 0) (1- (length prefix))))
+ (setq backend (intern (substring prefix 0 (1- (length prefix))))))
+ (while servers
+ (when (eq (caaar servers) backend)
+ (setq possible (caar servers))
+ (when (equal (cadaar servers) server)
+ (setq found (caar servers))))
+ (pop servers))
+ (or (car (rassoc found gnus-server-alist))
+ found
+ (car (rassoc possible gnus-server-alist))
+ possible
+ (list backend server))))))
(defsubst gnus-secondary-method-p (method)
"Return whether METHOD is a secondary select method."
(gnus-group-set-info (cons param (gnus-info-params info))
group 'params))))
+(defun gnus-group-set-parameter (group name value)
+ "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.
+ (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)))))
+ (setq old-params (cdr old-params)))
+ (gnus-group-set-info new-params group 'params)))))
+
(defun gnus-group-add-score (group &optional score)
"Add SCORE to the GROUP score.
If SCORE is nil, add 1 to the score of GROUP."
(let ((info (gnus-get-info group)))
- (gnus-info-set-score info (+ (gnus-info-score info) (or score 1)))))
+ (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.
(or method-only-group (gnus-info-group info))
gnus-newsrc-hashtb))
(part-info info)
- (info (if method-only-group (nth 2 entry) 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 recevied parts of the actual group info - either the
+ ;; 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))
;; This is a new group, so we just create it.
(save-excursion
(set-buffer gnus-group-buffer)
- (if (gnus-info-method info)
- ;; It's a foreign group...
- (gnus-group-make-group
- (gnus-group-real-name (gnus-info-group info))
- (prin1-to-string (car (gnus-info-method info)))
- (nth 1 (gnus-info-method info)))
- ;; It's a native group.
- (gnus-group-make-group (gnus-info-group info)))
+ (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
(setcar (nthcdr 2 entry) info)
(when (and (not (eq (car entry) t))
(gnus-active (gnus-info-group info)))
- (let ((marked (gnus-info-marks info)))
- (setcar entry (length (gnus-list-of-unread-articles
- (car 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)
"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))))
+ (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)
(- (1+ (cdr active)) (car active)) 0)
nil))))
-;; Dummy function redefined when running under XEmacs.
-(defalias 'gnus-group-remove-excess-properties 'ignore)
-
-(defun gnus-group-insert-group-line
- (gnus-tmp-group gnus-tmp-level gnus-tmp-marked number
- gnus-tmp-method)
+(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 (eq gnus-tmp-moderated ?m) "(m)" ""))
(gnus-tmp-method
(gnus-server-get-method gnus-tmp-group gnus-tmp-method))
- (gnus-tmp-news-server (or (car (cdr 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)
- (car (cdr 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-number
- (cond ((eq number t) "*" )
- ((numberp number) (int-to-string number))
- (t number)))
(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) ; passed as parameter to user-funcs.
+ header gnus-tmp-header) ; passed as parameter to user-funcs.
(beginning-of-line)
- (add-text-properties
+ (gnus-add-text-properties
(point)
(prog1 (1+ (point))
;; Insert the text.
(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)))
(widen)
(let ((ident (gnus-intern-safe group gnus-active-hashtb))
(loc (point-min))
- found buffer-read-only visible)
+ 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)))
loc (point-max) 'gnus-group ident))
(setq found t)
(goto-char loc)
- (gnus-delete-line)
- (gnus-group-insert-group-line-info group)
+ (let ((gnus-group-indentation (gnus-group-group-indentation)))
+ (gnus-delete-line)
+ (gnus-group-insert-group-line-info group)
+ (save-excursion
+ (forward-line -1)
+ (run-hooks 'gnus-group-update-group-hook)))
(setq loc (1+ loc)))
- (if (or found visible-only)
- ()
+ (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).
- ;; Fix by Per Abrahamsen <amanda@iesd.auc.dk>.
- (let ((entry (cdr (cdr (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
- (car (car entry))
- gnus-active-hashtb)))))
- (setq entry (cdr entry)))
- (or entry (goto-char (point-max))))
+ (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.
- (gnus-group-insert-group-line-info group))
+ (let ((gnus-group-indentation (gnus-group-group-indentation)))
+ (gnus-group-insert-group-line-info group)
+ (save-excursion
+ (forward-line -1)
+ (run-hooks 'gnus-group-update-group-hook))))
(gnus-group-set-mode-line)))))
(defun gnus-group-set-mode-line ()
+ "Update the mode line in the group buffer."
(when (memq 'group gnus-updated-mode-lines)
- (let* ((gformat (or gnus-group-mode-line-format-spec
- (setq gnus-group-mode-line-format-spec
- (gnus-parse-format
- gnus-group-mode-line-format
- gnus-group-mode-line-format-alist))))
- (gnus-tmp-news-server (car (cdr gnus-select-method)))
- (gnus-tmp-news-method (car gnus-select-method))
- (max-len 60)
- header ;Dummy binding for user-defined formats
- ;; Get the resulting string.
- (mode-string (eval gformat)))
- ;; If the line is too long, we chop it off.
- (when (> (length mode-string) max-len)
- (setq mode-string (substring mode-string 0 (- max-len 4))))
- (prog1
- (setq mode-line-buffer-identification (list mode-string))
- (set-buffer-modified-p t)))))
+ ;; Yes, we want to keep this mode line updated.
+ (save-excursion
+ (set-buffer gnus-group-buffer)
+ (let* ((gformat (or gnus-group-mode-line-format-spec
+ (setq gnus-group-mode-line-format-spec
+ (gnus-parse-format
+ gnus-group-mode-line-format
+ gnus-group-mode-line-format-alist))))
+ (gnus-tmp-news-server (cadr gnus-select-method))
+ (gnus-tmp-news-method (car gnus-select-method))
+ (gnus-tmp-colon (if (equal gnus-tmp-news-server "") "" ":"))
+ (max-len 60)
+ gnus-tmp-header ;Dummy binding for user-defined formats
+ ;; Get the resulting string.
+ (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."
"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))
(interactive "p")
(let ((buffer-read-only nil)
group)
- (while
- (and (> n 0)
- (setq group (gnus-group-group-name))
- (progn
- (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))))
- t)
- (or no-advance (zerop (gnus-group-next-group 1))))
- (setq n (1- n)))
+ (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-all-groups ()
"Unmark all groups."
+ (interactive)
(let ((groups gnus-group-marked))
(save-excursion
(while groups
(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): ")
(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))
+ (gnus-group-mark-group 1 'unmark t)
+ t)
(setq gnus-group-marked
- (delete group 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)
+ (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)))))
+ (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."
(substitute-command-keys
"\\<gnus-group-mode-map>\\[gnus-group-universal-argument]")))))
'undefined)
- (progn
- (message "Undefined key")
- (ding))
+ (gnus-error 1 "Undefined key")
(while groups
(gnus-group-remove-mark (setq group (pop groups)))
(command-execute func))))
(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)))
(interactive "sGroup name: ")
(or (get-buffer gnus-group-buffer)
(gnus))
- (gnus-group-select-group))
+ (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.
(gnus-group-prefixed-name group method))))
(gnus-sethash
group
- (list t nil (list group gnus-level-default-subscribed nil nil
- (append method
- (list
- (list 'quit-config
- (if quit-config quit-config
- (cons (current-buffer) 'summary)))))))
+ `(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)
(interactive
(list (completing-read
"Group: " gnus-active-hashtb nil
- (memq gnus-select-method gnus-have-read-active-file))))
+ (gnus-read-active-file-p)
+ nil
+ 'gnus-group-history)))
- (if (equal group "")
- (error "Empty group name"))
+ (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))))
- (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))
+ (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."
(goto-char (point-min))
(let ((best 100000)
unread best-point)
- (while (setq unread (get-text-property (point) 'gnus-unread))
+ (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) best)
+ (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
(let ((method
(completing-read
"Method: " (append gnus-valid-select-methods gnus-server-alist)
- nil t)))
- (if (assoc method gnus-valid-select-methods)
- (list method
- (if (memq 'prompt-address
- (assoc method gnus-valid-select-methods))
- (read-string "Address: ")
- ""))
- (list method nil)))))
-
- (save-excursion
- (set-buffer gnus-group-buffer)
- (let* ((meth (and method (if address (list (intern method) address)
- method)))
- (nname (if method (gnus-group-prefixed-name name meth) name))
- info)
- (and (gnus-gethash nname gnus-newsrc-hashtb)
- (error "Group %s already exists" nname))
- (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)
- (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)) ")")))
- (gnus-group-insert-group-line-info nname)
+ 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))
+ (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)
- (if (assoc method gnus-valid-select-methods)
- (require (intern method)))
- (and (gnus-check-backend-function 'request-create-group nname)
- (gnus-request-create-group nname))
- t)))
+ ;; 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.
() ; Whew!
(gnus-message 6 "Deleting group %s..." group)
(if (not (gnus-request-delete-group group force))
- (progn
- (gnus-message 3 "Couldn't delete group %s" group)
- (ding))
+ (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)))
(gnus-message 6 "Renaming group %s to %s..." group new-name)
(prog1
(if (not (gnus-request-rename-group group new-name))
- (progn
- (gnus-message 3 "Couldn't rename group %s to %s" group new-name)
- (ding))
+ (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 (cdr (car gnus-list-of-killed-groups))
- new-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))
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 ((done-func '(lambda ()
- "Exit editing mode and update the information."
- (interactive)
- (gnus-group-edit-group-done 'part 'group)))
- (part (or part 'info))
- (winconf (current-window-configuration))
- info)
+ (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"))
(local-set-key "\C-c\C-c" done-func)
(make-local-variable 'gnus-prev-winconf)
(setq gnus-prev-winconf winconf)
- ;; We modify the func to let it know what part it is editing.
- (setcar (cdr (nth 4 done-func)) (list 'quote part))
- (setcar (cdr (cdr (nth 4 done-func))) group)
(erase-buffer)
(insert
(cond
(goto-char (point-min))
(let* ((form (read (current-buffer)))
(winconf gnus-prev-winconf)
- (new-group (when (eq part 'info)
- (if (or (not (nth 4 form))
+ (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 (nth 4 form)))
- (gnus-group-real-name (car form))
+ gnus-select-method method))
+ (gnus-group-real-name (car info))
(gnus-group-prefixed-name
- (gnus-group-real-name (car form)) (nth 4 form))))))
+ (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 (eq part 'info)
+ (if (and info new-group)
(progn
- (when new-group (setcar form new-group))
- (gnus-group-set-info form))
- (gnus-group-set-info form group part))
+ (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)
- (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))
(gnus-group-update-group (or new-group group))
(gnus-group-position-point)))
"etc/gnus-tut.txt"))))
(setq path nil)))
(if (not file)
- (message "Couldn't find doc group")
+ (gnus-message 1 "Couldn't find doc group")
(gnus-group-make-group
(gnus-group-real-name name)
- (list 'nndoc name
+ (list 'nndoc "gnus-help"
(list 'nndoc-address file)
(list 'nndoc-article-type 'mbox)))))
(gnus-group-position-point))
(file-name-nondirectory file) '(nndoc "")))))
(gnus-group-make-group
(gnus-group-real-name name)
- (list 'nndoc name
+ (list 'nndoc (file-name-nondirectory file)
(list 'nndoc-address file)
- (list 'nndoc-article-type (or type 'guess))))
- (forward-line -1)
- (gnus-group-position-point)))
+ (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.
(list 'nndir (if all "hpc" "edu")
(list 'nndir-directory
(if all gnus-group-archive-directory
- gnus-group-recent-archive-directory)))))
- (forward-line -1)
- (gnus-group-position-point))
+ gnus-group-recent-archive-directory))))))
(defun gnus-group-make-directory-group (dir)
"Create an nndir group.
(setq ext (format "<%d>" (setq i (1+ i)))))
(gnus-group-make-group
(gnus-group-real-name group)
- (list 'nndir group (list 'nndir-directory dir))))
- (forward-line -1)
- (gnus-group-position-point))
+ (list 'nndir group (list 'nndir-directory dir)))))
(defun gnus-group-make-kiboze-group (group address scores)
"Create an nnkiboze group.
(setq scores (cons (cons header regexps) scores)))
scores)))
(gnus-group-make-group group "nnkiboze" address)
- (save-excursion
- (gnus-set-work-buffer)
+ (nnheader-temp-write (gnus-score-file-name (concat "nnkiboze:" group))
(let (emacs-lisp-mode-hook)
- (pp scores (current-buffer)))
- (write-region (point-min) (point-max)
- (gnus-score-file-name (concat "nnkiboze:" group))))
- (forward-line -1)
- (gnus-group-position-point))
+ (pp scores (current-buffer)))))
(defun gnus-group-add-to-virtual (n vgroup)
"Add the current group to a virtual group."
(interactive (list gnus-group-sort-function
current-prefix-arg))
(let ((func (cond
- ((not (listp func))
- func)
- ((= 1 (length func))
- (car func))
- (t
- `(lambda (t1 t2)
- ,(gnus-make-sort-function
- (reverse func)))))))
+ ((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 (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)))
+ (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.
(level2 (gnus-info-level info2)))
(or (< level1 level2)
(and (= level1 level2)
- (< (gnus-info-score info1) (gnus-info-score info2))))))
+ (> (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
The difference between N and actual number of newsgroups that were
caught up is returned."
(interactive "P")
+ (unless (gnus-group-group-name)
+ (error "No group on the current line"))
(if (not (or (not gnus-interactive-catchup) ;Without confirmation?
gnus-expert-user
(gnus-y-or-n-p
(nnvirtual-catchup-group
(gnus-group-real-name (car groups)) (nth 1 method) all)))
(gnus-group-remove-mark (car groups))
- (if (prog1
- (gnus-group-goto-group (car groups))
- (gnus-group-catchup (car groups) all))
- (gnus-group-update-group-line)
- (setq ret (1+ ret)))
+ (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)))
(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)
(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
- (let ((nnmail-expiry-wait-function nil)
- (nnmail-expiry-wait expiry-wait))
- (gnus-request-expire-articles
- (gnus-uncompress-sequence (cdr expirable)) group))
- (gnus-request-expire-articles
- (gnus-uncompress-sequence (cdr expirable))
- group)))))
+ (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)
current-prefix-arg
(string-to-int
(let ((s (read-string
- (format "Level (default %s): " (gnus-group-group-level)))))
+ (format "Level (default %s): "
+ (or (gnus-group-group-level)
+ gnus-level-default-subscribed)))))
(if (string-match "^\\s-*$" s)
- (int-to-string (gnus-group-group-level))
+ (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 groups
- (setq group (car groups)
- groups (cdr groups))
+ (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)
(interactive
(list (completing-read
"Group: " gnus-active-hashtb nil
- (memq gnus-select-method gnus-have-read-active-file))))
+ (gnus-read-active-file-p)
+ nil
+ 'gnus-group-history)))
(let ((newsrc (gnus-gethash group gnus-newsrc-hashtb)))
(cond
((string-match "^[ \t]$" group)
(unless silent
(gnus-group-update-group group)))
((and (stringp group)
- (or (not (memq gnus-select-method gnus-have-read-active-file))
+ (or (not (gnus-read-active-file-p))
(gnus-active group)))
;; Add new newsgroup.
(gnus-group-change-level
(gnus-group-remove-mark group)
(setq level (gnus-group-group-level))
(gnus-delete-line)
- (if (and (not discard)
- (setq entry (gnus-gethash group gnus-newsrc-hashtb)))
- (setq gnus-list-of-killed-groups
- (cons (cons (car entry) (nth 2 entry))
- gnus-list-of-killed-groups)))
+ (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
(let (entry)
(setq groups (nreverse groups))
(while groups
- (gnus-group-remove-mark (car groups))
+ (gnus-group-remove-mark (setq group (pop groups)))
(gnus-delete-line)
- (setq entry (gnus-gethash (pop groups) gnus-newsrc-hashtb))
- (push (cons (car entry) (nth 2 entry))
- gnus-list-of-killed-groups)
- (setcdr (cdr entry) (cdr (cdr (cdr entry)))))
+ (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)
;; first newsgroup.
(setq prev (gnus-group-group-name))
(gnus-group-change-level
- info (nth 2 info) gnus-level-killed
+ 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))
(interactive "P")
;; Find all possible killed newsgroups if arg.
(when arg
- ;; First make sure active file has been read.
- (unless gnus-have-read-active-file
- (let ((gnus-read-active-file t))
- (gnus-read-active-file)))
- (or gnus-killed-hashtb (gnus-make-hashtable-from-killed))
- ;; Go through all newsgroups that are known to Gnus - enlarge kill list
- (mapatoms
- (lambda (sym)
- (let ((groups 0)
- (group (symbol-name sym)))
- (if (or (null group)
- (gnus-gethash group gnus-killed-hashtb)
- (gnus-gethash group gnus-newsrc-hashtb))
- ()
- (let ((do-sub (gnus-matches-options-n group)))
- (if (or (eq do-sub 'subscribe) (eq do-sub 'ignore))
- ()
- (setq groups (1+ groups))
- (setq gnus-killed-list
- (cons group gnus-killed-list))
- (gnus-sethash group group gnus-killed-hashtb))))))
- gnus-active-hashtb))
+ (gnus-get-killed-groups))
(if (not gnus-killed-list)
(gnus-message 6 "No killed groups")
(let (gnus-group-list-mode)
"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-have-read-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 (list)
(mapatoms
(lambda (sym)
- (and (symbol-value sym)
+ (and (boundp sym)
+ (symbol-value sym)
(setq list (cons (symbol-name sym) list))))
gnus-active-hashtb)
list)
(buffer-read-only nil))
(erase-buffer)
(while groups
- (gnus-group-insert-group-line-info (car groups))
- (setq groups (cdr groups)))
+ (gnus-group-insert-group-line-info (pop groups)))
(goto-char (point-min))))
(defun gnus-activate-all-groups (level)
(interactive "P")
(run-hooks 'gnus-get-new-news-hook)
;; We might read in new NoCeM messages here.
- (and gnus-use-nocem (gnus-nocem-scan-groups))
+ (when (and gnus-use-nocem
+ (null arg))
+ (gnus-nocem-scan-groups))
;; If ARG is not a number, then we read the active file.
- (and arg
- (not (numberp arg))
- (progn
- (let ((gnus-read-active-file t))
- (gnus-read-active-file))
- (setq arg nil)))
+ (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))
(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)
(interactive "P")
(let* ((groups (gnus-group-process-prefix n))
(ret (if (numberp n) (- n (length groups)) 0))
+ (beg (unless n (point)))
group)
- (while groups
- (setq group (car groups)
- groups (cdr groups))
+ (while (setq group (pop groups))
(gnus-group-remove-mark group)
- (unless (gnus-get-new-news-in-group group)
- (ding)
- (gnus-message 3 "%s error: %s" group (gnus-status-message 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-get-new-news-in-group (group)
- (when (and group (gnus-activate-group group 'scan))
- (gnus-get-unread-articles-in-group
- (gnus-get-info group) (gnus-active group) t)
- (when (gnus-group-goto-group group)
- (gnus-group-update-group-line))
- t))
-
(defun gnus-group-fetch-faq (group &optional faq-dir)
"Fetch the FAQ for the current group."
(interactive
gnus-description-hashtb))
(setq desc (gnus-group-get-description group))
(gnus-read-descriptions-file method))
- (message
+ (gnus-message 1
(or desc (gnus-gethash group gnus-description-hashtb)
"No description available")))))
(setq b (point))
(insert (format " *: %-20s %s\n" (symbol-name group)
(symbol-value group)))
- (add-text-properties
+ (gnus-add-text-properties
b (1+ b) (list 'gnus-group group
'gnus-unread t 'gnus-marked nil
'gnus-level (1+ gnus-level-subscribed))))
(string-match regexp (symbol-name group))
(setq groups (cons (symbol-name group) groups))))
gnus-active-hashtb)
- ;; Go through all descriptions that are known to Gnus.
- (if 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))
+ ;; 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.
If the prefix LEVEL is non-nil, it should be a number that says which
level to cut off listing groups.
If ALL, also list groups with no unread articles.
-If LOWEST, don't list groups with level lower than LOWEST."
+If LOWEST, don't list groups with level lower than LOWEST.
+
+This command may read the active file."
(interactive "P\nsList newsgroups matching: ")
+ ;; First make sure active file has been read.
+ (when (and level
+ (> (prefix-numeric-value level) gnus-level-killed))
+ (gnus-get-killed-groups))
(gnus-group-prepare-flat (or level gnus-level-subscribed)
all (or lowest 1) regexp)
(goto-char (point-min))
(defun gnus-group-restart (&optional arg)
"Force Gnus to read the .newsrc file."
(interactive "P")
- (gnus-save-newsrc-file)
- (gnus-setup-news 'force)
- (gnus-group-list-groups arg))
+ (when (gnus-yes-or-no-p
+ (format "Are you sure you want to read %s? "
+ gnus-current-startup-file))
+ (gnus-save-newsrc-file)
+ (gnus-setup-news 'force)
+ (gnus-group-list-groups arg)))
(defun gnus-group-read-init-file ()
"Read the Gnus elisp init file."
"Quit reading news after updating .newsrc.eld and .newsrc.
The hook `gnus-exit-gnus-hook' is called before actually exiting."
(interactive)
- (if (or noninteractive ;For gnus-batch-kill
- (not (gnus-server-opened gnus-select-method)) ;NNTP connection closed
+ (when
+ (or noninteractive ;For gnus-batch-kill
(not gnus-interactive-exit) ;Without confirmation
gnus-expert-user
(gnus-y-or-n-p "Are you sure you want to quit reading news? "))
- (progn
- (run-hooks 'gnus-exit-gnus-hook)
- ;; Offer to save data from non-quitted summary buffers.
- (gnus-offer-save-summaries)
- ;; Save the newsrc file(s).
- (gnus-save-newsrc-file)
- ;; Kill-em-all.
- (gnus-close-backends)
- ;; Shut down the cache.
- (when gnus-use-cache
- (gnus-cache-close))
- ;; Reset everything.
- (gnus-clear-system))))
+ (run-hooks 'gnus-exit-gnus-hook)
+ ;; Offer to save data from non-quitted summary buffers.
+ (gnus-offer-save-summaries)
+ ;; Save the newsrc file(s).
+ (gnus-save-newsrc-file)
+ ;; Kill-em-all.
+ (gnus-close-backends)
+ ;; Reset everything.
+ (gnus-clear-system)
+ ;; Allow the user to do things after cleaning up.
+ (run-hooks 'gnus-after-exiting-gnus-hook)))
(defun gnus-close-backends ()
;; Send a close request to all backends that support such a request.
(let ((methods gnus-valid-select-methods)
func)
(while methods
- (if (fboundp (setq func (intern (concat (car (car methods))
+ (if (fboundp (setq func (intern (concat (caar methods)
"-request-close"))))
(funcall func))
(setq methods (cdr methods)))))
(gnus-remove-some-windows))
(gnus-dribble-save)
(gnus-close-backends)
- ;; Shut down the cache.
- (when gnus-use-cache
- (gnus-cache-close))
- (gnus-clear-system)))
+ (gnus-clear-system)
+ ;; Allow the user to do things after cleaning up.
+ (run-hooks 'gnus-after-exiting-gnus-hook)))
(defun gnus-offer-save-summaries ()
"Offer to save all active summary buffers."
(list (let ((how (completing-read
"Which backend: "
(append gnus-valid-select-methods gnus-server-alist)
- nil t (cons "nntp" 0))))
+ nil t (cons "nntp" 0) 'gnus-method-history)))
;; We either got a backend name or a virtual server name.
;; If the first, we also need an address.
(if (assoc how gnus-valid-select-methods)
;; Non-orthogonal keys
- (gnus-define-keys
- gnus-summary-mode-map
- " " gnus-summary-next-page
- "\177" gnus-summary-prev-page
- "\r" gnus-summary-scroll-up
- "n" gnus-summary-next-unread-article
- "p" gnus-summary-prev-unread-article
- "N" gnus-summary-next-article
- "P" gnus-summary-prev-article
- "\M-\C-n" gnus-summary-next-same-subject
- "\M-\C-p" gnus-summary-prev-same-subject
- "\M-n" gnus-summary-next-unread-subject
- "\M-p" gnus-summary-prev-unread-subject
- "." gnus-summary-first-unread-article
- "," gnus-summary-best-unread-article
- "\M-s" gnus-summary-search-article-forward
- "\M-r" gnus-summary-search-article-backward
- "<" gnus-summary-beginning-of-article
- ">" gnus-summary-end-of-article
- "j" gnus-summary-goto-article
- "^" gnus-summary-refer-parent-article
- "\M-^" gnus-summary-refer-article
- "u" gnus-summary-tick-article-forward
- "!" gnus-summary-tick-article-forward
- "U" gnus-summary-tick-article-backward
- "d" gnus-summary-mark-as-read-forward
- "D" gnus-summary-mark-as-read-backward
- "E" gnus-summary-mark-as-expirable
- "\M-u" gnus-summary-clear-mark-forward
- "\M-U" gnus-summary-clear-mark-backward
- "k" gnus-summary-kill-same-subject-and-select
- "\C-k" gnus-summary-kill-same-subject
- "\M-\C-k" gnus-summary-kill-thread
- "\M-\C-l" gnus-summary-lower-thread
- "e" gnus-summary-edit-article
- "#" gnus-summary-mark-as-processable
- "\M-#" gnus-summary-unmark-as-processable
- "\M-\C-t" gnus-summary-toggle-threads
- "\M-\C-s" gnus-summary-show-thread
- "\M-\C-h" gnus-summary-hide-thread
- "\M-\C-f" gnus-summary-next-thread
- "\M-\C-b" gnus-summary-prev-thread
- "\M-\C-u" gnus-summary-up-thread
- "\M-\C-d" gnus-summary-down-thread
- "&" gnus-summary-execute-command
- "c" gnus-summary-catchup-and-exit
- "\C-w" gnus-summary-mark-region-as-read
- "\C-t" gnus-summary-toggle-truncation
- "?" gnus-summary-mark-as-dormant
- "\C-c\M-\C-s" gnus-summary-limit-include-expunged
- "\C-c\C-s\C-n" gnus-summary-sort-by-number
- "\C-c\C-s\C-a" gnus-summary-sort-by-author
- "\C-c\C-s\C-s" gnus-summary-sort-by-subject
- "\C-c\C-s\C-d" gnus-summary-sort-by-date
- "\C-c\C-s\C-i" gnus-summary-sort-by-score
- "=" gnus-summary-expand-window
- "\C-x\C-s" gnus-summary-reselect-current-group
- "\M-g" gnus-summary-rescan-group
- &
projects / gnus / blobdiff