+++ /dev/null
-;;; auc-menu.el - Easy menu support for GNU Emacs 19 and XEmacs.
-;;
-;; $Id: auc-menu.el,v 5.7 1994/11/28 01:41:22 amanda Exp $
-;;
-;; LCD Archive Entry:
-;; auc-menu|Per Abrahamsen|abraham@iesd.auc.dk|
-;; Easy menu support for GNU Emacs 19 and XEmacs|
-;; $Date: 1994/11/28 01:41:22 $|$Revision: 5.7 $|~/misc/auc-menu.el.gz|
-
-;; Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc.
-;; Copyright (C) 1994 Per Abrahamsen <abraham@iesd.auc.dk>
-;;
-;; This program is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-;;
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-;;
-;; You should have received a copy of the GNU General Public License
-;; along with this program; if not, write to the Free Software
-;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
-
-;; Commentary:
-;;
-;; Easymenu allows you to define menus for both Emacs 19 and XEmacs.
-;; The advantages of using easymenu are:
-;;
-;; - Easier to use than either the Emacs 19 and XEmacs menu syntax.
-;;
-;; - Common interface for Emacs 18, Emacs 19, and XEmacs.
-;; (The code does nothing when run under Emacs 18).
-;;
-;; The public functions are:
-;;
-;; - Function: easy-menu-define SYMBOL MAPS DOC MENU
-;; SYMBOL is both the name of the variable that holds the menu and
-;; the name of a function that will present a the menu.
-;; MAPS is a list of keymaps where the menu should appear in the menubar.
-;; DOC is the documentation string for the variable.
-;; MENU is an XEmacs style menu description.
-;;
-;; See the documentation for easy-menu-define for details.
-;;
-;; - Function: easy-menu-change PATH NAME ITEMS
-;; Change an existing menu.
-;; The menu must already exist an be visible on the menu bar.
-;; PATH is a list of strings used for locating the menu on the menu bar.
-;; NAME is the name of the menu.
-;; ITEMS is a list of menu items, as defined in `easy-menu-define'.
-;;
-;; - Function: easy-menu-add MENU [ MAP ]
-;; Add MENU to the current menubar in MAP.
-;;
-;; - Function: easy-menu-remove MENU
-;; Remove MENU from the current menubar.
-;;
-;; GNU Emacs 19 never uses `easy-menu-add' or `easy-menu-remove',
-;; menus automatically appear and disappear when the keymaps
-;; specified by the MAPS argument to `easy-menu-define' are
-;; activated.
-;;
-;; XEmacs will bind the map to button3 in each MAPS, but you must
-;; explicitly call `easy-menu-add' and `easy-menu-remove' to add and
-;; remove menus from the menu bar.
-
-;; auc-menu.el define the easymenu API included in Emacs 19.29 and
-;; later. In fact, the Emacs 19 specific code should be identical.
-
-;;; Code:
-
-;;;###autoload
-(defmacro easy-menu-define (symbol maps doc menu)
- "Define a menu bar submenu in maps MAPS, according to MENU.
-The arguments SYMBOL and DOC are ignored; they are present for
-compatibility only. SYMBOL is not evaluated. In other Emacs versions
-these arguments may be used as a variable to hold the menu data, and a
-doc string for that variable.
-
-The first element of MENU must be a string. It is the menu bar item name.
-The rest of the elements are menu items.
-
-A menu item is usually a vector of three elements: [NAME CALLBACK ENABLE]
-
-NAME is a string--the menu item name.
-
-CALLBACK is a command to run when the item is chosen,
-or a list to evaluate when the item is chosen.
-
-ENABLE is an expression; the item is enabled for selection
-whenever this expression's value is non-nil.
-
-Alternatively, a menu item may have the form:
-
- [ NAME CALLBACK [ KEYWORD ARG ] ... ]
-
-Where KEYWORD is one of the symbol defined below.
-
- :keys KEYS
-
-KEYS is a string; a complex keyboard equivalent to this menu item.
-
- :active ENABLE
-
-ENABLE is an expression; the item is enabled for selection
-whenever this expression's value is non-nil.
-
- :suffix NAME
-
-NAME is a string; the name of an argument to CALLBACK.
-
- :style STYLE
-
-STYLE is a symbol describing the type of menu item. The following are
-defined:
-
-toggle: A checkbox.
- Currently just prepend the name with the string \"Toggle \".
-radio: A radio button.
-nil: An ordinary menu item.
-
- :selected SELECTED
-
-SELECTED is an expression; the checkbox or radio button is selected
-whenever this expression's value is non-nil.
-Currently just disable radio buttons, no effect on checkboxes.
-
-A menu item can be a string. Then that string appears in the menu as
-unselectable text. A string consisting solely of hyphens is displayed
-as a solid horizontal line.
-
-A menu item can be a list. It is treated as a submenu.
-The first element should be the submenu name. That's used as the
-menu item in the top-level menu. The cdr of the submenu list
-is a list of menu items, as above."
- (` (progn
- (defvar (, symbol) nil (, doc))
- (easy-menu-do-define (quote (, symbol)) (, maps) (, doc) (, menu)))))
-
-(cond
-
-;;; Emacs 18
-
-((< (string-to-int emacs-version) 19)
-
-(defun easy-menu-do-define (symbol maps doc menu)
- (fset symbol (symbol-function 'ignore)))
-
-(defun easy-menu-remove (menu))
-
-(defun easy-menu-add (menu &optional map))
-
-(defun easy-menu-change (path name items))
-
-) ;Emacs 18
-
-;;; XEmacs
-
-((string-match "XEmacs\\|Lucid" emacs-version)
-
-(defun easy-menu-do-define (symbol maps doc menu)
- (set symbol menu)
- (fset symbol (list 'lambda '(e)
- doc
- '(interactive "@e")
- '(run-hooks 'activate-menubar-hook)
- '(setq zmacs-region-stays 't)
- (list 'popup-menu symbol)))
- (mapcar (function (lambda (map) (define-key map 'button3 symbol)))
- (if (keymapp maps) (list maps) maps)))
-
-(fset 'easy-menu-change (symbol-function 'add-menu))
-
-(defun easy-menu-add (menu &optional map)
- "Add MENU to the current menu bar."
- (cond ((null current-menubar)
- ;; Don't add it to a non-existing menubar.
- nil)
- ((assoc (car menu) current-menubar)
- ;; Already present.
- nil)
- ((equal current-menubar '(nil))
- ;; Set at left if only contains right marker.
- (set-buffer-menubar (list menu nil)))
- (t
- ;; Add at right.
- (set-buffer-menubar (copy-sequence current-menubar))
- (add-menu nil (car menu) (cdr menu)))))
-
-(defun easy-menu-remove (menu)
- "Remove MENU from the current menu bar."
- (and current-menubar
- (assoc (car menu) current-menubar)
- (delete-menu-item (list (car menu)))))
-
-) ;XEmacs
-
-;;; GNU Emacs 19
-
-(t
-
-(defun easy-menu-do-define (symbol maps doc menu)
- ;; We can't do anything that might differ between Emacs dialects in
- ;; `easy-menu-define' in order to make byte compiled files
- ;; compatible. Therefore everything interesting is done in this
- ;; function.
- (set symbol (easy-menu-create-keymaps (car menu) (cdr menu)))
- (fset symbol (` (lambda (event) (, doc) (interactive "@e")
- (easy-popup-menu event (, symbol)))))
- (mapcar (function (lambda (map)
- (define-key map (vector 'menu-bar (intern (car menu)))
- (cons (car menu) (symbol-value symbol)))))
- (if (keymapp maps) (list maps) maps)))
-
-(defvar easy-menu-item-count 0)
-
-;; Return a menu keymap corresponding to a XEmacs style menu list
-;; MENU-ITEMS, and with name MENU-NAME.
-(defun easy-menu-create-keymaps (menu-name menu-items)
- (let ((menu (make-sparse-keymap menu-name)))
- ;; Process items in reverse order,
- ;; since the define-key loop reverses them again.
- (setq menu-items (reverse menu-items))
- (while menu-items
- (let* ((item (car menu-items))
- (callback (if (vectorp item) (aref item 1)))
- command enabler name)
- (cond ((stringp item)
- (setq command nil)
- (setq name (if (string-match "^-+$" item) "" item)))
- ((consp item)
- (setq command (easy-menu-create-keymaps (car item) (cdr item)))
- (setq name (car item)))
- ((vectorp item)
- (setq command (make-symbol (format "menu-function-%d"
- easy-menu-item-count)))
- (setq easy-menu-item-count (1+ easy-menu-item-count))
- (setq name (aref item 0))
- (let ((keyword (aref item 2)))
- (if (and (symbolp keyword)
- (= ?: (aref (symbol-name keyword) 0)))
- (let ((count 2)
- style selected active keys
- arg)
- (while (> (length item) count)
- (setq keyword (aref item count))
- (setq arg (aref item (1+ count)))
- (setq count (+ 2 count))
- (cond ((eq keyword ':keys)
- (setq keys arg))
- ((eq keyword ':active)
- (setq active arg))
- ((eq keyword ':suffix)
- (setq name (concat name " " arg)))
- ((eq keyword ':style)
- (setq style arg))
- ((eq keyword ':selected)
- (setq selected arg))))
- (if keys
- (setq name (concat name " (" keys ")")))
- (if (eq style 'toggle)
- ;; Simulate checkboxes.
- (setq name (concat "Toggle " name)))
- (if active
- (put command 'menu-enable active)
- (and (eq style 'radio)
- selected
- ;; Simulate radio buttons with menu-enable.
- (put command 'menu-enable
- (list 'not selected)))))))
- (if (keymapp callback)
- (setq name (concat name " ...")))
- (if (symbolp callback)
- (fset command callback)
- (fset command (list 'lambda () '(interactive) callback)))))
- (if (null command)
- ;; Handle inactive strings specially--allow any number
- ;; of identical ones.
- (setcdr menu (cons (list nil name) (cdr menu)))
- (if name
- (define-key menu (vector (intern name)) (cons name command)))))
- (setq menu-items (cdr menu-items)))
- menu))
-
-(defun easy-menu-change (path name items)
- "Change menu found at PATH as item NAME to contain ITEMS.
-PATH is a list of strings for locating the menu containing NAME in the
-menu bar. ITEMS is a list of menu items, as in `easy-menu-define'.
-These items entirely replace the previous items in that map.
-
-Call this from `activate-menubar-hook' to implement dynamic menus."
- (let ((map (key-binding (apply 'vector
- 'menu-bar
- (mapcar 'intern (append path (list name)))))))
- (if (keymapp map)
- (setcdr map (cdr (easy-menu-create-keymaps name items)))
- (error "Malformed menu in `easy-menu-change'"))))
-
-(defun easy-menu-remove (menu))
-
-(defun easy-menu-add (menu &optional map))
-
-) ;GNU Emacs 19
-
-) ;cond
-
-(provide 'easymenu)
-(provide 'auc-menu)
-
-;;; auc-menu.el ends here
-From lars Thu Feb 23 23:20:38 1995
-From: larsi@ifi.uio.no (ding)
-Date: Fri Feb 24 13:40:45 1995
-Subject: This is a test version of this group
-Message-ID: <lars-doc0@eyesore.no>
-
-This group will look something like this, but the stuff in here is of
-little worth right now.
-
-For real documentation, you'll have to read the source code. Or you
-can read the info file, which is pretty comprehensive, if somewhat out
-of date.
-
-Gnus is currently in beta.
-
-When you happen upon a bug, please drop me a note.
-
-
-From lars Thu Feb 23 23:20:38 1995
-From: larsi@ifi.uio.no (ding)
-Date: Fri Feb 24 13:40:45 1995
-Subject: So you want to use the new Gnus
-Message-ID: <lars-doc1@eyesore.no>
-
-Actually, since you are reading this, chances are you are already
-using the new Gnus. Congratulations.
-
-This entire newsgroup you are reading is, in fact, no real newsgroup
-at all, in the traditional sense. It is an example of one of the
-"foreign" select methods that Gnus may use.
-
-The text you are now reading is stored in the "etc" directory with the
-rest of the Emacs sources. You are using the "nndir" backend for
-accessing it. Scary, isn't it?
-
-This isn't the real documentation. `M-x info', `m gnus <RET>' to read
-that. This "newsgroup" is intended as a kinder, gentler way of getting
-people started.
-
-Gnus is a rewrite of GNUS 4.1, written by Masanobu Umeda. The rewrite
-was done by moi, yours truly, your humble servant, Lars Magne
-Ingebrigtsen. If you have a WWW browser, you can investigate to your
-heart's delight at "http://www.ifi.uio.no/~larsi/larsi.html".
-
-Much code (especially the score code) was written by Per Abrahamsen.
-
-;; Copyright (C) 1995 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
-;; Keywords: news
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; 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.
-
-From lars Thu Feb 23 23:20:38 1995
-From: larsi@ifi.uio.no (ding)
-Date: Fri Feb 24 13:40:45 1995
-Subject: Starting up
-Message-ID: <lars-doc2@eyesore.no>
-
-If you are having problems with Gnus not finding your server, you have
-to set `gnus-select-method'. A "method" is a way of specifying *how*
-the news is to be found, and from *where*.
-
-Say you want to read news from you local, friendly nntp server
-"news.my.local.server".
-
-(setq gnus-select-method '(nntp "news.my.local.server"))
-
-Quite easy, huh?
-
-From the news spool:
-
-(setq gnus-select-method '(nnspool ""))
-
-From your mh-e spool:
-
-(setq gnus-select-method '(nnmh ""))
-
-There's a whole bunch of other methods for reading mail and news, see
-the "Foreign groups" article for that.
-
-
-From lars Thu Feb 23 23:20:38 1995
-From: larsi@ifi.uio.no (ding)
-Date: Fri Feb 24 13:40:45 1995
-Subject: Where are all the groups, then?
-Message-ID: <lars-doc3@eyesore.no>
-
-If this is the first time you have used a newsreader, you won't have a
-.newsrc file. This means that Gnus will think that all the newsgroups
-on the server are "new", and kill them all.
-
-If you have a .newsrc file, the new groups will be processed with the
-function in the `gnus-subscribe-newsgroup-method' variable, which is
-`gnus-subscribe-zombies' by default.
-
-This means that all the groups have been made into "zombies" - not
-quite dead, but not exactly alive, either.
-
-Jump back to the *Group* buffer, and type `C-c C-z' to list all the
-zombie groups. Look though the list, and subscribe to the groups you
-want to read by pressing `u' on the one you think look interesting.
-
-If all the groups have been killed, type `C-c C-k' to list all the
-killed groups. Subscribe to them the same way.
-
-When you are satisfied, press `M-z' to kill all the zombie groups.
-
-Now you should have a nice list of all groups you are interested in.
-
-(If you later want to subscribe to more groups, press `C-c C-k' to
-list all the kill groups, and repeat. You can also type `U' and be
-prompted for groups to subscribe to.)
-
-
-From lars Thu Feb 23 23:20:38 1995
-From: larsi@ifi.uio.no (ding)
-Date: Fri Feb 24 13:40:45 1995
-Subject: I want to read my mail!
-Message-ID: <lars-doc4@eyesore.no>
-
-Yes, Virginia, you can read mail with Gnus.
-
-First you have to decide which mail backend you want to use. You have
-nnml, which is a one-file-one-mail backend, which is quite nice, but
-apt to make your systems administrator go crazy and come after you
-with a shotgun.
-
-nnmbox uses a Unix mail box to store mail. Nice, but slow.
-
-nnmh uses mh-e folders, which is also a one-file-one-mail thingie, but
-slower than nnml. (It doesn't support NOV files.)
-
-So if you want to go with nnmbox, you can simply say:
-
-(setq gnus-secondary-select-methods '((nnmbox "")))
-
-(The same for the other methods, kind of.)
-
-You should also set `nnmail-split-methods' to something sensible:
-
-(setq nnmail-split-methods
- '(("mail.junk" "From:.*Lars")
- ("mail.misc "")))
-
-This will put all mail from me in you junk mail group, and the rest in
-"mail.misc".
-
-These groups will be subscribe the same way as the normal groups, so
-you will probably find them among the zombie groups after you set
-these variables and re-start Gnus.
-
-
-From lars Thu Feb 23 23:20:38 1995
-From: larsi@ifi.uio.no (ding)
-Date: Fri Feb 24 13:40:45 1995
-Subject: Foreign newsgroups
-Message-ID: <lars-doc5@eyesore.no>
-
-These are groups that do not come from `gnus-select-method'.
-
-Say you want to read "alt.furniture.couches" from "news.funet.fi". You
-can then either type `B news.funet.fi <RET>' to browse that server and
-subscribe to that group, or you can type
-`M-a alt.furniture.couches<RET>nntp<RET>news.funet.fi<RET>', if you
-like to type a lot.
-
-If you want to read a directory as a newsgroup, you can create an
-nndir group, much the same way. There's a shorthand for that,
-though. If, for instance, you want to read the (ding) list archives,
-you could type `D /ftp <RET>'.
-
-There's lots more to know about foreign groups, but you have to read
-the info pages to find out more.
-
-
-From lars Thu Feb 23 23:20:38 1995
-From: larsi@ifi.uio.no (ding)
-Date: Fri Feb 24 13:40:45 1995
-Subject: Low level changes in GNUS, or, Wrong type argument: stringp, nil
-Message-ID: <lars-doc6@eyesore.no>
-
-Gnus really isn't GNUS, even though it looks like it. If you scrape
-the surface, you'll find that most things have changed.
-
-This means that old code that relies on GNUS internals will fail.
-
-In particular, `gnus-newsrc-hashtb', `gnus-newsrc-assoc',
-`gnus-killed-list', the `nntp-header-' macros and the display formats
-have all changed. If you have some code lying around that depend on
-these, or change these, you'll have to re-write your code.
-
-Old hilit19 code does not work at all. In fact, you should probably
-remove all hihit code from all the Gnus hooks
-(`gnus-group-prepare-hook', `gnus-summary-prepare-hook' and
-`gnus-summary-article-hook'). (Well, at the very least the first
-two.) Gnus provides various integrated functions for highlighting,
-which are both faster and more accurated.
-
-There is absolutely no chance, whatsoever, of getting Gnus to work
-with Emacs 18.
-
-
-From lars Thu Feb 23 23:20:38 1995
-From: larsi@ifi.uio.no (ding)
-Date: Fri Feb 24 13:40:45 1995
-Subject: Bugs & stuff
-Message-ID: <lars-doc7@eyesore.no>
-
-If you want to report a bug, please type `M-x gnus-bug'. This will
-give me a precice overview of your Gnus and Emacs version numbers,
-along with a look at all Gnus variables you have changed.
-
-Du not expect a reply back, but your bug should be fixed in the next
-version. If the bug persists, please re-submit your bug report.
-
-When a bug occurs, I need a recipe for how to trigger the bug. You
-have to tell me exactly what you do to uncover the bug, and you should
-(setq debug-on-error t) and send me the backtrace along with the bug
-report.
-
-If I am not able to reproduce the bug, I won't be able to fix it.
-
-I would, of course, prefer that you locate the bug, fix it, and mail
-me the patches, but one can't have everything.
-
-If you have any questions on usage, the "ding@ifi.uio.no" mailing list
-is where to post the questions.
-
-
-From lars Thu Feb 23 23:20:38 1995
-From: larsi@ifi.uio.no (ding)
-Date: Fri Feb 24 13:40:45 1995
-Subject: How do I re-scan my mail groups?
-Message-ID: <lars-doc8@eyesore.no>
-
-Reading the active file from the nntp server is a drag.
-
-Just press `M-g' on the mail groups, and they will be re-scanned.
-
-You can also re-scan all the mail groups by putting them on level 1
-(`1 S'), and saying `1 g' to re-scan all level 1 groups.
-
-
-From lars Thu Feb 23 23:20:38 1995
-From: larsi@ifi.uio.no (ding)
-Date: Fri Feb 24 13:40:45 1995
-Subject: How do I set up virtual newsgroups?
-Message-ID: <lars-doc9@eyesore.no>
-
-Virtual newsgroups are collections of other newsgroups. Why people
-want this is beyond me, but here goes:
-
-Create the group by saying
-
-`M-a my.virtual.newsgroup<RET>nnvirtual<RET>^rec\.aquaria\.*<RET>'
-
-This will create the group "nnvirtual:my.virtual.newsgroup", which
-will collect all articles from all the groups in the "rec.aquaria"
-hierarchy.
-
-If you want to edit the regular expression, just type `M-e' on the
-group line.
-
-Note that all the groups that are part of the virtual group have to be
-alive. This means that the cannot, absolutely not, be zombie or
-killed. They can be unsubscribed; that's no problem.
-
-You can combine groups from different servers in the same virtual
-newsgroup, something that may actually be useful. Say you have the
-group "comp.headers" on the server "news.server.no" and the same group
-on "news.server.edu". If people have posted articles with Distribution
-headers that stop propagation of their articles, combining these two
-newsgroups into one virtual newsgroup should give you a better view of
-what's going on.
-
-One caveat, though: The virtual group article numbers from the first
-source group (group A) will always be lower than the article numbers
-from the second (group B). This means that Gnus will believe that
-articles from group A are older than articles from group B. Threading
-will lessen these problems, but it might be a good idea to sort the
-threads over the date of the articles to get a correct feel for the
-flow of the groups:
-
-(setq gnus-thread-sort-functions '(gnus-thread-sort-by-date))
-
-If you only want this in virtual groups, you could say something along
-the lines of:
-
-(setq gnus-select-group-hook
- (lambda ()
- (if (eq 'nnvirtual (car (gnus-find-method-for-group
- gnus-newsgroup-name)))
- (progn
- (make-local-variable 'gnus-thread-sort-functions)
- (setq gnus-thread-sort-functions '(gnus-thread-sort-by-date))))))
-
-
-From lars Thu Feb 23 23:20:38 1995
-From: larsi@ifi.uio.no (ding)
-Date: Fri Feb 24 13:40:45 1995
-Subject: I want to kiboze everything in sight!
-Message-ID: <lars-doc10@eyesore.no>
-
-The nnkiboze backend collects articles that you are interested in from
-groups you are interested in. Below is a description for how you can
-gather all posts from me, and all posts about Gnus in the gnu.emacs
-hierarchy in one handy, easy to read group.
-
-Gnus will let you eat up all available machine resources, grinding
-everything to a halt. Including your nntp server. Who says Gnus isn't
-friendly?
-
-You want to do this, of course.
-
-Create an nnkiboze group the normal way:
-
-`M-a my.group<RET>nnkiboze<RET>^gnu.emacs.*<RET>'
-
-You now have a shiny new group that you can't enter. How...
-practical.
-
-But just wait, it gets worse.
-
-You now have to create a score file.
-
-`C-x C-f ~/News/nnkiboze:my.group.SCORE<RET>'
-
-Put something like the following in this file:
-
-(setq gnus-score-alist
- '(("from"
- ("Ingebrigtsen" nil 1000)
- ("lmi" nil 5000))
- ("subject"
- ("Gnus" nil 10000))
- (touched)))
-
-Save the file, and go to a shell window.
-
-Type:
-
-$ emacs -batch -l ~/.emacs -l nnkiboze -f nnkiboze-generate-groups
-
-Wait a few hours, and all articles from me, or articles about Gnus,
-will appear, as if by magic, in the nnkiboze group. You really want
-that, of course.
-
-Gnus actually grabs the headers of all the groups that supply the
-nnkiboze group with articles, so this isn't very kind. Pleasy only do
-it at night (`at' is a fine command), and please, *please*, limit the
-number of groups that supply articles to the group. If you specify ""
-as the address of this group, nnkiboze will ask for headers from *all*
-groups, and this is megs and megs and megs of data.
-
-Use it, don't abuse it. Be nice.
-
-
-
-
(defun gnus-cache-request-article (article group)
- (let ((file (gnus-cache-file-name group article)))
+ (let ((file (gnus-cache-file-name group article))
+ (buffer-read-only nil))
(if (not (file-exists-p file))
()
(erase-buffer)
valstr))))
-(eval
- '(progn
- (if (string-match "XEmacs\\|Lucid" emacs-version)
- ()
-
- (defvar gnus-mouse-face-prop 'mouse-face)
-
-
;; Added by Per Abrahamsen <amanda@iesd.auc.dk>.
- (defvar gnus-display-type
- (condition-case nil
- (let ((display-resource (x-get-resource ".displayType" "DisplayType")))
- (cond (display-resource (intern (downcase display-resource)))
- ((x-display-color-p) 'color)
- ((x-display-grayscale-p) 'grayscale)
- (t 'mono)))
- (error 'mono))
- "A symbol indicating the display Emacs is running under.
+(eval-and-compile
+ (if (string-match "XEmacs\\|Lucid" emacs-version)
+ ()
+
+ (defvar gnus-mouse-face-prop 'mouse-face
+ "Property used for highlighting mouse regions.")
+
+ ;; Added by Per Abrahamsen <amanda@iesd.auc.dk>.
+ (defvar gnus-display-type
+ (condition-case nil
+ (let ((display-resource (x-get-resource ".displayType" "DisplayType")))
+ (cond (display-resource (intern (downcase display-resource)))
+ ((x-display-color-p) 'color)
+ ((x-display-grayscale-p) 'grayscale)
+ (t 'mono)))
+ (error 'mono))
+ "A symbol indicating the display Emacs is running under.
The symbol should be one of `color', `grayscale' or `mono'. If Emacs
guesses this display attribute wrongly, either set this variable in
your `~/.emacs' or set the resource `Emacs.displayType' in your
variables get. You would normally not change this variable, but
pounce directly on the real variables themselves.")
- (defvar gnus-background-mode
- (condition-case nil
- (let ((bg-resource (x-get-resource ".backgroundMode"
- "BackgroundMode"))
- (params (frame-parameters)))
- (cond (bg-resource (intern (downcase bg-resource)))
- ((and (cdr (assq 'background-color params))
- (< (apply '+ (x-color-values
- (cdr (assq 'background-color params))))
- (/ (apply '+ (x-color-values "white")) 3)))
- 'dark)
- (t 'light)))
- (error 'light))
- "A symbol indicating the Emacs background brightness.
+ (defvar gnus-background-mode
+ (condition-case nil
+ (let ((bg-resource (x-get-resource ".backgroundMode"
+ "BackgroundMode"))
+ (params (frame-parameters)))
+ (cond (bg-resource (intern (downcase bg-resource)))
+ ((and (cdr (assq 'background-color params))
+ (< (apply '+ (x-color-values
+ (cdr (assq 'background-color params))))
+ (/ (apply '+ (x-color-values "white")) 3)))
+ 'dark)
+ (t 'light)))
+ (error 'light))
+ "A symbol indicating the Emacs background brightness.
The symbol should be one of `light' or `dark'.
If Emacs guesses this frame attribute wrongly, either set this variable in
your `~/.emacs' or set the resource `Emacs.backgroundMode' in your
variables get. You would normally not change this variable, but
pounce directly on the real variables themselves."))
- (cond
- ((string-match "XEmacs\\|Lucid" emacs-version)
- (gnus-xmas-define))
-
- ((and (not (string-match "28.9" emacs-version))
- (not (string-match "29" emacs-version)))
- ;; Remove the `intangible' prop.
- (let ((props (and (boundp 'gnus-hidden-properties)
- gnus-hidden-properties)))
- (while (and props (not (eq (car (cdr props)) 'intangible)))
- (setq props (cdr props)))
- (and props (setcdr props (cdr (cdr (cdr props))))))
- (or (fboundp 'buffer-substring-no-properties)
- (defun buffer-substring-no-properties (beg end)
- (format "%s" (buffer-substring beg end)))))
+ (cond
+ ((string-match "XEmacs\\|Lucid" emacs-version)
+ (gnus-xmas-define))
+
+ ((and (not (string-match "28.9" emacs-version))
+ (not (string-match "29" emacs-version)))
+ ;; Remove the `intangible' prop.
+ (let ((props (and (boundp 'gnus-hidden-properties)
+ gnus-hidden-properties)))
+ (while (and props (not (eq (car (cdr props)) 'intangible)))
+ (setq props (cdr props)))
+ (and props (setcdr props (cdr (cdr (cdr props))))))
+ (or (fboundp 'buffer-substring-no-properties)
+ (defun buffer-substring-no-properties (beg end)
+ (format "%s" (buffer-substring beg end)))))
- ((boundp 'MULE)
- (provide 'gnusutil))
- )))
+ ((boundp 'MULE)
+ (provide 'gnusutil))))
(eval-and-compile
(cond
(not (file-symlink-p file))
(file-exists-p file))))
(or (fboundp 'face-list)
- (defun face-list (&rest args)))
- )
+ (defun face-list (&rest args))))
(defun gnus-ems-redefine ()
(cond
(setq gnus-check-before-posting
(delq 'long-lines
(delq 'control-chars gnus-check-before-posting))))
- )
- ))
+
+ (defun gnus-summary-line-format-spec ()
+ (insert gnus-tmp-unread gnus-tmp-replied
+ gnus-tmp-score-char gnus-tmp-indentation)
+ (put-text-property
+ (point)
+ (progn
+ (insert
+ gnus-tmp-opening-bracket
+ (format "%4d: %-20s"
+ gnus-tmp-lines
+ (if (> (length gnus-tmp-name) 20)
+ (gnus-truncate-string gnus-tmp-name 20)
+ gnus-tmp-name))
+ gnus-tmp-closing-bracket)
+ (point))
+ gnus-mouse-face-prop gnus-mouse-face)
+ (insert " " gnus-tmp-subject-or-nil "\n"))
+ )))
+
(provide 'gnus-ems)
(setq mh-sent-from-folder gnus-article-copy)
(setq mh-sent-from-msg 1)
(setq gnus-mail-buffer (buffer-name (current-buffer)))
+ (use-local-map (copy-keymap (current-local-map)))
(local-set-key "\C-c\C-c" 'gnus-mh-mail-send-and-exit)
(setq mh-previous-window-config config)))
(interactive (list t))
(let* ((group (or group gnus-newsgroup-name))
(pgroup group)
- (to-address
- (when group
- (gnus-group-get-parameter group 'to-address)))
- (to-group
- (when group
- (gnus-group-get-parameter group 'to-group)))
- (mailing-list
- (and group gnus-mailing-list-groups
- (string-match gnus-mailing-list-groups group))))
+ to-address to-group mailing-list to-list)
(when group
- (setq group (gnus-group-real-name group)))
+ (setq to-address (gnus-group-get-parameter group 'to-address)
+ to-group (gnus-group-get-parameter group 'to-group)
+ to-list (gnus-group-get-parameter group 'to-list)
+ mailing-list (when gnus-mailing-list-groups
+ (string-match gnus-mailing-list-groups group))
+ group (gnus-group-real-name group)))
(if (or to-group
(and (gnus-member-of-valid 'post (or pgroup gnus-newsgroup-name))
(not mailing-list)
+ (not to-list)
(not to-address)))
;; This is news.
(if post
;; The is mail.
(if post
(progn
- (gnus-new-mail to-address)
+ (gnus-new-mail (or to-address to-list))
;; Arrange for mail groups that have no `to-address' to
;; get that when the user sends off the mail.
- (or to-address
- (progn
- (make-local-variable 'gnus-add-to-address)
- (setq gnus-add-to-address group))))
+ (unless to-address
+ (make-local-variable 'gnus-add-to-address)
+ (setq gnus-add-to-address group)))
(gnus-mail-reply yank to-address 'followup)))))
(defun gnus-inews-news (&optional use-group-method)
(re-search-forward
(concat "^" (regexp-quote mail-header-separator) "$"))
(replace-match "" t t)
+ ;; Remove X- prefixes to headers.
+ (gnus-inews-dex-headers)
;; Run final inews hooks. This hook may do FCC.
;; The article must be saved before being posted because
;; `gnus-request-post' modifies the buffer.
(run-hooks 'gnus-inews-article-hook)
- ;; Remove X- prefixes to headers.
- (gnus-inews-dex-headers)
;; Copy the article over to some group, possibly.
(and gcc (gnus-inews-do-gcc gcc))
;; Post the article.
(cur (cons (current-buffer) (cdr gnus-article-current)))
(winconf (current-window-configuration))
from subject date reply-to message-of to cc
- references message-id sender follow-to sendto elt new-cc)
+ references message-id sender follow-to sendto elt new-cc new-to
+ mct mctdo)
(set-buffer (get-buffer-create gnus-mail-buffer))
(mail-mode)
(if (and (buffer-modified-p)
(setq subject (concat "Re: " subject))
(setq to (mail-fetch-field "to"))
(setq cc (mail-fetch-field "cc"))
+ (setq mct (mail-fetch-field "mail-copies-to"))
(setq reply-to (mail-fetch-field "reply-to"))
(setq references (mail-fetch-field "references"))
(setq message-id (mail-fetch-field "message-id"))
+
+ (setq mctdo (not (equal mct "never")))
- (if (not followup)
- ()
- ;; When we followup, we want all the headers, I would think.
- (setq new-cc (rmail-dont-reply-to
- (concat (or to "")
- (if cc (concat (if to ", " "") cc) ""))))
- (let ((rmail-dont-reply-to-names
- (regexp-quote (mail-strip-quoted-names
- (or to-address reply-to from "")))))
- (setq new-cc (rmail-dont-reply-to new-cc))))
-
+ (if (not (and followup (not to-address)))
+ (setq new-to (or reply-to from))
+ (let (ccalist)
+ (save-excursion
+ (gnus-set-work-buffer)
+ (unless (equal mct "never")
+ (insert (or reply-to from "")))
+ (insert (if (bolp) "" ", ")
+ (or to "")
+ (if (or (not mct) (not mctdo)) ""
+ (concat (if (bolp) "" ", ") mct))
+ (if cc (concat (if (bolp) "" ", ") cc) ""))
+ (goto-char (point-min))
+ (setq ccalist
+ (mapcar
+ (lambda (addr)
+ (cons (mail-strip-quoted-names addr) addr))
+ (nreverse (mail-parse-comma-list))))
+ (let ((s ccalist))
+ (while s
+ (setq ccalist (delq (assoc (car (pop s)) s) ccalist)))))
+ (setq new-to (cdr (pop ccalist)))
+ (setq new-cc
+ (mapconcat
+ (lambda (addr) (cdr addr))
+ ccalist ", "))))
(widen)))
(setq news-reply-yank-from (or from "(nobody)"))
(if followup 'followup 'reply)
(or to-address
(if (and follow-to (not (stringp follow-to))) sendto
- (or follow-to reply-to from sender "")))
+ (or follow-to new-to sender "")))
subject message-of
(if (zerop (length new-cc)) nil new-cc)
gnus-article-copy)
;;; Code:
(require 'gnus)
-(eval-when-compile
- (require 'cl))
+(eval-when-compile (require 'cl))
(defvar gnus-nocem-groups '("alt.nocem.misc" "news.admin.net-abuse.announce")
"*List of groups that will be searched for NoCeM messages.")
(save-excursion
(set-buffer (find-file-noselect
(concat gnus-soup-directory "AREAS")))
- (buffer-disable-undo)
+ (buffer-disable-undo (current-buffer))
(erase-buffer)
(let ((areas gnus-soup-areas)
area)
(gnus-make-directory dir))
(save-excursion
(set-buffer (find-file-noselect (concat dir "REPLIES")))
- (buffer-disable-undo)
+ (buffer-disable-undo (current-buffer))
(erase-buffer)
(let (area)
(while areas
\\{gnus-server-mode-map}"
(interactive)
- (if (gnus-visual-p 'server-menu 'menu) (gnus-server-make-menu-bar))
+ (when (and menu-bar-mode
+ (gnus-visual-p 'server-menu 'menu))
+ (gnus-server-make-menu-bar))
(kill-all-local-variables)
(setq mode-line-modified "-- ")
(make-local-variable 'mode-line-format)
(elem (assoc method gnus-opened-servers))
(status (cond ((eq (nth 1 elem) 'denied)
"(denied)")
- ((gnus-server-opened method)
+ ((or (gnus-server-opened method)
+ (eq (nth 1 elem) 'ok))
"(open)")
(t
"(closed)")))
(beginning-of-line)
(setq b (point))
;; Insert the text.
- (insert (eval sformat))
+ (eval sformat)
(add-text-properties b (1+ b) (list 'gnus-server (intern name)))))
-(defun gnus-server-enter-server-buffer ()
+(defun gnus-enter-server-buffer ()
"Set up the server buffer."
(gnus-server-setup-buffer)
(gnus-configure-windows 'server)
(gnus-server-prepare))
(defun gnus-server-setup-buffer ()
- (if (get-buffer gnus-server-buffer)
- ()
+ "Initialize the server buffer."
+ (unless (get-buffer gnus-server-buffer)
(save-excursion
(set-buffer (get-buffer-create gnus-server-buffer))
(gnus-server-mode)
- (and gnus-carpal (gnus-carpal-setup-buffer 'server)))))
+ (when gnus-carpal
+ (gnus-carpal-setup-buffer 'server)))))
(defun gnus-server-prepare ()
(setq gnus-server-mode-line-format-spec
gnus-server-mode-line-format-alist))
(setq gnus-server-line-format-spec
(gnus-parse-format gnus-server-line-format
- gnus-server-line-format-alist))
+ gnus-server-line-format-alist t))
(let ((alist gnus-server-alist)
(buffer-read-only nil)
(opened gnus-opened-servers)
- done)
+ done server)
(erase-buffer)
;; First we do the real list of servers.
(while alist
- (gnus-server-insert-server-line nil (car (car alist)) (cdr (car alist)))
- (and (assoc (cdr (car alist)) gnus-opened-servers)
- (setq done (cons (cdr (car alist)) done)))
- (setq alist (cdr alist)))
+ (push (cdr (setq server (pop alist))) done)
+ (gnus-server-insert-server-line nil (car server) (cdr server)))
;; Then we insert the list of servers that have been opened in
;; this session.
(while opened
- (or (member (car (car opened)) done)
- (gnus-server-insert-server-line
- nil (format "%s:%s" (car (car (car opened)))
- (nth 1 (car (car opened))))
- (car (car opened))))
+ (unless (member (car (car opened)) done)
+ (gnus-server-insert-server-line
+ nil (format "%s:%s" (car (car (car opened)))
+ (nth 1 (car (car opened))))
+ (car (car opened))))
(setq opened (cdr opened))))
(goto-char (point-min))
(gnus-server-position-point))
(gnus-server-position-point))
(defun gnus-server-remove-denials ()
- "Remove all marks as to whether Gnus could open servers or not."
+ "Make all denied servers into closed servers."
(interactive)
- (setq gnus-opened-servers nil)
+ (let ((servers gnus-opened-servers))
+ (while servers
+ (when (eq (nth 1 (car servers)) 'denied)
+ (setcar (nthcdr 1 (car servers)) 'closed))
+ (setq servers (cdr servers))))
(gnus-server-list-servers))
(defun gnus-server-copy-server (from to)
(defun gnus-server-read-server (server)
"Browse a server."
(interactive (list (gnus-server-server-name)))
- (gnus-browse-foreign-server (gnus-server-to-method server) (current-buffer)))
-
-(defun gnus-mouse-pick-server (e)
+ (let ((buf (current-buffer)))
+ (prog1
+ (gnus-browse-foreign-server (gnus-server-to-method server) buf)
+ (save-excursion
+ (set-buffer buf)
+ (gnus-server-update-server (gnus-server-server-name))
+ (gnus-server-position-point)))))
+
+(defun gnus-server-pick-server (e)
(interactive "e")
(mouse-set-point e)
(gnus-server-read-server (gnus-server-server-name)))
-;;; gnus-topic.el --- a folding group mode for Gnus
+;;; gnus-topic.el --- a folding minor mode for Gnus group buffers
;; Copyright (C) 1995 Free Software Foundation, Inc.
;; Author: Ilja Weis <kult@uni-paderborn.de>
(require 'gnus)
(eval-when-compile (require 'cl))
-(defvar gnus-group-topic-face 'bold
- "*Face used to highlight topic headers.")
+(defvar gnus-topic-mode nil
+ "Minor mode for Gnus group buffers.")
-(defvar gnus-group-topics '(("no" "^no" nil) ("misc" "." nil))
+(defvar gnus-topic-line-format "%i[ %(%[%n%]%) -- %a ]%v\n"
+ "Format of topic lines.
+It works along the same lines as a normal formatting string,
+with some simple extensions.
+
+%i Indentation based on topic level.
+%n Topic name.
+%v Nothing if the topic is visible, \"...\" otherwise.
+%g Number of groups in the topic.
+%a Number of unread articles in the groups in the topic.
+")
+
+(defvar gnus-group-topics '(("misc" "." nil))
"*Alist of newsgroup topics.
This alist has entries of the form
the groups are always shown if SHOW is true or never if SHOW is a
number.")
-(defvar gnus-topic-names nil
- "A list of all topic names.")
-
-(defvar gnus-topic-names nil
- "A list of all topic names.")
-
(defvar gnus-group-topic-topics-only nil
"*If non-nil, only the topics will be shown when typing `l' or `L'.")
(defvar gnus-topic-unique t
"*If non-nil, each group will only belong to one topic.")
+(defvar gnus-topic-hide-subtopics t
+ "*If non-nil, hide subtopics along with groups.")
+
;; Internal variables.
-(defvar gnus-topics-not-listed nil)
+(defvar gnus-topic-killed-topics nil)
+
+(defconst gnus-topic-line-format-alist
+ `((?n name ?s)
+ (?v visible ?s)
+ (?i indentation ?s)
+ (?g number-of-groups ?d)
+ (?a (gnus-topic-articles-in-topic groups) ?d)
+ (?l level ?d)))
+
+(defvar gnus-topic-line-format-spec nil)
;; Functions.
(defun gnus-group-topic-name ()
"The name of the topic on the current line."
- (get-text-property (gnus-point-at-bol) 'gnus-topic))
+ (let ((topic (get-text-property (gnus-point-at-bol) 'gnus-topic)))
+ (and topic (symbol-name topic))))
+
+(defun gnus-group-topic-level ()
+ "The level of the topic on the current line."
+ (get-text-property (gnus-point-at-bol) 'gnus-topic-level))
(defun gnus-group-prepare-topics (level &optional all lowest regexp list-topic)
"List all newsgroups with unread articles of level LEVEL or lower, and
(erase-buffer))
;; List dead groups?
- (and (>= level gnus-level-zombie) (<= lowest gnus-level-zombie)
- (gnus-group-prepare-flat-list-dead
- (setq gnus-zombie-list (sort gnus-zombie-list 'string<))
- gnus-level-zombie ?Z
- regexp))
+ (when (and (>= level gnus-level-zombie) (<= lowest gnus-level-zombie))
+ (gnus-group-prepare-flat-list-dead
+ (setq gnus-zombie-list (sort gnus-zombie-list 'string<))
+ gnus-level-zombie ?Z
+ regexp))
- (and (>= level gnus-level-killed) (<= lowest gnus-level-killed)
- (gnus-group-prepare-flat-list-dead
- (setq gnus-killed-list (sort gnus-killed-list 'string<))
- gnus-level-killed ?K
- regexp))
+ (when (and (>= level gnus-level-killed) (<= lowest gnus-level-killed))
+ (gnus-group-prepare-flat-list-dead
+ (setq gnus-killed-list (sort gnus-killed-list 'string<))
+ gnus-level-killed ?K
+ regexp))
;; Use topics.
- (if (< lowest gnus-level-zombie)
- (let ((topics (gnus-topic-find-groups list-topic level all))
- topic how)
- (setq gnus-topic-names topics)
- (while topics
- (setq topic (car (car topics))
- tlist (cdr (car topics))
- how (nth 2 (assoc topic gnus-group-topics))
- topics (cdr topics))
-
- ;; Insert the topic.
- (unless list-topic
- (add-text-properties
- (point)
- (progn
- (insert topic "\n")
- (1- (point)))
- (list 'mouse-face gnus-mouse-face
- 'face gnus-group-topic-face
- 'gnus-topic topic)))
-
- ;; We insert the groups for the topics we want to have.
- (if (and (or (and (not how) (not gnus-group-topic-topics-only))
- (and how (not (numberp how))))
- (not (member topic gnus-topics-not-listed)))
- ;; We want to list this topic.
- (progn
- (setq gnus-topics-not-listed
- (delete topic gnus-topics-not-listed))
- (setq tlist (nreverse tlist))
- (while tlist
- (setq info (car tlist))
- (gnus-group-insert-group-line
- nil (gnus-info-group info)
- (gnus-info-level info) (gnus-info-marks info)
- (car (gnus-gethash (gnus-info-group info)
- gnus-newsrc-hashtb))
- (gnus-info-method info))
- (setq tlist (cdr tlist))))
- ;; This one is hiddent.
- (push topic gnus-topics-not-listed))))))
+ (when (< lowest gnus-level-zombie)
+ (let ((topics (gnus-topic-find-groups nil level all))
+ topic how)
+ ;; The first time we set the topology to whatever we have
+ ;; gotten here, which can be rather random.
+ (unless gnus-topic-topology
+ (setq gnus-topic-topology
+ (list (list "Gnus" 'visible)
+ (mapcar (lambda (topic) (list (car topic) 'visible))
+ topics)))
+ (gnus-topic-enter-dribble))
+
+ ;; Check that all topics are in the topology.
+ (gnus-topic-check-topology topics)
+
+ (if list-topic
+ (let ((top (gnus-topic-find-topology list-topic)))
+ (gnus-topic-prepare-topic
+ (cdr top) (car top) topics))
+ (gnus-topic-prepare-topic gnus-topic-topology 0 topics)))))
(gnus-group-set-mode-line)
(setq gnus-group-list-mode (cons level all))
(run-hooks 'gnus-group-prepare-hook))
+(defun gnus-topic-prepare-topic (topic level topic-alist)
+ "Insert TOPIC into the group buffer."
+ (let* ((type (pop topic))
+ (groups (nreverse (cdr (assoc (car type) topic-alist))))
+ (visiblep (eq (nth 1 type) 'visible))
+ info)
+ ;; Insert the topic line.
+ (gnus-topic-insert-topic-line
+ (car type) visiblep
+ (not (eq (nth 2 type) 'hidden))
+ level groups)
+ (when visiblep
+ ;; Insert all the groups that belong in this topic.
+ (while groups
+ (setq info (pop groups))
+ (gnus-group-insert-group-line
+ (gnus-info-group info)
+ (gnus-info-level info) (gnus-info-marks info)
+ (car (gnus-gethash (gnus-info-group info)
+ gnus-newsrc-hashtb))
+ (gnus-info-method info))))
+ ;; Insert any sub-topics.
+ (when (or visiblep
+ (and (not gnus-topic-hide-subtopics)
+ (eq (nth 2 type) 'shown)))
+ (while topic
+ (gnus-topic-prepare-topic (pop topic) (1+ level) topic-alist)))))
+
+
(defun gnus-topic-find-groups (&optional topic level all)
"Find all topics and all groups in all topics.
If TOPIC, just find the groups in that topic."
gnus-group-topics)))
(topic-alist (if topic (list (assoc topic gnus-group-topics))
gnus-group-topics))
- info clevel unread group w lowest gtopic)
+ info clevel unread group w lowest gtopic params)
(setq lowest (or lowest 1))
(setq all (or all nil))
(setq level (or level 7))
(while newsrc
(setq info (car newsrc)
group (gnus-info-group info)
+ params (gnus-info-params info)
newsrc (cdr newsrc)
unread (car (gnus-gethash group gnus-newsrc-hashtb)))
(and
(or all
(eq unread t)
(> unread 0)
- (cdr (assq 'tick (gnus-info-marks info)))) ; Has right readedness.
+ (cdr (assq 'tick (gnus-info-marks info))) ; Has right readedness.
+ ;; Check for permanent visibility.
+ (and gnus-permanently-visible-groups
+ (string-match gnus-permanently-visible-groups group))
+ (memq 'visible params)
+ (cdr (assq 'visible params)))
(progn
;; So we find out what topic this group belongs to. First we
;; check the group parameters.
(setq ts (cdr ts))))))))
topics))
-(defun gnus-topic-remove-topic ()
+(defun gnus-topic-remove-topic (&optional insert total-remove hide)
"Remove the current topic."
(let ((topic (gnus-group-topic-name))
+ (level (gnus-group-topic-level))
+ (beg (progn (beginning-of-line) (point)))
buffer-read-only)
(when topic
- (setq gnus-topics-not-listed (cons topic gnus-topics-not-listed))
- (forward-line 1)
- (unless (gnus-group-topic-name)
- (delete-region (point)
- (or (next-single-property-change (point) 'gnus-topic)
- (point-max)))))))
+ (while (and (zerop (forward-line 1))
+ (> (or (gnus-group-topic-level) (1+ level)) level)))
+ (delete-region beg (point))
+ (setcar (cdr (car (cdr (gnus-topic-find-topology topic))))
+ (if insert 'visible 'invisible))
+ (when hide
+ (setcdr (cdr (car (cdr (gnus-topic-find-topology topic))))
+ (list hide)))
+ (unless total-remove
+ (gnus-topic-insert-topic topic)))))
(defun gnus-topic-insert-topic (topic)
"Insert TOPIC."
- (setq gnus-topics-not-listed (delete topic gnus-topics-not-listed))
(gnus-group-prepare-topics
(car gnus-group-list-mode) (cdr gnus-group-list-mode)
nil nil topic))
-(defun gnus-topic-fold ()
+(defun gnus-topic-fold (&optional insert)
"Remove/insert the current topic."
(let ((topic (gnus-group-topic-name)))
(when topic
(save-excursion
- (if (not (member topic gnus-topics-not-listed))
- ;; If the topic is visible, we remove it.
- (gnus-topic-remove-topic)
- ;; If not, we insert it.
- (forward-line 1)
- (gnus-topic-insert-topic topic))))))
+ (gnus-topic-remove-topic (or insert (not (gnus-topic-visible-p))))))))
+
+(defun gnus-group-topic-p ()
+ "Return non-nil if the current line is a topic."
+ (get-text-property (gnus-point-at-bol) 'gnus-topic))
+
+(defun gnus-topic-visible-p ()
+ "Return non-nil if the current topic is visible."
+ (get-text-property (gnus-point-at-bol) 'gnus-topic-visible))
+
+(defun gnus-topic-insert-topic-line (name visiblep shownp level groups)
+ (let* ((visible (if (and visiblep shownp) "" "..."))
+ (indentation (make-string (* 2 level) ? ))
+ (number-of-groups (length groups))
+ b)
+ (beginning-of-line)
+ ;; Insert the text.
+ (add-text-properties
+ (point)
+ (prog1 (1+ (point))
+ (eval gnus-topic-line-format-spec))
+ (list 'gnus-topic (intern name)
+ 'gnus-topic-level level
+ 'gnus-topic-visible visiblep))))
+
+(defun gnus-topic-check-topology (topic-alist)
+ (let ((topics (gnus-topic-list))
+ changed)
+ (while topic-alist
+ (unless (member (car (car topic-alist)) topics)
+ (nconc gnus-topic-topology
+ (list (list (list (car (car topic-alist)) 'visible))))
+ (setq changed t))
+ (setq topic-alist (cdr topic-alist)))
+ (when changed
+ (gnus-topic-enter-dribble))))
+
+(defvar gnus-tmp-topics nil)
+(defun gnus-topic-list (&optional topology)
+ (unless topology
+ (setq topology gnus-topic-topology
+ gnus-tmp-topics nil))
+ (push (car (car topology)) gnus-tmp-topics)
+ (mapcar 'gnus-topic-list (cdr topology))
+ gnus-tmp-topics)
+
+(defun gnus-topic-find-topology (topic &optional topology level remove)
+ (unless topology
+ (setq topology gnus-topic-topology)
+ (setq level 0))
+ (let ((top topology)
+ result)
+ (if (equal (car (car topology)) topic)
+ (progn
+ (when remove
+ (delq topology remove))
+ (cons level topology))
+ (setq topology (cdr topology))
+ (while (and topology
+ (not (setq result (gnus-topic-find-topology
+ topic (car topology) (1+ level)
+ (and remove top)))))
+ (setq topology (cdr topology)))
+ result)))
+
+(defun gnus-topic-enter-dribble ()
+ (gnus-dribble-enter
+ (format "(setq gnus-topic-topology '%S)" gnus-topic-topology)))
+
+(defun gnus-topic-articles-in-topic (groups)
+ (let ((total 0)
+ number)
+ (while groups
+ (when (numberp (setq number (gnus-group-unread
+ (gnus-info-group (pop groups)))))
+ (incf total number)))
+ total))
+
+(defun gnus-topic-parent-topic ()
+ (save-excursion
+ (let (topic)
+ (while (not (setq topic (gnus-group-topic-name)))
+ (forward-line -1))
+ topic)))
+
+(defun gnus-topic-goto-topic (topic)
+ (goto-char (point-min))
+ (while (and (not (equal topic (gnus-group-topic-name)))
+ (zerop (forward-line 1))))
+ (gnus-group-topic-name))
+
+(defun gnus-topic-update-topic ()
+ (when (and (eq major-mode 'gnus-group-mode)
+ gnus-topic-mode)
+ (let ((group (gnus-group-group-name)))
+ (gnus-topic-goto-topic (gnus-topic-parent-topic))
+ (gnus-topic-remove-topic t)
+ (gnus-group-goto-group group)
+ (gnus-group-position-point))))
+
+;;; Topic mode, commands and keymap.
+
+(defvar gnus-topic-mode-map nil)
+(defvar gnus-group-topic-map nil)
+
+(unless gnus-topic-mode-map
+ (setq gnus-topic-mode-map (make-sparse-keymap))
+ (define-key gnus-topic-mode-map "=" 'gnus-topic-select-group)
+ (define-key gnus-topic-mode-map "\r" 'gnus-topic-select-group)
+ (define-key gnus-topic-mode-map " " 'gnus-topic-read-group)
+ (define-key gnus-topic-mode-map "\C-k" 'gnus-topic-kill-group)
+ (define-key gnus-topic-mode-map "\C-y" 'gnus-topic-yank-group)
+
+ (define-prefix-command 'gnus-group-topic-map)
+ (define-key gnus-group-mode-map "T" 'gnus-group-topic-map)
+ (define-key gnus-group-topic-map "c" 'gnus-topic-create-topic)
+ (define-key gnus-group-topic-map "m" 'gnus-topic-move-to-topic)
+ (define-key gnus-group-topic-map "h" 'gnus-topic-hide-topic)
+ (define-key gnus-group-topic-map "s" 'gnus-topic-show-topic)
+ )
+
+;;;###autoload
+(defun gnus-topic-mode (&optional arg redisplay)
+ "Minor mode for Gnus group buffers."
+ (interactive (list current-prefix-arg t))
+ (when (eq major-mode 'gnus-group-mode)
+ (make-local-variable 'gnus-topic-mode)
+ (setq gnus-topic-mode
+ (if (null arg) (not gnus-topic-mode)
+ (> (prefix-numeric-value arg) 0)))
+ (when gnus-topic-mode
+ (setq gnus-topic-line-format-spec
+ (gnus-parse-format gnus-topic-line-format
+ gnus-topic-line-format-alist t))
+ (unless (assq 'gnus-topic-mode minor-mode-alist)
+ (push '(gnus-topic-mode " Topic") minor-mode-alist))
+ (unless (assq 'gnus-topic-mode minor-mode-map-alist)
+ (push (cons 'gnus-topic-mode gnus-topic-mode-map)
+ minor-mode-map-alist)))
+ (make-local-variable 'gnus-group-prepare-function)
+ (setq gnus-group-prepare-function
+ (if gnus-topic-mode
+ 'gnus-group-prepare-topics
+ 'gnus-group-prepare-flat))
+ (add-hook 'gnus-summary-exit-hook 'gnus-topic-update-topic)
+ (when redisplay
+ (gnus-group-list-groups))))
+
+(defun gnus-topic-select-group (&optional all)
+ "Select this newsgroup.
+No article is selected automatically.
+If ALL is non-nil, already read articles become readable.
+If ALL is a number, fetch this number of articles."
+ (interactive "P")
+ (if (gnus-group-topic-p)
+ (let ((gnus-group-list-mode
+ (if all (cons (if (numberp all) all 7) t) gnus-group-list-mode)))
+ (gnus-topic-fold all))
+ (gnus-group-select-group all)))
+
+(defun gnus-topic-read-group (&optional all no-article group)
+ "Read news in this newsgroup.
+If the prefix argument ALL is non-nil, already read articles become
+readable. IF ALL is a number, fetch this number of articles. If the
+optional argument NO-ARTICLE is non-nil, no article will be
+auto-selected upon group entry. If GROUP is non-nil, fetch that
+group."
+ (interactive "P")
+ (if (gnus-group-topic-p)
+ (let ((gnus-group-list-mode
+ (if all (cons (if (numberp all) all 7) t) gnus-group-list-mode)))
+ (gnus-topic-fold all))
+ (gnus-group-read-group all no-article group)))
+
+(defun gnus-topic-create-topic (topic parent &optional previous)
+ (interactive
+ (list
+ (read-string "Create topic: ")
+ (completing-read "Parent topic: "
+ (mapcar (lambda (l) (list l)) (gnus-topic-list))
+ nil t)))
+ ;; Check whether this topic already exists.
+ (when (gnus-topic-find-topology topic)
+ (error "Topic aleady exists"))
+ (let ((top (cdr (gnus-topic-find-topology parent))))
+ (unless top
+ (error "No such topic: %s" parent))
+ (when previous
+ (while (and (cdr top)
+ (not (equal (car (car (car top))) previous)))
+ (setq top (cdr top))))
+ (setcdr top (cons (list (list topic 'visible)) (cdr top))))
+ (gnus-topic-enter-dribble)
+ (gnus-group-list-groups))
;; Written by "jeff (j.d.) sparkes" <jsparkes@bnr.ca>.
-(defun gnus-group-add-to-topic (n topic)
- "Add the current group to a topic."
+(defun gnus-topic-move-to-topic (n topic)
+ "Move the current group to a topic."
(interactive
(list current-prefix-arg
- (completing-read "Add to topic: " gnus-topic-names)))
+ (completing-read "Move to topic: "
+ (mapcar (lambda (l) (list l)) (gnus-topic-list)))))
(let ((groups (gnus-group-process-prefix n)))
(mapcar (lambda (g)
(gnus-group-remove-mark g)
(gnus-group-add-parameter g (cons 'topic topic)))
groups)
- (gnus-group-position-point)))
+ (gnus-group-position-point))
+ (gnus-topic-enter-dribble)
+ (gnus-group-list-groups))
-(defun gnus-topic-toggle-topic ()
- "Toggle between a flat group buffer and a topic display."
+(defun gnus-topic-kill-group (&optional n discard)
+ "Kill the next N groups."
+ (interactive "P")
+ (if (not (gnus-group-topic-p))
+ (gnus-group-kill-group n discard)
+ (let ((topic (gnus-group-topic-name)))
+ (gnus-topic-remove-topic nil t)
+ (push (gnus-topic-find-topology topic nil nil gnus-topic-topology)
+ gnus-topic-killed-topics))))
+
+(defun gnus-topic-yank-group (&optional arg)
+ "Yank the last ARG groups."
+ (interactive "p")
+ (if (null gnus-topic-killed-topics)
+ (gnus-group-yank-group arg)
+ (let ((parent (gnus-group-topic-name))
+ (item (nth 1 (pop gnus-topic-killed-topics))))
+ (gnus-topic-create-topic
+ (car item) (or parent (car (car gnus-topic-topology)))))))
+
+(defun gnus-topic-hide-topic ()
+ "Hide all subtopics under the current topic."
(interactive)
- (if (eq gnus-group-prepare-function 'gnus-group-prepare-topics)
- (setq gnus-group-prepare-function 'gnus-group-prepare-flat)
- (setq gnus-group-prepare-function 'gnus-group-prepare-topics))
- (gnus-group-list-groups))
+ (when (gnus-group-topic-p)
+ (gnus-topic-remove-topic nil nil 'hidden)))
+
+(defun gnus-topic-show-topic ()
+ "Show the hidden topic."
+ (interactive)
+ (when (gnus-group-topic-p)
+ (gnus-topic-remove-topic t nil 'shown)))
;;; gnus-topic.el ends here
(defun gnus-uu-grab-articles
(articles process-function &optional sloppy limit no-errors)
(let ((state 'first)
- has-been-begin article result-file result-files process-state
- article-buffer)
+ has-been-begin article result-file result-files process-state)
(if (not (gnus-server-opened gnus-current-select-method))
(progn
(setq state 'last)))
(message "Getting article %d, %s" article (gnus-uu-part-number article))
-
- (if (not (= (or gnus-current-article 0) article))
- (let ((nntp-async-number nil))
- (save-excursion
- (set-buffer nntp-server-buffer)
- (gnus-request-article-this-buffer article gnus-newsgroup-name))
- (setq gnus-last-article gnus-current-article)
- (setq gnus-current-article article)
- (setq gnus-article-current (cons gnus-newsgroup-name article))
- (if (stringp nntp-server-buffer)
- (setq article-buffer nntp-server-buffer)
- (setq article-buffer (buffer-name nntp-server-buffer))))
- (gnus-summary-stop-page-breaking)
- (setq article-buffer gnus-article-buffer))
-
- (buffer-disable-undo article-buffer)
- ;; Mark article as read.
- (and (memq article gnus-newsgroup-processable)
- (gnus-summary-remove-process-mark article))
- (run-hooks 'gnus-mark-article-hook)
-
- (setq process-state (funcall process-function article-buffer state))
+ (gnus-summary-display-article article)
+ (save-excursion
+ (set-buffer gnus-original-article-buffer)
+ (let ((buffer-read-only nil))
+ (save-excursion
+ (set-buffer gnus-summary-buffer)
+ (setq process-state
+ (funcall process-function
+ gnus-original-article-buffer state)))))
+ (gnus-summary-remove-process-mark article)
(if (or (memq 'begin process-state)
(and (or (eq state 'first) (eq state 'first-and-last))
;; Make sure the last article is put in the article buffer & fix
;; windows etc.
- (if (not (string= article-buffer gnus-article-buffer))
- (save-excursion
- (set-buffer (get-buffer-create gnus-article-buffer))
- (let ((buffer-read-only nil))
- (widen)
- (erase-buffer)
- (insert-buffer-substring article-buffer)
- (gnus-set-mode-line 'article)
- (goto-char (point-min)))))
-
- (gnus-set-mode-line 'summary)
-
(if result-files
()
(if (not has-been-begin)
; "Face used for signature.")
(defvar gnus-button-url-regexp "\\b\\(s?https?\\|ftp\\|file\\|gopher\\|news\\|telnet\\|wais\\|mailto\\):\\(//[-a-zA-Z0-9_.]+:[0-9]*\\)?[-a-zA-Z0-9_=?#$@~`%&*+|\\/.,]*[-a-zA-Z0-9_=#$@~`%&*+|\\/]"
- "*Regular expression matching Urls")
+ "*Regular expression that matches URLs.")
(defvar gnus-button-alist
`(("\\bin\\( +article\\)? +\\(<\\([^\n @<>]+@[^\n @<>]+\\)>\\)" 2
(assq (1+ lines) gnus-cite-attribution-alist)))
gnus-button-message-id 3)
;; This is how URLs _should_ be embedded in text...
- ("<URL:\\([^\n\r>]*\\)>" 0 t browse-url-browser-function 1)
+ ("<URL:\\([^\n\r>]*\\)>" 0 t ,browse-url-browser-function 1)
;; Next regexp stolen from highlight-headers.el.
;; Modified by Vladimir Alexiev.
- (,gnus-button-url-regexp 0 t browse-url-browser-function 0))
+ (,gnus-button-url-regexp 0 t ,browse-url-browser-function 0)
+ ("\\(<\\(url: \\)?news:\\([^>\n ]*\\)>\\)" 1 t
+ gnus-button-message-id 3))
"Alist of regexps matching buttons in article bodies.
Each entry has the form (REGEXP BUTTON FORM CALLBACK PAR...), where
variable it the real callback function.")
(defvar gnus-header-button-alist
- `(("^\\(References\\|Message-ID\\):" "<[^>]+>" 0 t gnus-button-message-id 0)
+ `(("^\\(References\\|Message-I[Dd]\\):" "<[^>]+>"
+ 0 t gnus-button-message-id 0)
("^\\(From\\|Reply-To\\): " ": *\\(.+\\)$" 1 t gnus-button-reply 0)
("^\\(Cc\\|To\\):" "[^ \t\n<>,()\"]+@[^ \t\n<>,()\"]+"
0 t gnus-button-mailto 0)
- ("^X-[Uu][Rr][Ll]:" ,gnus-button-url-regexp 0 t browse-url-browser-function 0))
+ ("^X-[Uu][Rr][Ll]:" ,gnus-button-url-regexp 0 t
+ ,browse-url-browser-function 0))
"Alist of headers and regexps to match buttons in article heads.
This alist is very similar to `gnus-button-alist', except that each
(cons fun args)))))))
(defun gnus-button-message-id (message-id)
- ;; Fetch MESSAGE-ID.
+ "Fetch MESSAGE-ID."
(save-excursion
(set-buffer gnus-summary-buffer)
(gnus-summary-refer-article message-id)))
;;; Code:
(require 'text-props)
+(defvar menu-bar-mode t)
(defvar gnus-xmas-glyph-directory nil
"*Directory where Gnus logos and icons are located.
(progn
(setq info (nth 2 entry))
(gnus-group-insert-group-line
- nil group (gnus-info-level info) (gnus-info-marks info)
+ group (gnus-info-level info) (gnus-info-marks info)
(car entry) (gnus-info-method info)))
(setq active (gnus-gethash group gnus-active-hashtb))
(gnus-group-insert-group-line
- nil group (if (member group gnus-zombie-list) gnus-level-zombie
+ group (if (member group gnus-zombie-list) gnus-level-zombie
gnus-level-killed)
nil (if active (- (1+ (cdr active)) (car active)) 0) nil))
(save-excursion
(defun gnus-xmas-redefine ()
- (fset 'gnus-mouse-face-function 'identity)
+
+
(fset 'gnus-summary-make-display-table (lambda () nil))
(fset 'gnus-visual-turn-off-edit-menu 'identity)
(fset 'gnus-highlight-selected-summary
(set-specifier (symbol-value gnus-use-toolbar)
(cons (current-buffer) gnus-summary-toolbar))))
-
;;; gnus-xmas.el ends here
;;; Commentary:
-;; Although Gnus looks suspiciously like GNUS, it isn't quite the same
-;; beast. Most internal structures have been changed. If you have
-;; written packages that depend on any of the hash tables,
-;; `gnus-newsrc-alist', `gnus-killed-assoc', marked lists, the .newsrc
-;; buffer, or internal knowledge of the `nntp-header-' macros, or
-;; dependence on the buffers having a certain format, your code will
-;; fail.
-
;;; Code:
(eval '(run-hooks 'gnus-load-hook))
that will be removed from subject strings if fuzzy subject
simplification is selected.")
+(defvar gnus-permanently-visible-groups nil
+ "*Regexp to match groups that should always be listed in the group buffer.
+This means that they will still be listed when there are no unread
+articles in the groups.")
+
(defvar gnus-group-default-list-level gnus-level-subscribed
"*Default listing level.
Ignored if `gnus-group-use-permanent-levels' is non-nil.")
(defvar gnus-strict-mime t
"*If nil, decode MIME header even if there is not Mime-Version field.")
-(defvar gnus-show-mime-method (function metamail-buffer)
+(defvar gnus-show-mime-method 'metamail-buffer
"*Function to process a MIME message.
The function is called from the article buffer.")
+(defvar gnus-decode-encoded-word-method (lambda ())
+ "*Function to decode a MIME encoded-words.
+The function is called from the article buffer.")
+
(defvar gnus-show-threads t
"*If non-nil, display threads in summary mode.")
If this variable is nil, screen refresh may be quicker.")
;; Added by Keinonen Kari <kk85613@cs.tut.fi>.
-(defvar gnus-mode-non-string-length 21
+(defvar gnus-mode-non-string-length 25
"*Max length of mode-line non-string contents.
If this is nil, Gnus will take space as is needed, leaving the rest
of the modeline intact.")
(defvar gnus-summary-inhibit-highlight nil)
(defvar gnus-newsgroup-selected-overlay nil)
+(defvar gnus-inhibit-hiding nil)
+
(defvar gnus-article-mode-map nil)
(defvar gnus-dribble-buffer nil)
(defvar gnus-headers-retrieved-by nil)
(defvar gnus-summary-display-table nil)
(defconst gnus-group-line-format-alist
- (` ((?M gnus-tmp-marked ?c)
- (?S gnus-tmp-subscribed ?c)
- (?L gnus-tmp-level ?d)
- (?N gnus-tmp-number ?s)
- (?I gnus-tmp-number-of-dormant ?d)
- (?T gnus-tmp-number-of-ticked ?d)
- (?R gnus-tmp-number-of-read ?s)
- (?t gnus-tmp-number-total ?d)
- (?y gnus-tmp-number-of-unread-unticked ?s)
- (?i gnus-tmp-number-of-ticked-and-dormant ?d)
- (?g gnus-tmp-group ?s)
- (?G gnus-tmp-qualified-group ?s)
- (?D gnus-tmp-newsgroup-description ?s)
- (?o gnus-tmp-moderated ?c)
- (?O gnus-tmp-moderated-string ?s)
- (?p gnus-tmp-process-marked ?c)
- (?s gnus-tmp-news-server ?s)
- (?n gnus-tmp-news-method ?s)
- (?z gnus-tmp-news-method-string ?s)
- (?u gnus-tmp-user-defined ?s))))
+ `((?M gnus-tmp-marked ?c)
+ (?S gnus-tmp-subscribed ?c)
+ (?L gnus-tmp-level ?d)
+ (?N gnus-tmp-number ?s)
+ (?R gnus-tmp-number-of-read ?s)
+ (?t gnus-tmp-number-total ?d)
+ (?y gnus-tmp-number-of-unread ?s)
+ (?I (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked))) ?d)
+ (?T (gnus-range-length (cdr (assq 'tick gnus-tmp-marked))) ?d)
+ (?i (+ (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked)))
+ (gnus-range-length (cdr (assq 'tick gnus-tmp-marked)))) ?d)
+ (?g gnus-tmp-group ?s)
+ (?G gnus-tmp-qualified-group ?s)
+ (?D gnus-tmp-newsgroup-description ?s)
+ (?o gnus-tmp-moderated ?c)
+ (?O gnus-tmp-moderated-string ?s)
+ (?p gnus-tmp-process-marked ?c)
+ (?s gnus-tmp-news-server ?s)
+ (?n gnus-tmp-news-method ?s)
+ (?z gnus-tmp-news-method-string ?s)
+ (?u gnus-tmp-user-defined ?s)))
(defconst gnus-summary-line-format-alist
- (` ((?N gnus-tmp-number ?d)
- (?S gnus-tmp-subject ?s)
- (?s gnus-tmp-subject-or-nil ?s)
- (?n gnus-tmp-name ?s)
- (?A (car (cdr (funcall gnus-extract-address-components gnus-tmp-from)))
- ?s)
- (?a (or (car (funcall gnus-extract-address-components gnus-tmp-from))
- gnus-tmp-from) ?s)
- (?F gnus-tmp-from ?s)
- (?x (, (macroexpand '(mail-header-xref gnus-tmp-header))) ?s)
- (?D (, (macroexpand '(mail-header-date gnus-tmp-header))) ?s)
- (?d (gnus-dd-mmm (mail-header-date gnus-tmp-header)) ?s)
- (?M (, (macroexpand '(mail-header-id gnus-tmp-header))) ?s)
- (?r (, (macroexpand '(mail-header-references gnus-tmp-header))) ?s)
- (?c (or (mail-header-chars gnus-tmp-header) 0) ?d)
- (?L gnus-tmp-lines ?d)
- (?I gnus-tmp-indentation ?s)
- (?T (if (= gnus-tmp-level 0) "" (make-string (frame-width) ? )) ?s)
- (?R gnus-tmp-replied ?c)
- (?\[ gnus-tmp-opening-bracket ?c)
- (?\] gnus-tmp-closing-bracket ?c)
- (?\> (make-string gnus-tmp-level ? ) ?s)
- (?\< (make-string (max 0 (- 20 gnus-tmp-level)) ? ) ?s)
- (?i gnus-tmp-score ?d)
- (?z gnus-tmp-score-char ?c)
- (?U gnus-tmp-unread ?c)
- (?t (gnus-summary-number-of-articles-in-thread
- (and (boundp 'thread) (car thread)) gnus-tmp-level)
- ?d)
- (?e (gnus-summary-number-of-articles-in-thread
- (and (boundp 'thread) (car thread)) gnus-tmp-level t)
- ?c)
- (?u gnus-tmp-user-defined ?s)))
+ `((?N gnus-tmp-number ?d)
+ (?S gnus-tmp-subject ?s)
+ (?s gnus-tmp-subject-or-nil ?s)
+ (?n gnus-tmp-name ?s)
+ (?A (car (cdr (funcall gnus-extract-address-components gnus-tmp-from)))
+ ?s)
+ (?a (or (car (funcall gnus-extract-address-components gnus-tmp-from))
+ gnus-tmp-from) ?s)
+ (?F gnus-tmp-from ?s)
+ (?x ,(macroexpand '(mail-header-xref gnus-tmp-header)) ?s)
+ (?D ,(macroexpand '(mail-header-date gnus-tmp-header)) ?s)
+ (?d (gnus-dd-mmm (mail-header-date gnus-tmp-header)) ?s)
+ (?M ,(macroexpand '(mail-header-id gnus-tmp-header)) ?s)
+ (?r ,(macroexpand '(mail-header-references gnus-tmp-header)) ?s)
+ (?c (or (mail-header-chars gnus-tmp-header) 0) ?d)
+ (?L gnus-tmp-lines ?d)
+ (?I gnus-tmp-indentation ?s)
+ (?T (if (= gnus-tmp-level 0) "" (make-string (frame-width) ? )) ?s)
+ (?R gnus-tmp-replied ?c)
+ (?\[ gnus-tmp-opening-bracket ?c)
+ (?\] gnus-tmp-closing-bracket ?c)
+ (?\> (make-string gnus-tmp-level ? ) ?s)
+ (?\< (make-string (max 0 (- 20 gnus-tmp-level)) ? ) ?s)
+ (?i gnus-tmp-score ?d)
+ (?z gnus-tmp-score-char ?c)
+ (?U gnus-tmp-unread ?c)
+ (?t (gnus-summary-number-of-articles-in-thread
+ (and (boundp 'thread) (car thread)) gnus-tmp-level)
+ ?d)
+ (?e (gnus-summary-number-of-articles-in-thread
+ (and (boundp 'thread) (car thread)) gnus-tmp-level t)
+ ?c)
+ (?u gnus-tmp-user-defined ?s))
"An alist of format specifications that can appear in summary lines,
and what variables they correspond with, along with the type of the
variable (string, integer, character, etc).")
"gnus-bug@ifi.uio.no (The Gnus Bugfixing Girls + Boys)"
"The mail address of the Gnus maintainers.")
-(defconst gnus-version "September Gnus v0.14"
+(defconst gnus-version "September Gnus v0.15"
"Version number for this version of Gnus.")
(defvar gnus-info-nodes
'(gnus-newsrc-options gnus-newsrc-options-n
gnus-newsrc-last-checked-date
gnus-newsrc-alist gnus-server-alist
- gnus-killed-list gnus-zombie-list)
+ gnus-killed-list gnus-zombie-list
+ gnus-topic-topology)
"Gnus variables saved in the quick startup file.")
(defvar gnus-newsrc-options nil
(defvar gnus-newsrc-last-checked-date nil
"Date Gnus last asked server for new newsgroups.")
+(defvar gnus-topic-topology nil
+ "The complete topic hierarchy.")
+
(defvar gnus-newsrc-alist nil
"Assoc list of read articles.
gnus-newsrc-hashtb should be kept so that both hold the same information.")
(defvar gnus-newsgroup-threads nil)
-(defvar gnus-newsgroup-prepared nil)
+(defvar gnus-newsgroup-prepared nil
+ "Whether the current group has been prepared properly.")
(defvar gnus-newsgroup-ancient nil
"List of `gnus-fetch-old-headers' articles in the current newsgroup.")
;; flexibility of the user-defined format specs.
;; First we have lots of dummy defvars to let the compiler know these
-;; are realyl dynamic variables.
+;; are really dynamic variables.
(defvar gnus-tmp-unread)
(defvar gnus-tmp-replied)
(defvar gnus-tmp-marked)
(defvar gnus-tmp-subscribed)
(defvar gnus-tmp-process-marked)
-(defvar gnus-tmp-number-of-unread-unticked)
+(defvar gnus-tmp-number-of-unread)
(defvar gnus-tmp-group-name)
(defvar gnus-tmp-group)
(defvar gnus-tmp-article-number)
(defvar gnus-tmp-news-server)
(defvar gnus-tmp-article-number)
(defvar gnus-mouse-face)
+(defvar gnus-mouse-face-prop)
(defun gnus-byte-code (func)
(let ((fval (symbol-function func)))
(defun gnus-summary-line-format-spec ()
(insert gnus-tmp-unread gnus-tmp-replied
gnus-tmp-score-char gnus-tmp-indentation)
- (let ((b (point)))
- (insert gnus-tmp-opening-bracket
- (format "%4d: %-20s"
- gnus-tmp-lines
- (if (> (length gnus-tmp-name) 20)
- (substring gnus-tmp-name 0 20)
- gnus-tmp-name))
- gnus-tmp-closing-bracket
- " " gnus-tmp-subject-or-nil "\n")
- (put-text-property b (+ b 28) gnus-mouse-face-prop gnus-mouse-face)))
+ (put-text-property
+ (point)
+ (progn
+ (insert
+ gnus-tmp-opening-bracket
+ (format "%4d: %-20s"
+ gnus-tmp-lines
+ (if (> (length gnus-tmp-name) 20)
+ (substring gnus-tmp-name 0 20)
+ gnus-tmp-name))
+ gnus-tmp-closing-bracket)
+ (point))
+ gnus-mouse-face-prop gnus-mouse-face)
+ (insert " " gnus-tmp-subject-or-nil "\n"))
+
(defvar gnus-summary-line-format-spec
(gnus-byte-code 'gnus-summary-line-format-spec))
(defun gnus-group-line-format-spec ()
(insert gnus-tmp-marked gnus-tmp-subscribed
gnus-tmp-process-marked
- (format "%5s: " gnus-tmp-number-of-unread-unticked))
- (let ((b (point)))
- (insert gnus-tmp-group "\n")
- (put-text-property b (1- (point)) gnus-mouse-face-prop gnus-mouse-face)))
+ (format "%5s: " gnus-tmp-number-of-unread))
+ (put-text-property
+ (point)
+ (progn
+ (insert gnus-tmp-group "\n")
+ (1- (point)))
+ gnus-mouse-face-prop gnus-mouse-face))
(defvar gnus-group-line-format-spec
(gnus-byte-code 'gnus-group-line-format-spec))
(defun gnus-summary-mode-line-format-spec ()
-(format "Gnus %s/%d %s" gnus-tmp-group-name gnus-tmp-article-number gnus-tmp-unread-and-unselected))
+ (format "Gnus %s/%d %s" gnus-tmp-group-name
+ gnus-tmp-article-number gnus-tmp-unread-and-unselected))
(defvar gnus-summary-mode-line-format-spec
(gnus-byte-code 'gnus-summary-mode-line-format-spec))
(defun gnus-group-mode-line-format-spec ()
-(format "Gnus List of groups {%s:%s} " gnus-tmp-news-method gnus-tmp-news-server))
+ (format "Gnus List of groups {%s:%s} "
+ gnus-tmp-news-method gnus-tmp-news-server))
(defvar gnus-group-mode-line-format-spec
(gnus-byte-code 'gnus-group-mode-line-format-spec))
(defun gnus-article-mode-line-format-spec ()
-(format "Gnus %s/%d %s" gnus-tmp-group-name gnus-tmp-article-number gnus-tmp-subject))
+ (format "Gnus %s/%d %s" gnus-tmp-group-name
+ gnus-tmp-article-number gnus-tmp-subject))
(defvar gnus-article-mode-line-format-spec
(gnus-byte-code 'gnus-article-mode-line-format-spec))
(summary-dummy . "* : : %S\n")
(summary . "%U%R%z%I%(%[%4L: %-20,20n%]%) %s\n")))
-;;; Phew. All that gruft is over, fortunately. Perhaps one should
-;;; hand-optimize the functions above, though.
+;;; Phew. All that gruft is over, fortunately.
(defvar gnus-summary-mark-positions nil)
(defvar gnus-group-mark-positions nil)
(setq keymap (car (memq 'keymap function)))
(setq function (car function)))
(autoload function (car package) nil interactive keymap)))
- (if (eq (cadr package) ':interactive)
+ (if (eq (nth 1 package) ':interactive)
(cdddr package)
(cdr package)))))
'(("metamail" metamail-buffer)
("nnsoup" nnsoup-pack-replies)
("gnus-mh" gnus-mh-mail-setup gnus-summary-save-article-folder
gnus-Folder-save-name gnus-folder-save-name)
- ("gnus-mh" :interactive t gnus-mh-save-in-folder)
+ ("gnus-mh" :interactive t gnus-summary-save-in-folder)
("gnus-vis" gnus-group-make-menu-bar gnus-summary-make-menu-bar
gnus-server-make-menu-bar gnus-article-make-menu-bar
gnus-browse-make-menu-bar gnus-highlight-selected-summary
("gnus-demon" :interactive t
gnus-demon-init gnus-demon-cancel)
("gnus-nocem" gnus-nocem-scan-groups gnus-nocem-close)
- ("gnus-srvr" gnus-server-enter-setup-buffer)
+ ("gnus-srvr" gnus-enter-server-buffer gnus-server-set-info)
("gnus-cite" :interactive t
gnus-article-highlight-citation gnus-article-hide-citation-maybe
gnus-article-hide-citation)
gnus-current-score-file-nondirectory gnus-score-adaptive
gnus-score-find-trace gnus-score-file-name)
("gnus-edit" :interactive t gnus-score-customize)
- ("gnus-topic" gnus-topic-fold gnus-group-prepare-topics)
- ("gnus-topic" :interactive t
- gnus-group-add-to-topic gnus-topic-toggle-topic)
+ ("gnus-topic" :interactive t gnus-topic-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-sendmail-setup-mail gnus-article-mail
gnus-inews-message-id)
("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-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-vm" gnus-vm-mail-setup)
("gnus-vm" :interactive t gnus-summary-save-in-vm
gnus-summary-save-article-vm gnus-yank-article))))
(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 ((GnusStartBufferWindow (selected-window)))
+ (unwind-protect
+ (progn
+ (pop-to-buffer ,buffer)
+ ,@forms)
+ (select-window GnusStartBufferWindow))))
(defmacro gnus-gethash (string hashtable)
"Get hash value of STRING in HASHTABLE."
- (` (symbol-value (intern-soft (, string) (, hashtable)))))
+ `(symbol-value (intern-soft ,string ,hashtable)))
(defmacro gnus-sethash (string value hashtable)
"Set hash value. Arguments are STRING, VALUE, and HASHTABLE."
- (` (set (intern (, string) (, hashtable)) (, value))))
+ `(set (intern ,string ,hashtable) ,value))
(defmacro gnus-intern-safe (string hashtable)
"Set hash value. Arguments are STRING, VALUE, and HASHTABLE."
(setq symbol nil))
symbol))
+(defmacro gnus-group-unread (group)
+ "Get the currently computed number of unread articles in GROUP."
+ `(car (gnus-gethash ,group gnus-newsrc-hashtb)))
+
(defmacro gnus-active (group)
"Get active info on GROUP."
`(gnus-gethash ,group gnus-active-hashtb))
(and point (goto-char point)))
(defmacro gnus-buffer-exists-p (buffer)
- (` (and (, buffer)
- (funcall (if (stringp (, buffer)) 'get-buffer 'buffer-name)
- (, buffer)))))
+ `(and ,buffer
+ (funcall (if (stringp ,buffer) 'get-buffer 'buffer-name)
+ ,buffer)))
(defmacro gnus-kill-buffer (buffer)
- (` (if (gnus-buffer-exists-p (, buffer))
- (kill-buffer (, buffer)))))
+ `(let ((buf ,buffer))
+ (if (gnus-buffer-exists-p buf)
+ (kill-buffer buf))))
(defsubst gnus-point-at-bol ()
"Return point at the beginning of the line."
(defmacro gnus-info-set-group (info group)
`(setcar ,info ,group))
(defmacro gnus-info-set-rank (info rank)
- `(setcar (cdr ,info) ,rank))
+ `(setcar (nthcdr 1 ,info) ,rank))
(defmacro gnus-info-set-read (info read)
- `(setcar (cddr ,info) ,read))
+ `(setcar (nthcdr 2 ,info) ,read))
(defmacro gnus-info-set-marks (info marks)
- `(setcar (cdddr ,info) ,marks))
+ `(setcar (nthcdr 3 ,info) ,marks))
(defmacro gnus-info-set-method (info method)
- `(setcar (cddddr ,info) ,method))
+ `(setcar (nthcdr 4 ,info) ,method))
(defmacro gnus-info-set-params (info params)
- `(setcar (cdddddr ,info) ,params))
+ `(setcar (nthcdr 5 ,info) ,params))
(defmacro gnus-info-set-level (info level)
`(let ((rank (cdr ,info)))
(point-max)))
(goto-char (point-min)))
-(defun gnus-update-format-specifications ()
+;;;###autoload
+(defun gnus-update-format (var)
+ "Update the format specification near point."
+ (interactive
+ (list
+ (save-excursion
+ (eval-defun nil)
+ ;; Find the end of the current word.
+ (re-search-forward "[ \t\n]" nil t)
+ ;; Search backward.
+ (when (re-search-backward "\\(gnus-[-a-z]+-line-format\\)" nil t)
+ (match-string 1)))))
+ (set
+ (intern (format "%s-spec" var))
+ (gnus-parse-format (symbol-value (intern var))
+ (symbol-value (intern (format "%s-alist" var)))
+ (not (string-match "mode" var))))
+ (pop-to-buffer "*Gnus Format*")
+ (erase-buffer)
+ (lisp-interaction-mode)
+ (insert (pp-to-string (symbol-value (intern (format "%s-spec" var))))))
+
+
+(defun gnus-update-format-specifications (&optional force)
(gnus-make-thread-indent-array)
+ (when force
+ (setq gnus-old-specs nil))
+
(let ((formats '(summary summary-dummy group
summary-mode group-mode article-mode))
old-format new-format)
pos)
(gnus-set-work-buffer)
(gnus-summary-insert-line
- nil [0 "" "" "" "" "" 0 0 ""] 0 nil 128 t nil "" nil 1)
+ [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)))))
(gnus-group-marked '("dummy.group")))
(gnus-set-active "dummy.group" '(0 . 0))
(gnus-set-work-buffer)
- (gnus-group-insert-group-line nil "dummy.group" 0 nil 0 nil)
+ (gnus-group-insert-group-line "dummy.group" 0 nil 0 nil)
(goto-char (point-min))
(setq gnus-group-mark-positions
(list (cons 'process (and (search-forward "\200" nil t)
(- (point) 2))))))))
-(defun gnus-mouse-face-function (form)
- (` (put-text-property
- (point) (progn (insert (, form)) (point))
- ,gnus-mouse-face-prop gnus-mouse-face)))
+(defvar gnus-mouse-face-0 'highlight)
+(defvar gnus-mouse-face-1 'highlight)
+(defvar gnus-mouse-face-2 'highlight)
+(defvar gnus-mouse-face-3 'highlight)
+(defvar gnus-mouse-face-4 'highlight)
+
+(defun gnus-mouse-face-function (form type)
+ `(put-text-property
+ (point) (progn ,@form (point))
+ gnus-mouse-face-prop
+ ,(if (equal type 0)
+ 'gnus-mouse-face
+ `(quote ,(symbol-value (intern (format "gnus-mouse-face-%d" type)))))))
+
+(defvar gnus-face-0 'bold)
+(defvar gnus-face-1 'italic)
+(defvar gnus-face-2 'bold-italic)
+(defvar gnus-face-3 'bold)
+(defvar gnus-face-4 'bold)
+
+(defun gnus-face-face-function (form type)
+ `(put-text-property
+ (point) (progn ,@form (point))
+ 'face ',(symbol-value (intern (format "gnus-face-%d" type)))))
(defun gnus-max-width-function (el max-width)
(or (numberp max-width) (signal 'wrong-type-argument '(numberp max-width)))
- (` (let ((val (eval (, el))))
+ (if (symbolp el)
+ `(if (> (length ,el) ,max-width)
+ (substring ,el 0 ,max-width)
+ ,el)
+ `(let ((val (eval ,el)))
(if (numberp val)
(setq val (int-to-string val)))
- (if (> (length val) (, max-width))
- (substring val 0 (, max-width))
- val))))
+ (if (> (length val) ,max-width)
+ (substring val 0 ,max-width))
+ val)))
(defun gnus-parse-format (format spec-alist &optional insert)
;; This function parses the FORMAT string with the help of the
;; SPEC-ALIST and returns a list that can be eval'ed to return the
;; string. If the FORMAT string contains the specifiers %( and %)
;; the text between them will have the mouse-face text property.
- (let (did-insert result)
- (setq result
- (if (string-match "\\`\\(.*\\)%(\\(.*\\)%)\\(.*\n?\\)\\'" format)
- ;; This is a complex that should have mouse-face set on
- ;; parts of the format.
- (if (and gnus-visual gnus-mouse-face)
- (let ((pre (substring format (match-beginning 1)
- (match-end 1)))
- (button (substring format (match-beginning 2)
- (match-end 2)))
- (post (substring format (match-beginning 3)
- (match-end 3))))
- (if (not insert)
- (list 'concat
- (gnus-parse-simple-format pre spec-alist)
- (gnus-mouse-face-function
- (gnus-parse-simple-format button spec-alist))
- (gnus-parse-simple-format post spec-alist))
- (setq did-insert t)
- ;; So here we want mouse face and insert.
- (list 'progn
- (list 'insert
- (gnus-parse-simple-format pre spec-alist))
- (gnus-mouse-face-function
- (gnus-parse-simple-format button spec-alist))
- (list 'insert
- (gnus-parse-simple-format
- post spec-alist)))))
- ;; We don't want faces.
- (gnus-parse-simple-format
- (concat (substring format (match-beginning 1) (match-end 1))
- (substring format (match-beginning 2) (match-end 2))
- (substring format (match-beginning 3) (match-end 3)))
- spec-alist))
- ;; This is a simple format.
- (gnus-parse-simple-format format spec-alist)))
- (if (and insert (not did-insert))
- (list 'insert result)
- result)))
+ (if (string-match
+ "\\`\\(.*\\)%[0-9]?[[(]\\(.*\\)%[0-9]?[])]\\(.*\n?\\)\\'"
+ format)
+ (gnus-parse-complex-format format spec-alist)
+ ;; This is a simple format.
+ (gnus-parse-simple-format format spec-alist insert)))
+
+(defun gnus-parse-complex-format (format spec-alist)
+ (save-excursion
+ (gnus-set-work-buffer)
+ (insert format)
+ (goto-char (point-min))
+ (while (re-search-forward "\"" nil t)
+ (replace-match "\\\"" nil t))
+ (goto-char (point-min))
+ (insert "(\"")
+ (while (re-search-forward "%\\([0-9]+\\)?\\([][()]\\)" nil t)
+ (let ((number (if (match-beginning 1)
+ (match-string 1) "0"))
+ (delim (aref (match-string 2) 0)))
+ (if (or (= delim ?\() (= delim ?\[))
+ (replace-match (concat "\"(" (if (= delim ?\() "mouse" "face")
+ " " number " \""))
+ (replace-match "\")\""))))
+ (goto-char (point-max))
+ (insert "\")")
+ (goto-char (point-min))
+ (let ((form (read (current-buffer))))
+ (cons 'progn (gnus-complex-form-to-spec form spec-alist)))))
-(defun gnus-parse-simple-format (format spec-alist)
+(defun gnus-complex-form-to-spec (form spec-alist)
+ (delq nil
+ (mapcar
+ (lambda (sform)
+ (if (stringp sform)
+ (gnus-parse-simple-format sform spec-alist t)
+ (funcall (intern (format "gnus-%s-face-function"
+ (car sform)))
+ (gnus-complex-form-to-spec
+ (cdr (cdr sform)) spec-alist)
+ (nth 1 sform))))
+ form)))
+
+(defun gnus-parse-simple-format (format spec-alist &optional insert)
;; This function parses the FORMAT string with the help of the
- ;; SPEC-ALIST and returns a list that can be eval'ed to return the
- ;; string. The list will consist of the symbol `format', a format
- ;; specification string, and a list of forms depending on the
- ;; SPEC-ALIST.
+ ;; SPEC-ALIST and returns a list that can be eval'ed to return a
+ ;; string.
(let ((max-width 0)
- spec flist fstring newspec elem beg)
+ spec flist fstring newspec elem beg result dontinsert)
(save-excursion
(gnus-set-work-buffer)
(insert format)
(setq max-width 0)
(setq beg (match-beginning 2)))
;; Find the specification from `spec-alist'.
- (if (not (setq elem (cdr (assq spec spec-alist))))
- (setq elem '("*" ?s)))
- ;; Treat user defined format specifiers specially
- (and (eq (car elem) 'gnus-tmp-user-defined)
- (setq elem
- (list
- (list (intern (concat "gnus-user-format-function-"
- (match-string 3)))
- 'gnus-tmp-header)
- ?s))
- (delete-region (match-beginning 3) (match-end 3)))
+ (unless (setq elem (cdr (assq spec spec-alist)))
+ (setq elem '("*" ?s)))
+ ;; Treat user defined format specifiers specially.
+ (when (eq (car elem) 'gnus-tmp-user-defined)
+ (setq elem
+ (list
+ (list (intern (concat "gnus-user-format-function-"
+ (match-string 3)))
+ 'gnus-tmp-header) ?s))
+ (delete-region (match-beginning 3) (match-end 3)))
(if (not (zerop max-width))
(let ((el (car elem)))
(cond ((= (car (cdr elem)) ?c)
(goto-char beg)
(insert newspec))
(setq fstring (buffer-substring 1 (point-max))))
- (cons 'format (cons fstring (nreverse flist)))))
+ ;; Do some postprocessing to increase efficiency.
+ (setq
+ result
+ (cond
+ ;; Emptyness.
+ ((string= fstring "")
+ nil)
+ ;; Not a format string.
+ ((not (string-match "%" fstring))
+ (list fstring))
+ ;; A format string with just a single string spec.
+ ((string= fstring "%s")
+ (list (car flist)))
+ ;; A single character.
+ ((string= fstring "%c")
+ (list (car flist)))
+ ;; A single number.
+ ((string= fstring "%d")
+ (setq dontinsert)
+ (if insert
+ (list `(princ ,(car flist)))
+ (list `(int-to-string ,(car flist)))))
+ ;; Just lots of chars and strings.
+ ((string-match "\\`\\(%[cs]\\)+\\'" fstring)
+ (nreverse flist))
+ ;; A single string spec at the beginning of the spec.
+ ((string-match "\\`%[sc][^%]+\\'" fstring)
+ (list (car flist) (substring fstring 2)))
+ ;; A single string spec in the middle of the spec.
+ ((string-match "\\`\\([^%]+\\)%[sc]\\([^%]+\\)\\'" fstring)
+ (list (match-string 1 fstring) (car flist) (match-string 2 fstring)))
+ ;; A single string spec in the end of the spec.
+ ((string-match "\\`\\([^%]+\\)%[sc]\\'" fstring)
+ (list (match-string 1 fstring) (car flist)))
+ ;; A more complex spec.
+ (t
+ (list (cons 'format (cons fstring (nreverse flist)))))))
+
+ (if insert
+ (when result
+ (if dontinsert
+ result
+ (cons 'insert result)))
+ (or (car result) ""))))
(defun gnus-set-work-buffer ()
(if (get-buffer gnus-work-buffer)
(defun gnus-group-quit-config (group)
"Return the quit-config of GROUP."
- (cdr (assoc 'quit-config (gnus-find-method-for-group group))))
+ (nth 1 (assoc 'quit-config (gnus-find-method-for-group group))))
;;; List and range functions
(setq ranges (cdr ranges)))
(not not-stop))))
+(defun gnus-range-length (range)
+ "Return the length RANGE would have if uncompressed."
+ (length (gnus-uncompress-range range)))
+
(defun gnus-sublist-p (list sublist)
"Test whether all elements in SUBLIST are members of LIST."
(let ((sublistp t))
(define-key gnus-group-mode-map ">" 'end-of-buffer)
(define-key gnus-group-mode-map "\C-c\C-b" 'gnus-bug)
(define-key gnus-group-mode-map "\C-c\C-s" 'gnus-group-sort-groups)
+ (define-key gnus-group-mode-map "t" 'gnus-topic-mode)
(define-key gnus-group-mode-map "#" 'gnus-group-mark-group)
(define-key gnus-group-mode-map "\M-#" 'gnus-group-unmark-group)
(define-key gnus-group-group-map "f" 'gnus-group-make-doc-group)
(define-key gnus-group-group-map "r" 'gnus-group-rename-group)
(define-key gnus-group-group-map "\177" 'gnus-group-delete-group)
- (define-key gnus-group-group-map "t" 'gnus-group-add-to-topic)
(define-prefix-command 'gnus-group-soup-map)
(define-key gnus-group-group-map "s" 'gnus-group-soup-map)
(define-key gnus-group-list-map "d" 'gnus-group-description-apropos)
(define-key gnus-group-list-map "m" 'gnus-group-list-matching)
(define-key gnus-group-list-map "M" 'gnus-group-list-all-matching)
- (define-key gnus-group-list-map "t" 'gnus-topic-toggle-topic)
(define-prefix-command 'gnus-group-score-map)
(define-key gnus-group-mode-map "W" 'gnus-group-score-map)
\\{gnus-group-mode-map}"
(interactive)
- (if (gnus-visual-p 'group-menu 'menu) (gnus-group-make-menu-bar))
+ (when (and menu-bar-mode
+ (gnus-visual-p 'group-menu 'menu))
+ (gnus-group-make-menu-bar))
(kill-all-local-variables)
(setq mode-line-modified "-- ")
(make-local-variable 'mode-line-format)
(or level gnus-group-default-list-level gnus-level-subscribed))))
-(defvar gnus-tmp-prev-perm nil)
-
;;;###autoload
(defun gnus-no-server (&optional arg)
"Read network news.
prompt the user for the name of an NNTP server to use.
As opposed to `gnus', this command will not connect to the local server."
(interactive "P")
- (let ((perm
- (cons gnus-group-use-permanent-levels gnus-group-default-list-level)))
- (setq gnus-tmp-prev-perm nil)
- (setq gnus-group-use-permanent-levels t)
- (gnus (or arg (1- gnus-level-default-subscribed)) t)
- (setq gnus-tmp-prev-perm perm)))
+ (make-local-variable gnus-group-use-permanent-levels)
+ (setq gnus-group-use-permanent-levels t)
+ (gnus (or arg (1- gnus-level-default-subscribed)) t))
;;;###autoload
(defun gnus-slave (&optional arg)
(gnus-clear-system)
(nnheader-init-server-buffer)
- ;; We do this if `gnus-no-server' has been run.
- (if gnus-tmp-prev-perm
- (setq gnus-group-use-permanent-levels (car gnus-tmp-prev-perm)
- gnus-group-default-list-level (cdr gnus-tmp-prev-perm)
- gnus-tmp-prev-perm nil))
+
(gnus-read-init-file)
(setq gnus-slave slave)
(let ((buffer-read-only nil)
(newsrc (cdr gnus-newsrc-alist))
(lowest (or lowest 1))
- info clevel unread group)
+ info clevel unread group params)
(erase-buffer)
(if (< lowest gnus-level-zombie)
;; List living groups.
(while newsrc
(setq info (car newsrc)
group (gnus-info-group info)
+ params (gnus-info-params info)
newsrc (cdr newsrc)
unread (car (gnus-gethash group gnus-newsrc-hashtb)))
(and unread ; This group might be bogus
(or all ; We list all groups?
(eq unread t) ; We list unactivated groups
(> unread 0) ; We list groups with unread articles
- (cdr (assq 'tick (gnus-info-marks info))))
+ (cdr (assq 'tick (gnus-info-marks info)))
; And groups with tickeds
+ ;; Check for permanent visibility.
+ (and gnus-permanently-visible-groups
+ (string-match gnus-permanently-visible-groups
+ group))
+ (memq 'visible params)
+ (cdr (assq 'visible params)))
(gnus-group-insert-group-line
- nil group (gnus-info-level info)
+ group (gnus-info-level info)
(gnus-info-marks info) unread (gnus-info-method info)))))
;; List dead groups.
"Say whether the group is secondary or not."
(gnus-secondary-method-p (gnus-find-method-for-group group)))
-(defun gnus-group-topic-p ()
- "Return non-nil if the current line is a topic."
- (get-text-property (gnus-point-at-bol) 'gnus-topic))
-
(defun gnus-group-get-parameter (group &optional symbol)
"Returns the group parameters for GROUP.
If SYMBOL, return the value of that symbol in the group parameters."
gnus-newsrc-hashtb))
(part-info info)
(info (if method-only-group (nth 2 entry) info)))
- (if (not method-only-group)
- ()
- (or entry
- (error "Trying to change non-existent group %s" method-only-group))
+ (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
;; select method or the group parameters. We first check
;; whether we have to extend the info, and if so, do that.
(let ((len (length info))
(total (if (eq part 'method) 5 6)))
- (and (< len total)
- (setcdr (nthcdr (1- len) info)
- (make-list (- total len) nil)))
+ (when (< len total)
+ (setcdr (nthcdr (1- len) info)
+ (make-list (- total len) nil)))
;; Then we enter the new info.
(setcar (nthcdr (1- total) info) part-info)))
- ;; We uncompress some lists of marked articles.
- (let (marked)
- (if (not (setq marked (gnus-info-marks info)))
- ()
- (while marked
- (or (eq 'score (car (car marked)))
- (eq 'bookmark (car (car marked)))
- (eq 'killed (car (car marked)))
- (setcdr (car marked)
- (gnus-uncompress-range (cdr (car marked)))))
- (setq marked (cdr marked)))))
- (if entry
- ()
+ (unless entry
;; This is a new group, so we just create it.
(save-excursion
(set-buffer gnus-group-buffer)
(if entry
(progn
(setcar (nthcdr 2 entry) info)
- (if (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)))))))
+ (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)))))))
(error "No such group: %s" (gnus-info-group info)))))
(defun gnus-group-set-method-info (group select-method)
;; (Un)subscribed group.
(setq info (nth 2 entry))
(gnus-group-insert-group-line
- nil group (gnus-info-level info) (gnus-info-marks info)
- (car entry) (gnus-info-method info)))
+ group (gnus-info-level info) (gnus-info-marks info)
+ (or (car entry) t) (gnus-info-method info)))
;; This group is dead.
(gnus-group-insert-group-line
- nil group
+ group
(if (member group gnus-zombie-list) gnus-level-zombie gnus-level-killed)
nil
(if (setq active (gnus-active group))
nil))))
(defun gnus-group-insert-group-line
- (gformat gnus-tmp-group gnus-tmp-level gnus-tmp-marked gnus-tmp-number
- gnus-tmp-method)
- (let* ((gformat (or gformat gnus-group-line-format-spec))
- (gnus-tmp-active (gnus-active gnus-tmp-group))
+ (gnus-tmp-group gnus-tmp-level gnus-tmp-marked gnus-tmp-number
+ gnus-tmp-method)
+ (let* ((gnus-tmp-active (gnus-active gnus-tmp-group))
(gnus-tmp-number-total
(if gnus-tmp-active
(1+ (- (cdr gnus-tmp-active) (car gnus-tmp-active)))
0))
- (gnus-tmp-number-of-dormant
- (length (cdr (assq 'dormant gnus-tmp-marked))))
- (gnus-tmp-number-of-ticked
- (length (cdr (assq 'tick gnus-tmp-marked))))
- (gnus-tmp-number-of-ticked-and-dormant
- (+ gnus-tmp-number-of-ticked gnus-tmp-number-of-dormant))
- (gnus-tmp-number-of-unread-unticked
+ (gnus-tmp-number-of-unread
(if (numberp gnus-tmp-number) (int-to-string (max 0 gnus-tmp-number))
"*"))
(gnus-tmp-number-of-read
(gnus-tmp-marked
(if (and (numberp gnus-tmp-number)
(zerop gnus-tmp-number)
- (> gnus-tmp-number-of-ticked 0))
+ (cdr (assq 'tick gnus-tmp-marked)))
?* ? ))
(gnus-tmp-number
(if (eq gnus-tmp-number t) "*"
- (+ gnus-tmp-number gnus-tmp-number-of-dormant
- gnus-tmp-number-of-ticked)))
+ gnus-tmp-number))
(gnus-tmp-process-marked
(if (member gnus-tmp-group gnus-group-marked)
gnus-process-mark ? ))
(beginning-of-line)
(setq b (point))
;; Insert the text.
- (eval gformat)
+ (eval gnus-group-line-format-spec)
(add-text-properties
b (1+ b) (list 'gnus-group (gnus-intern-safe
gnus-tmp-group gnus-active-hashtb)
'gnus-unread (if (numberp gnus-tmp-number)
(string-to-int
- gnus-tmp-number-of-unread-unticked)
+ gnus-tmp-number-of-unread)
t)
'gnus-marked gnus-tmp-marked
'gnus-level gnus-tmp-level))))
;; Return a list of groups to work on. Take into consideration N (the
;; prefix) and the list of marked groups.
(defun gnus-group-process-prefix (n)
- (cond (n
- (setq n (prefix-numeric-value n))
- ;; There is a prefix, so we return a list of the N next
- ;; groups.
- (let ((way (if (< n 0) -1 1))
- (n (abs n))
- group groups)
- (save-excursion
- (while (and (> n 0)
- (setq group (gnus-group-group-name)))
- (setq groups (cons group groups))
- (setq n (1- n))
- (forward-line way)))
- (nreverse groups)))
- (gnus-group-marked
- ;; No prefix, but a list of marked articles.
- (reverse gnus-group-marked))
- (t
- ;; Neither marked articles or a prefix, so we return the
- ;; current group.
- (let ((group (gnus-group-group-name)))
- (and group (list group))))))
+ (cond
+ (n
+ (setq n (prefix-numeric-value n))
+ ;; There is a prefix, so we return a list of the N next
+ ;; groups.
+ (let ((way (if (< n 0) -1 1))
+ (n (abs n))
+ group groups)
+ (save-excursion
+ (while (and (> n 0)
+ (setq group (gnus-group-group-name)))
+ (setq groups (cons group groups))
+ (setq n (1- n))
+ (gnus-group-next-group way)))
+ (nreverse groups)))
+ ((and (boundp 'transient-mark-mode) transient-mark-mode
+ mark-active)
+ ;; Work on the region between point and mark.
+ (let ((max (max (point) (mark)))
+ groups)
+ (save-excursion
+ (goto-char (min (point) (mark)))
+ (while
+ (and
+ (push (gnus-group-group-name) groups)
+ (zerop (gnus-group-next-group 1))
+ (< (point) max)))
+ (nreverse groups))))
+ (gnus-group-marked
+ ;; No prefix, but a list of marked articles.
+ (reverse gnus-group-marked))
+ (t
+ ;; Neither marked articles or a prefix, so we return the
+ ;; current group.
+ (let ((group (gnus-group-group-name)))
+ (and group (list group))))))
;; Selecting groups.
auto-selected upon group entry. If GROUP is non-nil, fetch that
group."
(interactive "P")
- (if (gnus-group-topic-p)
- (gnus-topic-fold) ; This is a topic line.
- ;; And this is a real group.
- (let ((group (or group (gnus-group-group-name)))
- number active marked entry)
- (or group (error "No group on current line"))
- (setq marked (nth 3 (nth 2 (setq entry (gnus-gethash
- group gnus-newsrc-hashtb)))))
- ;; This group might be a dead group. In that case we have to get
- ;; the number of unread articles from `gnus-active-hashtb'.
- (setq number
- (cond ((numberp all) all)
- (entry (car entry))
- ((setq active (gnus-active group))
- (- (1+ (cdr active)) (car active)))))
- (gnus-summary-read-group
- group (or all (and (numberp number)
- (zerop (+ number (length (cdr (assq 'tick marked)))
- (length (cdr (assq 'dormant marked)))))))
- no-article))))
+ (let ((group (or group (gnus-group-group-name)))
+ number active marked entry)
+ (or group (error "No group on current line"))
+ (setq marked (nth 3 (nth 2 (setq entry (gnus-gethash
+ group gnus-newsrc-hashtb)))))
+ ;; This group might be a dead group. In that case we have to get
+ ;; the number of unread articles from `gnus-active-hashtb'.
+ (setq number
+ (cond ((numberp all) all)
+ (entry (car entry))
+ ((setq active (gnus-active group))
+ (- (1+ (cdr active)) (car active)))))
+ (gnus-summary-read-group
+ group (or all (and (numberp number)
+ (zerop (+ number (length (cdr (assq 'tick marked)))
+ (length (cdr (assq 'dormant marked)))))))
+ no-article)))
(defun gnus-group-select-group (&optional all)
"Select this newsgroup.
(defun gnus-group-enter-server-mode ()
"Jump to the server buffer."
(interactive)
- (gnus-server-enter-setup-buffer))
+ (gnus-enter-server-buffer))
(defun gnus-group-make-group (name &optional method address)
"Add a new newsgroup.
";; Type `C-c C-c' after editing the group parameters.\n\n")
((eq part 'info)
";; Type `C-c C-c' after editing the group info.\n\n")))
- (let ((cinfo (gnus-copy-sequence info))
- marked)
- (if (not (setq marked (gnus-info-marks cinfo)))
- ()
- (while marked
- (or (eq 'score (car (car marked)))
- (eq 'bookmark (car (car marked)))
- (eq 'killed (car (car marked)))
- (not (numberp (car (cdr (car marked)))))
- (setcdr (car marked)
- (gnus-compress-sequence (sort (cdr (car marked)) '<) t)))
- (setq marked (cdr marked))))
- (insert
- (pp-to-string
- (cond ((eq part 'method)
- (or (gnus-info-method info) "native"))
- ((eq part 'params)
- (gnus-info-params info))
- (t
- cinfo)))
- "\n"))))
+ (insert
+ (pp-to-string
+ (cond ((eq part 'method)
+ (or (gnus-info-method info) "native"))
+ ((eq part 'params)
+ (gnus-info-params info))
+ (t info)))
+ "\n")))
(defun gnus-group-edit-group-method (group)
"Edit the select method of GROUP."
"Create a group that uses a single file as the source."
(interactive
(list (read-file-name "File name: ")
- (let ((err "")
- found char)
- (while (not found)
- (message "%sFile type (mbox, babyl, digest) [mbd]: " err)
- (setq found (cond ((= (setq char (read-char)) ?m) 'mbox)
- ((= char ?b) 'babyl)
- ((= char ?d) 'digest)
- (t (setq err (format "%c unknown. " char))
- nil))))
- found)))
+ (and current-prefix-arg 'ask)))
+ (when (eq type 'ask)
+ (let ((err "")
+ char found)
+ (while (not found)
+ (message
+ "%sFile type (mbox, babyl, digest, forward, mmfd, guess) [mbdfag]: "
+ err)
+ (setq found (cond ((= (setq char (read-char)) ?m) 'mbox)
+ ((= char ?b) 'babyl)
+ ((= char ?d) 'digest)
+ ((= char ?f) 'forward)
+ ((= char ?a) 'mmfd)
+ (t (setq err (format "%c unknown. " char))
+ nil))))
+ (setq type found)))
(let* ((file (expand-file-name file))
(name (gnus-generate-new-group-name
(gnus-group-prefixed-name
(gnus-group-real-name name)
(list 'nndoc name
(list 'nndoc-address file)
- (list 'nndoc-article-type type)))
+ (list 'nndoc-article-type (or type 'guess))))
(forward-line -1)
(gnus-group-position-point)))
;; Group sorting commands
;; Suggested by Joe Hildebrand <hildjj@idaho.fuentez.com>.
-(defun gnus-group-sort-groups (&optional func)
- "Sort the group buffer according to `gnus-group-sort-function'."
- (interactive)
- (let ((funcs
- (cond (func (list func))
- ((listp gnus-group-sort-function) gnus-group-sort-function)
- (t list gnus-group-sort-function))))
- ;; We peel off the dummy group off the alist.
- (and (equal (car (car gnus-newsrc-alist)) "dummy.group")
- (setq gnus-newsrc-alist (cdr gnus-newsrc-alist)))
- ;; Do the sorting.
- (while funcs
- (setq gnus-newsrc-alist
- (sort gnus-newsrc-alist (car funcs)))
- (setq funcs (cdr funcs))))
+(defun gnus-group-sort-groups (func &optional reverse)
+ "Sort the group buffer according to FUNC.
+If REVERSE, reverse the sorting order."
+ (interactive (list gnus-group-sort-function
+ current-prefix-arg))
+ (unless (listp func)
+ (setq func (list 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.
+ (while func
+ (setq gnus-newsrc-alist
+ (sort gnus-newsrc-alist (pop 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 ()
- "Sort the group buffer alphabetically by group name."
- (interactive)
- (gnus-group-sort-groups 'gnus-group-sort-by-alphabet))
+(defun gnus-group-sort-groups-by-alphabet (&optional reverse)
+ "Sort the group buffer alphabetically by group name.
+If REVERSE, sort in reverse order."
+ (interactive "P")
+ (gnus-group-sort-groups 'gnus-group-sort-by-alphabet reverse))
-(defun gnus-group-sort-groups-by-unread ()
- "Sort the group buffer by unread articles."
- (interactive)
- (gnus-group-sort-groups 'gnus-group-sort-by-unread))
+(defun gnus-group-sort-groups-by-unread (&optional reverse)
+ "Sort the group buffer by number of unread articles.
+If REVERSE, sort in reverse order."
+ (interactive "P")
+ (gnus-group-sort-groups 'gnus-group-sort-by-unread reverse))
-(defun gnus-group-sort-groups-by-level ()
- "Sort the group buffer by group level."
- (interactive)
- (gnus-group-sort-groups 'gnus-group-sort-by-level))
+(defun gnus-group-sort-groups-by-level (&optional reverse)
+ "Sort the group buffer by group level.
+If REVERSE, sort in reverse order."
+ (interactive "P")
+ (gnus-group-sort-groups 'gnus-group-sort-by-level reverse))
-(defun gnus-group-sort-groups-by-score ()
- "Sort the group buffer by group score."
- (interactive)
- (gnus-group-sort-groups 'gnus-group-sort-by-score))
+(defun gnus-group-sort-groups-by-score (&optional reverse)
+ "Sort the group buffer by group score.
+If REVERSE, sort in reverse order."
+ (interactive "P")
+ (gnus-group-sort-groups 'gnus-group-sort-by-score reverse))
-(defun gnus-group-sort-groups-by-rank ()
- "Sort the group buffer by group rank."
- (interactive)
- (gnus-group-sort-groups 'gnus-group-sort-by-rank))
+(defun gnus-group-sort-groups-by-rank (&optional reverse)
+ "Sort the group buffer by group rank.
+If REVERSE, sort in reverse order."
+ (interactive "P")
+ (gnus-group-sort-groups 'gnus-group-sort-by-rank reverse))
-(defun gnus-group-sort-groups-by-method ()
- "Sort the group buffer alphabetically by backend name."
- (interactive)
- (gnus-group-sort-groups 'gnus-group-sort-by-method))
+(defun gnus-group-sort-groups-by-method (&optional reverse)
+ "Sort the group buffer alphabetically by backend name.
+If REVERSE, sort in reverse order."
+ (interactive "P")
+ (gnus-group-sort-groups 'gnus-group-sort-by-method reverse))
(defun gnus-group-sort-by-alphabet (info1 info2)
"Sort alphabetically."
(if (not (numberp (car entry)))
(gnus-message 1 "Can't catch up; non-active group")
;; Do the updating only if the newsgroup isn't killed.
- (if (not entry)
- ()
- (gnus-update-read-articles
- group nil nil (and (not all) (cdr (assq 'tick marked))))
- (and all
- (setq marked (nth 3 (nth 2 entry)))
- (setcar (nthcdr 3 (nth 2 entry))
- (delq (assq 'dormant marked)
- (nth 3 (nth 2 entry)))))))
- num))
+ (when entry
+ (gnus-update-read-articles group nil)
+ ;; Also nix out the lists of marks and dormants.
+ (when all
+ (gnus-add-marked-articles group 'tick nil nil 'force)
+ (gnus-add-marked-articles group 'dormant nil nil 'force))
+ num))))
(defun gnus-group-expire-articles (&optional n)
"Expire all expirable articles in the current newsgroup."
(gnus-group-kill-group lines)))
(defun gnus-group-kill-group (&optional n discard)
- "The the next N groups.
+ "Kill the next N groups.
The killed newsgroups can be yanked by using \\[gnus-group-yank-group].
However, only groups that were alive can be yanked; already killed
groups or zombie groups can't be yanked.
(gnus-group-list-matching (or level gnus-level-killed) regexp t lowest))
;; Suggested by Jack Vinson <vinson@unagi.cis.upenn.edu>.
-(defun gnus-group-save-newsrc ()
- "Save the Gnus startup files."
- (interactive)
- (gnus-save-newsrc-file))
+(defun gnus-group-save-newsrc (&optional force)
+ "Save the Gnus startup files.
+If FORCE, force saving whether it is necessary or not."
+ (interactive "P")
+ (gnus-save-newsrc-file force))
(defun gnus-group-restart (&optional arg)
"Force Gnus to read the .newsrc file."
"Quit reading news without updating .newsrc.eld or .newsrc.
The hook `gnus-exit-gnus-hook' is called before actually exiting."
(interactive)
- (if (or noninteractive ;For gnus-batch-kill
- (zerop (buffer-size))
- (not (gnus-server-opened gnus-select-method))
- gnus-expert-user
- (not gnus-current-startup-file)
- (gnus-yes-or-no-p
- (format "Quit reading news without saving %s? "
- (file-name-nondirectory gnus-current-startup-file))))
- (progn
- (run-hooks 'gnus-exit-gnus-hook)
- (if gnus-use-full-window
- (delete-other-windows)
- (gnus-remove-some-windows))
- (gnus-dribble-save)
- (gnus-close-backends)
- (gnus-clear-system))))
+ (when (or noninteractive ;For gnus-batch-kill
+ (zerop (buffer-size))
+ (not (gnus-server-opened gnus-select-method))
+ gnus-expert-user
+ (not gnus-current-startup-file)
+ (gnus-yes-or-no-p
+ (format "Quit reading news without saving %s? "
+ (file-name-nondirectory gnus-current-startup-file))))
+ (run-hooks 'gnus-exit-gnus-hook)
+ (if gnus-use-full-window
+ (delete-other-windows)
+ (gnus-remove-some-windows))
+ (gnus-dribble-save)
+ (gnus-close-backends)
+ (gnus-clear-system)))
(defun gnus-offer-save-summaries ()
+ "Offer to save all active summary buffers."
(save-excursion
(let ((buflist (buffer-list))
buffers bufname)
+ ;; Go through all buffers and find all summaries.
(while buflist
(and (setq bufname (buffer-name (car buflist)))
(string-match "Summary" bufname)
(save-excursion
(set-buffer bufname)
;; We check that this is, indeed, a summary buffer.
- (eq major-mode 'gnus-summary-mode))
- (setq buffers (cons bufname buffers)))
+ (and (eq major-mode 'gnus-summary-mode)
+ ;; Also make sure this isn't bogus.
+ gnus-newsgroup-prepared))
+ (push bufname buffers))
(setq buflist (cdr buflist)))
- (and buffers
- (map-y-or-n-p
- "Update summary buffer %s? "
- (lambda (buf)
- (set-buffer buf)
- (gnus-summary-exit))
- buffers)))))
+ ;; Go through all these summary buffers and offer to save them.
+ (when buffers
+ (map-y-or-n-p
+ "Update summary buffer %s? "
+ (lambda (buf) (set-buffer buf) (gnus-summary-exit))
+ buffers)))))
(defun gnus-group-describe-briefly ()
"Give a one line description of the group mode commands."
(defvar gnus-browse-buffer "*Gnus Browse Server*")
(defun gnus-browse-foreign-server (method &optional return-buffer)
+ "Browse the server METHOD."
(setq gnus-browse-current-method method)
(setq gnus-browse-return-buffer return-buffer)
(let ((gnus-select-method method)
groups group)
(gnus-message 5 "Connecting to %s..." (nth 1 method))
- (or (gnus-check-server method)
- (error "Unable to contact server: %s" (gnus-status-message method)))
- (or (gnus-request-list method)
- (error "Couldn't request list: %s" (gnus-status-message method)))
- (get-buffer-create gnus-browse-buffer)
- (gnus-add-current-to-buffer-list)
- (and gnus-carpal (gnus-carpal-setup-buffer 'browse))
- (gnus-configure-windows 'browse)
- (buffer-disable-undo (current-buffer))
- (let ((buffer-read-only nil))
- (erase-buffer))
- (gnus-browse-mode)
- (setq mode-line-buffer-identification
- (format
- "Gnus Browse Server {%s:%s}" (car method) (car (cdr method))))
- (save-excursion
- (set-buffer nntp-server-buffer)
- (let ((cur (current-buffer)))
- (goto-char (point-min))
- (or (string= gnus-ignored-newsgroups "")
- (delete-matching-lines gnus-ignored-newsgroups))
- (while (re-search-forward
- "\\(^[^ \t]+\\)[ \t]+[0-9]+[ \t]+[0-9]+" nil t)
- (goto-char (match-end 1))
- (setq groups (cons (cons (match-string 1)
- (max 0 (- (1+ (read cur)) (read cur))))
- groups)))))
- (setq groups (sort groups
- (lambda (l1 l2)
- (string< (car l1) (car l2)))))
- (let ((buffer-read-only nil))
- (while groups
- (setq group (car groups))
- (insert
- (format "K%7d: %s\n" (cdr group) (car group)))
- (setq groups (cdr groups))))
- (switch-to-buffer (current-buffer))
- (goto-char (point-min))
- (gnus-group-position-point)))
+ (cond
+ ((not (gnus-check-server method))
+ (gnus-message
+ 1 "Unable to contact server: %s" (gnus-status-message method))
+ nil)
+ ((not (gnus-request-list method))
+ (gnus-message
+ 1 "Couldn't request list: %s" (gnus-status-message method))
+ nil)
+ (t
+ (get-buffer-create gnus-browse-buffer)
+ (gnus-add-current-to-buffer-list)
+ (and gnus-carpal (gnus-carpal-setup-buffer 'browse))
+ (gnus-configure-windows 'browse)
+ (buffer-disable-undo (current-buffer))
+ (let ((buffer-read-only nil))
+ (erase-buffer))
+ (gnus-browse-mode)
+ (setq mode-line-buffer-identification
+ (format
+ "Gnus Browse Server {%s:%s}" (car method) (car (cdr method))))
+ (save-excursion
+ (set-buffer nntp-server-buffer)
+ (let ((cur (current-buffer)))
+ (goto-char (point-min))
+ (or (string= gnus-ignored-newsgroups "")
+ (delete-matching-lines gnus-ignored-newsgroups))
+ (while (re-search-forward
+ "\\(^[^ \t]+\\)[ \t]+[0-9]+[ \t]+[0-9]+" nil t)
+ (goto-char (match-end 1))
+ (setq groups (cons (cons (match-string 1)
+ (max 0 (- (1+ (read cur)) (read cur))))
+ groups)))))
+ (setq groups (sort groups
+ (lambda (l1 l2)
+ (string< (car l1) (car l2)))))
+ (let ((buffer-read-only nil))
+ (while groups
+ (setq group (car groups))
+ (insert
+ (format "K%7d: %s\n" (cdr group) (car group)))
+ (setq groups (cdr groups))))
+ (switch-to-buffer (current-buffer))
+ (goto-char (point-min))
+ (gnus-group-position-point)
+ t))))
(defun gnus-browse-mode ()
"Major mode for browsing a foreign server.
3) `\\[gnus-browse-exit]' to return to the group buffer."
(interactive)
(kill-all-local-variables)
- (if (gnus-visual-p 'browse-menu 'menu) (gnus-browse-make-menu-bar))
+ (when (and menu-bar-mode
+ (gnus-visual-p 'browse-menu 'menu))
+ (gnus-browse-make-menu-bar))
(setq mode-line-modified "-- ")
(make-local-variable 'mode-line-format)
(setq mode-line-format (copy-sequence mode-line-format))
\\{gnus-summary-mode-map}"
(interactive)
- (if (gnus-visual-p 'summary-menu 'menu) (gnus-summary-make-menu-bar))
+ (when (and menu-bar-mode
+ (gnus-visual-p 'summary-menu 'menu))
+ (gnus-summary-make-menu-bar))
(kill-all-local-variables)
(let ((locals gnus-summary-local-variables))
(while locals
;; Summary data functions.
(defmacro gnus-data-number (data)
- (` (car (, data))))
+ `(car ,data))
(defmacro gnus-data-mark (data)
- (` (nth 1 (, data))))
+ `(nth 1 ,data))
(defmacro gnus-data-set-mark (data mark)
- (` (setcar (nthcdr 1 (, data)) (, mark))))
+ `(setcar (nthcdr 1 ,data) ,mark))
(defmacro gnus-data-pos (data)
- (` (nth 2 (, data))))
+ `(nth 2 ,data))
(defmacro gnus-data-set-pos (data pos)
- (` (setcar (nthcdr 2 (, data)) (, pos))))
+ `(setcar (nthcdr 2 ,data) ,pos))
(defmacro gnus-data-header (data)
- (` (nth 3 (, data))))
+ `(nth 3 ,data))
(defmacro gnus-data-level (data)
- (` (nth 4 (, data))))
+ `(nth 4 ,data))
(defmacro gnus-data-unread-p (data)
- (` (= (nth 1 (, data)) gnus-unread-mark)))
+ `(= (nth 1 ,data) gnus-unread-mark))
(defmacro gnus-data-pseudo-p (data)
- (` (consp (nth 3 (, data)))))
+ `(consp (nth 3 ,data)))
(defmacro gnus-data-find (number)
- (` (assq (, number) gnus-newsgroup-data)))
+ `(assq ,number gnus-newsgroup-data))
(defmacro gnus-data-find-list (number &optional data)
- (` (memq (assq (, number) (, (or data 'gnus-newsgroup-data)))
- (, (or data 'gnus-newsgroup-data)))))
+ `(let ((bdata ,(or data 'gnus-newsgroup-data)))
+ (memq (assq ,number bdata)
+ bdata)))
(defmacro gnus-data-make (number mark pos header level)
- (` (list (, number) (, mark) (, pos) (, header) (, level))))
+ `(list ,number ,mark ,pos ,header ,level))
(defun gnus-data-enter (after-article number mark pos header level offset)
(let ((data (gnus-data-find-list after-article)))
(setq data (cdr data))))))
(defmacro gnus-data-list (backward)
- (` (if (, backward)
- (or gnus-newsgroup-data-reverse
- (setq gnus-newsgroup-data-reverse
- (reverse gnus-newsgroup-data)))
- gnus-newsgroup-data)))
+ `(if ,backward
+ (or gnus-newsgroup-data-reverse
+ (setq gnus-newsgroup-data-reverse
+ (reverse gnus-newsgroup-data)))
+ gnus-newsgroup-data))
(defun gnus-data-update-list (data offset)
"Add OFFSET to the POS of all data entries in DATA."
gnus-newsgroup-end))))
(defmacro gnus-summary-article-header (&optional number)
- (` (gnus-data-header (gnus-data-find
- (, (or number '(gnus-summary-article-number)))))))
+ `(gnus-data-header (gnus-data-find
+ ,(or number '(gnus-summary-article-number)))))
(defmacro gnus-summary-thread-level (&optional number)
- (` (gnus-data-level (gnus-data-find
- (, (or number '(gnus-summary-article-number)))))))
+ `(gnus-data-level (gnus-data-find
+ ,(or number '(gnus-summary-article-number)))))
(defmacro gnus-summary-article-mark (&optional number)
- (` (gnus-data-mark (gnus-data-find
- (, (or number '(gnus-summary-article-number)))))))
+ `(gnus-data-mark (gnus-data-find
+ ,(or number '(gnus-summary-article-number)))))
(defmacro gnus-summary-article-pos (&optional number)
- (` (gnus-data-pos (gnus-data-find
- (, (or number '(gnus-summary-article-number)))))))
+ `(gnus-data-pos (gnus-data-find
+ ,(or number '(gnus-summary-article-number)))))
(defmacro gnus-summary-article-subject (&optional number)
"Return current subject string or nil if nothing."
- (` (let ((headers
- (, (if number
- (` (gnus-data-header (assq (, number) gnus-newsgroup-data)))
- '(gnus-data-header (assq (gnus-summary-article-number)
- gnus-newsgroup-data))))))
- (and headers
- (vectorp headers)
- (mail-header-subject headers)))))
+ `(let ((headers
+ ,(if number
+ `(gnus-data-header (assq ,number gnus-newsgroup-data))
+ '(gnus-data-header (assq (gnus-summary-article-number)
+ gnus-newsgroup-data)))))
+ (and headers
+ (vectorp headers)
+ (mail-header-subject headers))))
(defmacro gnus-summary-article-score (&optional number)
"Return current article score."
- (` (or (cdr (assq (, (or number '(gnus-summary-article-number)))
- gnus-newsgroup-scored))
- gnus-summary-default-score 0)))
+ `(or (cdr (assq ,(or number '(gnus-summary-article-number))
+ gnus-newsgroup-scored))
+ gnus-summary-default-score 0))
(defun gnus-summary-article-children (&optional number)
(let* ((data (gnus-data-find-list (or number (gnus-summary-article-number))))
t ; All non-existant numbers are the last article. :-)
(cdr (gnus-data-find-list article))))
-(defun gnus-summary-insert-dummy-line
- (sformat gnus-tmp-subject gnus-tmp-number)
+(defun gnus-summary-insert-dummy-line (gnus-tmp-subject gnus-tmp-number)
"Insert a dummy root in the summary buffer."
- (or sformat (setq sformat gnus-summary-dummy-line-format-spec))
(beginning-of-line)
(add-text-properties
- (point) (progn (eval sformat) (point))
+ (point) (progn (eval gnus-summary-dummy-line-format-spec) (point))
(list 'gnus-number gnus-tmp-number 'gnus-intangible gnus-tmp-number)))
(defvar gnus-thread-indent-array nil)
(setq n (1- n))))))
(defun gnus-summary-insert-line
- (sformat gnus-tmp-header gnus-tmp-level gnus-tmp-current gnus-tmp-unread
- gnus-tmp-replied gnus-tmp-expirable gnus-tmp-subject-or-nil
- &optional gnus-tmp-dummy gnus-tmp-score gnus-tmp-process)
- (or sformat (setq sformat gnus-summary-line-format-spec))
+ (gnus-tmp-header gnus-tmp-level gnus-tmp-current gnus-tmp-unread
+ gnus-tmp-replied gnus-tmp-expirable gnus-tmp-subject-or-nil
+ &optional gnus-tmp-dummy gnus-tmp-score gnus-tmp-process)
(let* ((gnus-tmp-indentation (aref gnus-thread-indent-array gnus-tmp-level))
(gnus-tmp-lines (mail-header-lines gnus-tmp-header))
(gnus-tmp-score (or gnus-tmp-score gnus-summary-default-score 0))
(or (numberp gnus-tmp-lines) (setq gnus-tmp-lines 0))
(put-text-property
(point)
- (progn (eval sformat) (point))
+ (progn (eval gnus-summary-line-format-spec) (point))
'gnus-number gnus-tmp-number)))
(defun gnus-summary-update-line (&optional dont-update)
(gnus-summary-hide-all-threads))
;; Show first unread article if requested.
(if (and (not no-article)
+ gnus-newsgroup-unreads
gnus-auto-select-first)
(progn
(if (eq gnus-auto-select-first 'best)
;; article.
(when gnus-tmp-dummy-line
(gnus-summary-insert-dummy-line
- nil gnus-tmp-dummy-line (gnus-header-number header)))
+ gnus-tmp-dummy-line (gnus-header-number header)))
;; Compute the mark.
(setq
(t (or (cdr (assq number gnus-newsgroup-reads))
gnus-ancient-mark))))
+ (setq gnus-newsgroup-data
+ (cons (gnus-data-make number mark (1+ (point))
+ header level)
+ gnus-newsgroup-data))
+
;; Actually insert the line.
(inline
(gnus-summary-insert-line
- nil header level nil mark
+ header level nil mark
(memq number gnus-newsgroup-replied)
(memq number gnus-newsgroup-expirable)
(cond
(cdr (assq number gnus-newsgroup-scored))
(memq number gnus-newsgroup-processable)))
- (setq gnus-newsgroup-data
- (cons (gnus-data-make number mark (- (point) 4)
- header level)
- gnus-newsgroup-data))
-
(setq gnus-tmp-prev-subject subject))))
(if (nth 1 thread)
(cons (gnus-data-make number mark (1+ (point)) header 0)
gnus-newsgroup-data))
(gnus-summary-insert-line
- nil header 0 nil mark (memq number gnus-newsgroup-replied)
+ header 0 nil mark (memq number gnus-newsgroup-replied)
(memq number gnus-newsgroup-expirable)
(mail-header-subject header) nil
(cdr (assq number gnus-newsgroup-scored))
(gnus-request-asynchronous gnus-newsgroup-name)))
;; Adjust and set lists of article marks.
- (when info
- (gnus-adjust-marked-articles info)
- (let ((marked (gnus-info-marks info)))
- (mapcar
- (lambda (thing)
- (let ((name (intern (format "gnus-newsgroup-%s" (car thing)))))
- (set name (copy-sequence (cdr (assq (cdr thing) marked))))))
- '((marked . tick) (replied . reply)
- (expirable . expire) (killed . killed)
- (bookmarks . bookmark) (dormant . dormant)
- (scored . score)))))
+ (gnus-adjust-marked-articles info)
(setq gnus-newsgroup-unreads
(gnus-set-difference
(setq articles (cdr articles)))
out))
-(defun gnus-adjust-marked-articles (info &optional active)
- "Remove all marked articles that are no longer legal."
+(defun gnus-adjust-marked-articles (info)
+ "Set all article lists and remove all marks that are no longer legal."
(let* ((marked-lists (gnus-info-marks info))
- (active (or active (gnus-active (gnus-info-group info))))
+ (active (gnus-active (gnus-info-group info)))
(min (car active))
- m prev)
- ;; There are many types of marked articles.
+ (max (cdr active))
+ (types '((marked . tick) (replied . reply)
+ (expirable . expire) (killed . killed)
+ (bookmarks . bookmark) (dormant . dormant)
+ (scored . score)))
+ (uncompressed '(score bookmark))
+ marks var articles article mark)
+
(while marked-lists
- (setq m (cdr (setq prev (car marked-lists))))
- (cond
- ((or (eq 'tick (car prev)) (eq 'dormant (car prev)))
- ;; Make sure that all ticked articles are a subset of the
- ;; active articles.
- (while m
- (if (< (car m) min)
- (setcdr prev (cdr m))
- (setq prev m))
- (setq m (cdr m))))
- ((eq 'score (car prev))
- ;; Scored articles should be a subset of
- ;; unread/unselected articles.
- (while m
- (if (or (memq (car (car m)) gnus-newsgroup-unreads)
- (memq (car (car m)) gnus-newsgroup-unreads))
- (setq prev m)
- (setcdr prev (cdr m)))
- (setq m (cdr m))))
- ((eq 'bookmark (car prev))
- ;; Bookmarks should be a subset of active articles.
- (while m
- (if (< (car (car m)) min)
- (setcdr prev (cdr m))
- (setq prev m))
- (setq m (cdr m))))
- ((eq 'killed (car prev))
- ;; Articles that have been through the kill process are
- ;; to be a subset of active articles.
- (while (and m (< (or (and (numberp (car m)) (car m))
- (cdr (car m)))
- min))
- (setcdr prev (cdr m))
- (setq m (cdr m)))
- (if (and m (< (or (and (numberp (car m)) (car m))
- (car (car m)))
- min))
- (setcar (if (numberp (car m)) m (car m)) min)))
- ((or (eq 'reply (car prev)) (eq 'expire (car prev)))
- ;; The replied and expirable articles have to be articles
- ;; that are active.
- (while m
- (if (< (car m) min)
- (setcdr prev (cdr m))
- (setq prev m))
- (setq m (cdr m)))))
- (setq marked-lists (cdr marked-lists)))
- ;; Remove all lists that are empty.
- (setq marked-lists (gnus-info-marks info))
- (if marked-lists
- (progn
- (while (= 1 (length (car marked-lists)))
- (setq marked-lists (cdr marked-lists)))
- (setq m (cdr (setq prev marked-lists)))
- (while m
- (if (= 1 (length (car m)))
- (setcdr prev (cdr m))
- (setq prev m))
- (setq m (cdr m)))
- (gnus-info-set-marks info marked-lists)))
- ;; Finally, if there are no marked lists at all left, and if there
- ;; are no elements after the lists in the info list, we just chop
- ;; the info list off before the marked lists.
- (and (null marked-lists)
- (not (nthcdr 4 info))
- (setcdr (nthcdr 2 info) nil)))
- info)
-
-(defun gnus-set-marked-articles
- (info ticked replied expirable killed dormant bookmark score)
+ (setq marks (pop marked-lists))
+ (set (setq var (intern (format "gnus-newsgroup-%s"
+ (car (rassq (setq mark (car marks))
+ types)))))
+ (if (memq (car marks) uncompressed) (cdr marks)
+ (gnus-uncompress-range (cdr marks))))
+
+ (setq articles (symbol-value var))
+
+ ;; All articles have to be subsets of the active articles.
+ (cond
+ ;; Adjust "simple" lists.
+ ((memq mark '(tick dormant expirable reply killed))
+ (while articles
+ (when (or (< (setq article (pop articles)) min) (> article max))
+ (set var (delq article (symbol-value var))))))
+ ;; Adjust assocs.
+ ((memq mark '(score bookmark))
+ (while articles
+ (when (or (< (car (setq article (pop articles))) min)
+ (> (car article) max))
+ (set var (delq article (symbol-value var))))))))))
+
+(defun gnus-update-marks ()
"Enter the various lists of marked articles into the newsgroup info list."
- (let (newmarked)
- (and ticked (setq newmarked (cons (cons 'tick ticked) nil)))
- (and replied (setq newmarked (cons (cons 'reply replied) newmarked)))
- (and expirable (setq newmarked (cons (cons 'expire expirable)
- newmarked)))
- (and killed (setq newmarked (cons (cons 'killed killed) newmarked)))
- (and dormant (setq newmarked (cons (cons 'dormant dormant) newmarked)))
- (and bookmark (setq newmarked (cons (cons 'bookmark bookmark)
- newmarked)))
- (and score (setq newmarked (cons (cons 'score score) newmarked)))
+ (let ((types '((marked . tick) (replied . reply)
+ (expirable . expire) (killed . killed)
+ (bookmarks . bookmark) (dormant . dormant)
+ (scored . score)))
+ (info (gnus-get-info gnus-newsgroup-name))
+ (uncompressed '(score bookmark))
+ var type list newmarked)
+ ;; Add all marks lists that are non-nil to the list of marks lists.
+ (while types
+ (setq type (pop types))
+ (when (setq list (symbol-value (intern (format "gnus-newsgroup-%s"
+ (car type)))))
+ (push (cons (cdr type)
+ (if (memq (cdr type) uncompressed) list
+ (gnus-compress-sequence list t)))
+ newmarked)))
+
+ ;; Enter these new marks into the info of the group.
(if (nthcdr 3 info)
(progn
(setcar (nthcdr 3 info) newmarked)
- (and (not newmarked)
- (not (nthcdr 4 info))
- (setcdr (nthcdr 2 info) nil)))
- (if newmarked
- (setcdr (nthcdr 2 info) (list newmarked))))))
+ ;; Cut off the end of the info if there's nothing else there.
+ (or newmarked (nthcdr 4 info)
+ (setcdr (nthcdr 2 info) nil)))
+ ;; Add the marks lists to the end of the info.
+ (when newmarked
+ (setcdr (nthcdr 2 info) (list newmarked))))))
+
(defun gnus-add-marked-articles (group type articles &optional info force)
;; Add ARTICLES of TYPE to the info of GROUP.
;; If INFO is non-nil, use that info. If FORCE is non-nil, don't
;; add, but replace marked articles of TYPE with ARTICLES.
(let ((info (or info (gnus-get-info group)))
+ (uncompressed '(score bookmark))
marked m)
(or (not info)
(and (not (setq marked (nthcdr 3 info)))
- (setcdr (nthcdr 2 info) (list (list (cons type articles)))))
+ (setcdr (nthcdr 2 info)
+ (list (list (cons type (gnus-compress-sequence
+ articles t))))))
(and (not (setq m (assq type (car marked))))
- (setcar marked (cons (cons type articles) (car marked))))
+ (setcar marked
+ (cons (cons type (gnus-compress-sequence articles t) )
+ (car marked)))
(if force
- (setcdr m articles)
- (nconc m articles)))))
+ (setcdr m (gnus-compress-sequence articles t))
+ (setcdr m (gnus-compress-sequence
+ (sort (nconc (gnus-uncompress-range m)
+ (copy-sequence articles)) '<) t)))))))
(defun gnus-set-mode-line (where)
"This function sets the mode line of the article or summary buffers.
(setq mode-line-buffer-identification mode-string)
(set-buffer-modified-p t))))
-(defun gnus-create-xref-hashtb (from-newsgroup headers unreads ticked dormant)
+(defun gnus-create-xref-hashtb (from-newsgroup headers unreads)
"Go through the HEADERS list and add all Xrefs to a hash table.
The resulting hash table is returned, or nil if no Xrefs were found."
(let* ((from-method (gnus-find-method-for-group from-newsgroup))
- (prefix (if (and
- (gnus-group-foreign-p from-newsgroup)
- (not (memq 'virtual
- (assoc (symbol-name (car from-method))
- gnus-valid-select-methods))))
- (gnus-group-real-prefix from-newsgroup)))
+ (prefix (gnus-group-real-prefix from-newsgroup))
(xref-hashtb (make-vector 63 0))
start group entry number xrefs header)
(while headers
- (setq header (car headers))
- (if (and (setq xrefs (mail-header-xref header))
- (not (memq (setq number (mail-header-number header)) unreads))
- (not (memq number ticked))
- (not (memq number dormant)))
- (progn
- (setq start 0)
- (while (string-match "\\([^ ]+\\)[:/]\\([0-9]+\\)" xrefs start)
- (setq start (match-end 0))
- (setq group (concat prefix (substring xrefs (match-beginning 1)
- (match-end 1))))
- (setq number
- (string-to-int (substring xrefs (match-beginning 2)
- (match-end 2))))
- (if (setq entry (gnus-gethash group xref-hashtb))
- (setcdr entry (cons number (cdr entry)))
- (gnus-sethash group (cons number nil) xref-hashtb)))))
- (setq headers (cdr headers)))
- (if start xref-hashtb nil)))
-
-(defun gnus-mark-xrefs-as-read (from-newsgroup headers unreads expirable
- ticked dormant)
+ (setq header (pop headers))
+ (when (and (setq xrefs (mail-header-xref header))
+ (not (memq (setq number (mail-header-number header))
+ unreads)))
+ (setq start 0)
+ (while (string-match "\\([^ ]+\\)[:/]\\([0-9]+\\)" xrefs start)
+ (setq start (match-end 0))
+ (setq group (concat prefix (substring xrefs (match-beginning 1)
+ (match-end 1))))
+ (setq number
+ (string-to-int (substring xrefs (match-beginning 2)
+ (match-end 2))))
+ (if (setq entry (gnus-gethash group xref-hashtb))
+ (setcdr entry (cons number (cdr entry)))
+ (gnus-sethash group (cons number nil) xref-hashtb)))))
+ (and start xref-hashtb)))
+
+(defun gnus-mark-xrefs-as-read (from-newsgroup headers unreads)
"Look through all the headers and mark the Xrefs as read."
(let ((virtual (memq 'virtual
(assoc (symbol-name (car (gnus-find-method-for-group
nth4)
(save-excursion
(set-buffer gnus-group-buffer)
- (if (setq xref-hashtb
- (gnus-create-xref-hashtb
- from-newsgroup headers unreads ticked dormant))
- (mapatoms
- (lambda (group)
- (if (string= from-newsgroup (setq name (symbol-name group)))
- ()
- (setq idlist (symbol-value group))
- ;; Dead groups are not updated.
- (if (and (prog1
- (setq entry (gnus-gethash name gnus-newsrc-hashtb)
- info (nth 2 entry))
- (if (stringp (setq nth4 (gnus-info-method info)))
- (setq nth4 (gnus-server-to-method nth4))))
- ;; Only do the xrefs if the group has the same
- ;; select method as the group we have just read.
- (or (gnus-methods-equal-p
- nth4 (gnus-find-method-for-group from-newsgroup))
- virtual
- (equal nth4
- (setq method (gnus-find-method-for-group
- from-newsgroup)))
- (and (equal (car nth4) (car method))
- (equal (nth 1 nth4) (nth 1 method))))
- gnus-use-cross-reference
- (or (not (eq gnus-use-cross-reference t))
- virtual
- ;; Only do cross-references on subscribed
- ;; groups, if that is what is wanted.
- (<= (gnus-info-level info) gnus-level-subscribed)))
- (gnus-group-make-articles-read name idlist expirable))))
- xref-hashtb)))))
-
-(defun gnus-group-make-articles-read (group articles expirable)
+ (when (setq xref-hashtb
+ (gnus-create-xref-hashtb from-newsgroup headers unreads))
+ (mapatoms
+ (lambda (group)
+ (unless (string= from-newsgroup (setq name (symbol-name group)))
+ (setq idlist (symbol-value group))
+ ;; Dead groups are not updated.
+ (and (prog1
+ (setq entry (gnus-gethash name gnus-newsrc-hashtb)
+ info (nth 2 entry))
+ (if (stringp (setq nth4 (gnus-info-method info)))
+ (setq nth4 (gnus-server-to-method nth4))))
+ ;; Only do the xrefs if the group has the same
+ ;; select method as the group we have just read.
+ (or (gnus-methods-equal-p
+ nth4 (gnus-find-method-for-group from-newsgroup))
+ virtual
+ (equal nth4 (setq method (gnus-find-method-for-group
+ from-newsgroup)))
+ (and (equal (car nth4) (car method))
+ (equal (nth 1 nth4) (nth 1 method))))
+ gnus-use-cross-reference
+ (or (not (eq gnus-use-cross-reference t))
+ virtual
+ ;; Only do cross-references on subscribed
+ ;; groups, if that is what is wanted.
+ (<= (gnus-info-level info) gnus-level-subscribed))
+ (gnus-group-make-articles-read name idlist))))
+ xref-hashtb)))))
+
+(defun gnus-group-make-articles-read (group articles)
(let* ((num 0)
(entry (gnus-gethash group gnus-newsrc-hashtb))
(info (nth 2 entry))
(active (gnus-active group))
- exps expirable range)
+ range)
;; First peel off all illegal article numbers.
(if active
(let ((ids articles)
id first)
- (setq exps nil)
(while ids
(setq id (car ids))
(if (and first (> id (cdr active)))
(if (or (> id (cdr active))
(< id (car active)))
(setq articles (delq id articles)))
- (and (memq id expirable)
- (setq exps (cons id exps)))
(setq ids (cdr ids)))))
- ;; Update expirable articles.
- (gnus-add-marked-articles nil 'expirable exps info)
;; If the read list is nil, we init it.
(and active
(null (gnus-info-read info))
"Return a list of articles to be worked upon. The prefix argument,
the list of process marked articles, and the current article will be
taken into consideration."
- (let (articles article)
- (if (and n (numberp n))
- (let ((backward (< n 0))
- (n (abs n)))
- (save-excursion
- (while
- (and (> n 0)
- (setq articles
- (cons (setq article (gnus-summary-article-number))
- articles))
- (if backward
- (gnus-summary-find-prev nil article)
- (gnus-summary-find-next nil article)))
- (setq n (1- n))))
- (sort articles (function <)))
- (or (reverse gnus-newsgroup-processable)
- (list (gnus-summary-article-number))))))
+ (cond
+ ((and n (numberp n))
+ ;; A numerical prefix has been given.
+ (let ((backward (< n 0))
+ (n (abs n))
+ articles article)
+ (save-excursion
+ (while
+ (and (> n 0)
+ (push (setq article (gnus-summary-article-number))
+ articles)
+ (if backward
+ (gnus-summary-find-prev nil article)
+ (gnus-summary-find-next nil article)))
+ (decf n)))
+ (nreverse articles)))
+ ((and (boundp 'transient-mark-mode) transient-mark-mode
+ mark-active)
+ ;; Work on the region between point and mark.
+ (let ((max (max (point) (mark)))
+ articles article)
+ (save-excursion
+ (goto-char (min (point) (mark)))
+ (while
+ (and
+ (push (setq article (gnus-summary-article-number)) articles)
+ (gnus-summary-find-next nil article)
+ (< (point) max)))
+ (nreverse articles))))
+ (gnus-newsgroup-processable
+ ;; There are process-marked articles present.
+ (reverse gnus-newsgroup-processable))
+ (t
+ ;; Just return the current article.
+ (list (gnus-summary-article-number)))))
(defun gnus-summary-search-group (&optional backward use-level)
"Search for next unread newsgroup.
(nreverse unread)))
(defun gnus-list-of-read-articles (group)
+ "Return a list of unread, unticked and non-dormant articles."
(let* ((info (gnus-get-info group))
(marked (gnus-info-marks info))
(active (gnus-active group)))
(gnus-uncompress-range active)
(gnus-list-of-unread-articles group))
(append
- (cdr (assq 'dormant marked))
- (cdr (assq 'tick marked)))))))
+ (gnus-uncompress-range (cdr (assq 'dormant marked)))
+ (gnus-uncompress-range (cdr (assq 'tick marked))))))))
;; Various summary commands
(let ((headers gnus-newsgroup-headers))
(gnus-close-group group)
(run-hooks 'gnus-exit-group-hook)
- (gnus-update-read-articles
- group gnus-newsgroup-unreads gnus-newsgroup-unselected
- gnus-newsgroup-marked
- t gnus-newsgroup-replied gnus-newsgroup-expirable
- gnus-newsgroup-killed gnus-newsgroup-dormant
- gnus-newsgroup-bookmarks
- (and gnus-save-score gnus-newsgroup-scored))
+ (unless gnus-save-score
+ (setq gnus-newsgroup-scored nil))
+ ;; Set the new ranges of read articles.
+ (gnus-update-read-articles
+ group (append gnus-newsgroup-unreads gnus-newsgroup-unselected))
+ ;; Set the current article marks.
+ (gnus-update-marks)
+ ;; Do the cross-ref thing.
(when gnus-use-cross-reference
- (gnus-mark-xrefs-as-read
- group headers gnus-newsgroup-unreads gnus-newsgroup-expirable
- gnus-newsgroup-marked gnus-newsgroup-dormant))
+ (gnus-mark-xrefs-as-read group headers gnus-newsgroup-unreads))
;; Do adaptive scoring, and possibly save score files.
(when gnus-newsgroup-adaptive
(gnus-score-adaptive))
(and group
(gnus-group-jump-to-group group))
(condition-case ()
- (execute-kbd-macro (char-to-string key))
+ (cond ((= key ?\C-n)
+ (gnus-group-next-unread-group 1))
+ ((= key ?\C-p)
+ (gnus-group-prev-unread-group 1)))
(error (ding) nil))
(setq group (gnus-group-group-name))
(switch-to-buffer obuf)))))
;; is done by recursing down the thread using this function, so this
;; will really go down to a leaf article first, before slowly
;; working its way up towards the root.
- (let ((children (apply '+ (mapcar (lambda (th)
- (gnus-summary-limit-children th))
- (cdr thread))))
+ (let ((children
+ (if (cdr thread)
+ (apply '+ (mapcar (lambda (th)
+ (gnus-summary-limit-children th))
+ (cdr thread)))
+ 0))
(number (mail-header-number (car thread)))
score)
(if (or
;; nothing to do with the limits, really.
(incf gnus-newsgroup-expunged-tally)
;; We also mark as read here, if that's wanted.
- (when (< score gnus-summary-mark-below)
- (setq gnus-newsgroup-unreads (delq number gnus-newsgroup-unreads))
+ (when (and gnus-summary-mark-below
+ (< score gnus-summary-mark-below))
+ (setq gnus-newsgroup-unreads
+ (delq number gnus-newsgroup-unreads))
(push (cons number gnus-low-score-mark) gnus-newsgroup-reads))
t))
;; Nope, invisible article.
(when (setq number (gnus-summary-insert-subject message-id))
(gnus-summary-select-article nil nil nil number)))))))
-(defun gnus-summary-enter-digest-group ()
+(defun gnus-summary-enter-digest-group (&optional force)
"Enter a digest group based on the current article."
- (interactive)
+ (interactive "P")
(gnus-set-global-variables)
(gnus-summary-select-article)
;; We do not want a narrowed article.
(ogroup gnus-newsgroup-name)
(buf (current-buffer)))
(if (gnus-group-read-ephemeral-group
- name (list 'nndoc name
- (list 'nndoc-address (get-buffer gnus-article-buffer))
- '(nndoc-article-type digest))
- t)
+ name `(nndoc ,name (nndoc-address ,(get-buffer gnus-article-buffer))
+ (nndoc-article-type ,(if force 'digest 'guess))) t)
+ ;; Make all postings to this group go to the parent group.
(setcdr (nthcdr 4 (gnus-get-info name))
(list (list (cons 'to-group ogroup))))
+ ;; Couldn't select this doc group.
(switch-to-buffer buf)
(gnus-set-global-variables)
(gnus-configure-windows 'summary)
(gnus-message 6 "Executing %s..." (key-description command))
;; We'd like to execute COMMAND interactively so as to give arguments.
(gnus-execute header regexp
- (` (lambda ()
- (call-interactively '(, (key-binding command)))))
+ `(lambda () (call-interactively ',(key-binding command)))
backward)
(gnus-message 6 "Executing %s...done" (key-description command)))))
(insert-buffer-substring gnus-original-article-buffer 1 e)
(let ((hook (delq 'gnus-article-hide-headers-if-wanted
(delq 'gnus-article-hide-headers
- (copy-sequence gnus-article-display-hook)))))
+ (copy-sequence gnus-article-display-hook))))
+ (gnus-inhibit-hiding t))
(run-hooks 'hook))
(if (or (not hidden) (and (numberp arg) (< arg 0)))
(gnus-article-hide-headers)))))
(save-excursion
(goto-char (point-min))
(gnus-summary-hide-thread)
- (while (zerop (gnus-summary-next-thread 1))
- (gnus-summary-hide-thread)))
+ (while (zerop (gnus-summary-next-thread 1 t))
+ (gnus-summary-hide-thread))
+ (gnus-summary-hide-thread))
(gnus-summary-position-point))
(defun gnus-summary-hide-thread ()
(let ((buffer-read-only nil)
(start (point))
(article (gnus-summary-article-number))
- (end (point)))
+ end)
;; Go forward until either the buffer ends or the subthread
;; ends.
- (if (eobp)
- ()
- (if (not (zerop (gnus-summary-next-thread 1)))
- ()
- (gnus-summary-find-prev)
- (prog1
- (save-excursion
- (search-backward "\n" start t))
- (subst-char-in-region start (point) ?\n ?\^M)
- (gnus-summary-goto-subject article)
- (gnus-summary-position-point))))))
+ (when (and (not (eobp))
+ (or (and (zerop (gnus-summary-next-thread 1 t))
+ (gnus-summary-find-prev))
+ (gnus-summary-goto-subject gnus-newsgroup-end)))
+ (setq end (point))
+ (prog1
+ (when (search-backward "\n" start t)
+ (subst-char-in-region start end ?\n ?\^M)
+ (gnus-summary-goto-subject article))
+ (gnus-summary-position-point)))))
(defun gnus-summary-go-to-next-thread (&optional previous)
"Go to the same level (or less) next thread.
(and oart
(gnus-summary-goto-subject oart))))
-(defun gnus-summary-next-thread (n)
+(defun gnus-summary-next-thread (n &optional silent)
"Go to the same level next N'th thread.
If N is negative, search backward instead.
Returns the difference between N and the number of skips actually
-done."
+done.
+
+If SILENT, don't output messages."
(interactive "p")
(gnus-set-global-variables)
(let ((backward (< n 0))
(n (abs n)))
(while (and (> n 0)
(gnus-summary-go-to-next-thread backward))
- (setq n (1- n)))
+ (decf n))
(gnus-summary-position-point)
- (if (/= 0 n) (gnus-message 7 "No more threads"))
+ (when (and (not silent) (/= 0 n))
+ (gnus-message 7 "No more threads"))
n))
(defun gnus-summary-prev-thread (n)
\\[gnus-article-describe-briefly]\t Describe the current mode briefly
\\[gnus-info-find-node]\t Go to the Gnus info node"
(interactive)
- (if (gnus-visual-p 'article-menu 'menu) (gnus-article-make-menu-bar))
+ (when (and menu-bar-mode
+ (gnus-visual-p 'article-menu 'menu))
+ (gnus-article-make-menu-bar))
(kill-all-local-variables)
(setq mode-line-modified "-- ")
(make-local-variable 'mode-line-format)
(set-buffer gnus-summary-buffer)
(setq gnus-current-article article)
(gnus-summary-mark-article article gnus-canceled-mark))
- (gnus-message 1 "No such article (may be canceled)")
+ (gnus-message
+ 1 "No such article (may have expired or been canceled)")
(ding)
nil)
(if (or (eq result 'pseudo) (eq result 'nneething))
(run-hooks 'internal-hook)
(run-hooks 'gnus-article-prepare-hook)
;; Decode MIME message.
- (if (and gnus-show-mime
- (or (not gnus-strict-mime)
- (gnus-fetch-field "Mime-Version")))
- (funcall gnus-show-mime-method))
+ (if gnus-show-mime
+ (if (or (not gnus-strict-mime)
+ (gnus-fetch-field "Mime-Version"))
+ (funcall gnus-show-mime-method)
+ (funcall gnus-decode-encoded-word-method)))
;; Perform the article display hooks.
(run-hooks 'gnus-article-display-hook))
;; Do page break.
"Hide unwanted headers if `gnus-have-all-headers' is nil.
Provided for backwards compatability."
(or (save-excursion (set-buffer gnus-summary-buffer) gnus-have-all-headers)
+ gnus-inhibit-hiding
(gnus-article-hide-headers)))
(defun gnus-article-hide-headers (&optional delete)
"Hide unwanted headers and possibly sort them as well."
(interactive "P")
- (save-excursion
- (set-buffer gnus-article-buffer)
- (save-restriction
- (let ((sorted gnus-sorted-header-list)
- (buffer-read-only nil)
- want-list beg want-l)
- ;; First we narrow to just the headers.
- (widen)
- (goto-char (point-min))
- ;; Hide any "From " lines at the beginning of (mail) articles.
- (while (looking-at "From ")
- (forward-line 1))
- (or (bobp)
- (add-text-properties (point-min) (point) gnus-hidden-properties))
- ;; Then treat the rest of the header lines.
- (narrow-to-region
- (point)
- (progn (search-forward "\n\n" nil t) (forward-line -1) (point)))
- ;; Then we use the two regular expressions
- ;; `gnus-ignored-headers' and `gnus-visible-headers' to
- ;; select which header lines is to remain visible in the
- ;; article buffer.
- (goto-char (point-min))
- (while (re-search-forward "^[^ \t]*:" nil t)
- (beginning-of-line)
- ;; We add the headers we want to keep to a list and delete
- ;; them from the buffer.
- (if (or (and (stringp gnus-visible-headers)
- (looking-at gnus-visible-headers))
- (and (not (stringp gnus-visible-headers))
- (stringp gnus-ignored-headers)
- (not (looking-at gnus-ignored-headers))))
- (progn
- (setq beg (point))
- (forward-line 1)
- ;; Be sure to get multi-line headers...
- (re-search-forward "^[^ \t]*:" nil t)
- (beginning-of-line)
- (setq want-list
- (cons (buffer-substring beg (point)) want-list))
- (delete-region beg (point))
- (goto-char beg))
- (forward-line 1)))
- ;; Next we perform the sorting by looking at
- ;; `gnus-sorted-header-list'.
- (goto-char (point-min))
- (while (and sorted want-list)
- (setq want-l want-list)
- (while (and want-l
- (not (string-match (car sorted) (car want-l))))
- (setq want-l (cdr want-l)))
- (if want-l
- (progn
- (insert (car want-l))
- (setq want-list (delq (car want-l) want-list))))
- (setq sorted (cdr sorted)))
- ;; Any headers that were not matched by the sorted list we
- ;; just tack on the end of the visible header list.
- (while want-list
- (insert (car want-list))
- (setq want-list (cdr want-list)))
- ;; And finally we make the unwanted headers invisible.
- (if delete
- (delete-region (point) (point-max))
- ;; Suggested by Sudish Joseph <joseph@cis.ohio-state.edu>.
- (add-text-properties (point) (point-max) gnus-hidden-properties))))))
+ (unless gnus-inhibit-hiding
+ (save-excursion
+ (set-buffer gnus-article-buffer)
+ (save-restriction
+ (let ((sorted gnus-sorted-header-list)
+ (buffer-read-only nil)
+ want-list beg want-l)
+ ;; First we narrow to just the headers.
+ (widen)
+ (goto-char (point-min))
+ ;; Hide any "From " lines at the beginning of (mail) articles.
+ (while (looking-at "From ")
+ (forward-line 1))
+ (or (bobp)
+ (add-text-properties (point-min) (point) gnus-hidden-properties))
+ ;; Then treat the rest of the header lines.
+ (narrow-to-region
+ (point)
+ (progn (search-forward "\n\n" nil t) (forward-line -1) (point)))
+ ;; Then we use the two regular expressions
+ ;; `gnus-ignored-headers' and `gnus-visible-headers' to
+ ;; select which header lines is to remain visible in the
+ ;; article buffer.
+ (goto-char (point-min))
+ (while (re-search-forward "^[^ \t]*:" nil t)
+ (beginning-of-line)
+ ;; We add the headers we want to keep to a list and delete
+ ;; them from the buffer.
+ (if (or (and (stringp gnus-visible-headers)
+ (looking-at gnus-visible-headers))
+ (and (not (stringp gnus-visible-headers))
+ (stringp gnus-ignored-headers)
+ (not (looking-at gnus-ignored-headers))))
+ (progn
+ (setq beg (point))
+ (forward-line 1)
+ ;; Be sure to get multi-line headers...
+ (re-search-forward "^[^ \t]*:" nil t)
+ (beginning-of-line)
+ (setq want-list
+ (cons (buffer-substring beg (point)) want-list))
+ (delete-region beg (point))
+ (goto-char beg))
+ (forward-line 1)))
+ ;; Next we perform the sorting by looking at
+ ;; `gnus-sorted-header-list'.
+ (goto-char (point-min))
+ (while (and sorted want-list)
+ (setq want-l want-list)
+ (while (and want-l
+ (not (string-match (car sorted) (car want-l))))
+ (setq want-l (cdr want-l)))
+ (if want-l
+ (progn
+ (insert (car want-l))
+ (setq want-list (delq (car want-l) want-list))))
+ (setq sorted (cdr sorted)))
+ ;; Any headers that were not matched by the sorted list we
+ ;; just tack on the end of the visible header list.
+ (while want-list
+ (insert (car want-list))
+ (setq want-list (cdr want-list)))
+ ;; And finally we make the unwanted headers invisible.
+ (if delete
+ (delete-region (point) (point-max))
+ ;; Suggested by Sudish Joseph <joseph@cis.ohio-state.edu>.
+ (add-text-properties
+ (point) (point-max) gnus-hidden-properties)))))))
;; Written by Per Abrahamsen <amanda@iesd.auc.dk>.
(defun gnus-article-treat-overstrike ()
(let ((next (following-char))
(previous (char-after (- (point) 2))))
(cond ((eq next previous)
- (put-text-property (- (point) 2) (point)
- 'invisible t)
- (put-text-property (point) (1+ (point))
- 'face 'bold))
+ (put-text-property (- (point) 2) (point) 'invisible t)
+ (put-text-property (point) (1+ (point)) 'face 'bold))
((eq next ?_)
- (put-text-property (1- (point)) (1+ (point))
- 'invisible t)
- (put-text-property (- (point) 2) (1- (point))
- 'face 'underline))
+ (put-text-property (1- (point)) (1+ (point)) 'invisible t)
+ (put-text-property
+ (- (point) 2) (1- (point)) 'face 'underline))
((eq previous ?_)
- (put-text-property (- (point) 2) (point)
- 'invisible t)
- (put-text-property (point) (1+ (point))
- 'face 'underline))))))))
+ (put-text-property (- (point) 2) (point) 'invisible t)
+ (put-text-property
+ (point) (1+ (point)) 'face 'underline))))))))
(defun gnus-article-word-wrap ()
"Format too long lines."
(second . 1))
"Mapping from time units to seconds.")
-(defun gnus-article-date-ut (&optional type)
+(defun gnus-article-date-ut (&optional type highlight)
"Convert DATE date to universal time in the current article.
If TYPE is `local', convert to local time; if it is `lapsed', output
how much time has lapsed since DATE."
- (interactive (list 'ut))
+ (interactive (list 'ut t))
(let ((date (mail-header-date (or gnus-current-headers
(gnus-summary-article-header) "")))
(date-regexp "^Date: \\|^X-Sent: ")
(inhibit-point-motion-hooks t))
(when (and date (not (string= date "")))
(save-excursion
+ (set-buffer gnus-article-buffer)
(save-restriction
- (set-buffer gnus-article-buffer)
(gnus-narrow-to-headers)
(let ((buffer-read-only nil))
;; Delete any old Date headers.
" ago\n"
" in the future\n")))))
(t
- (error "Unknown conversion type: %s" type))))))))))
+ (error "Unknown conversion type: %s" type)))))
+ ;; Do highlighting.
+ (when (and highlight (gnus-visual-p 'article-highlight 'highlight))
+ (gnus-article-highlight-headers)))))))
-(defun gnus-article-date-local ()
+(defun gnus-article-date-local (&optional highlight)
"Convert the current article date to the local timezone."
- (interactive)
- (gnus-article-date-ut 'local))
+ (interactive (list t))
+ (gnus-article-date-ut 'local highlight))
-(defun gnus-article-date-original ()
+(defun gnus-article-date-original (&optional highlight)
"Convert the current article date to what it was originally.
This is only useful if you have used some other date conversion
function and want to see what the date was before converting."
- (interactive)
- (gnus-article-date-ut 'original))
+ (interactive (list t))
+ (gnus-article-date-ut 'original highlight))
-(defun gnus-article-date-lapsed ()
+(defun gnus-article-date-lapsed (&optional highlight)
"Convert the current article date to time lapsed since it was sent."
- (interactive)
- (gnus-article-date-ut 'lapsed))
+ (interactive (list t))
+ (gnus-article-date-ut 'lapsed highlight))
(defun gnus-article-maybe-highlight ()
"Do some article highlighting if `gnus-visual' is non-nil."
(file-name-nondirectory dribble-file))))
(gnus-add-current-to-buffer-list)
(erase-buffer)
- (setq buffer-file-name dribble-file)
+ (set-visited-file-name dribble-file)
(buffer-disable-undo (current-buffer))
(bury-buffer (current-buffer))
(set-buffer-modified-p nil)
nil)))))
(defun gnus-check-server (&optional method)
- "If the news server is down, start it up again."
- (let ((method (if method method gnus-select-method)))
- (and (stringp method)
- (setq method (gnus-server-to-method method)))
+ "Check whether the connection to METHOD is down.
+If METHOD is nil, use `gnus-select-method'.
+If it is down, start it up (again)."
+ (let ((method (or method gnus-select-method)))
+ ;; Transform virtual server names into select methods.
+ (when (stringp method)
+ (setq method (gnus-server-to-method method)))
(if (gnus-server-opened method)
- ;; Stream is already opened.
+ ;; The stream is already opened.
t
- ;; Open server.
- (gnus-message 5 "Opening server %s on %s..." (car method) (nth 1 method))
+ ;; Open the server.
+ (gnus-message 5 "Opening %s server on %s..." (car method) (nth 1 method))
(run-hooks 'gnus-open-server-hook)
(prog1
(gnus-open-server method)
(message "")))))
-(defun gnus-nntp-message (&optional message)
- "Check the status of the NNTP server.
-If the status of the server is clear and MESSAGE is non-nil, MESSAGE
-is returned insted of the status string."
- (let ((status (gnus-status-message (gnus-find-method-for-group
- gnus-newsgroup-name)))
- (message (or message "")))
- (if (and (stringp status) (> (length status) 0))
- status message)))
-
(defun gnus-get-function (method function)
- (and (stringp method)
- (setq method (gnus-server-to-method method)))
+ "Return a function symbol based on METHOD and FUNCTION."
+ ;; Translate server names into methods.
+ (when (stringp method)
+ (setq method (gnus-server-to-method method)))
(let ((func (intern (format "%s-%s" (car method) function))))
- (if (not (fboundp func))
- (progn
- (require (car method))
- (if (not (fboundp func))
- (error "No such function: %s" func))))
+ ;; If the functions isn't bound, we require the backend in
+ ;; question.
+ (unless (fboundp func)
+ (require (car method))
+ (unless (fboundp func)
+ ;; This backend doesn't implement this function.
+ (error "No such function: %s" func)))
func))
;;; Interface functions to the backends.
(defun gnus-open-server (method)
+ "Open a connection to METHOD."
(let ((elem (assoc method gnus-opened-servers)))
;; If this method was previously denied, we just return nil.
- (if (eq (cdr elem) 'denied)
- nil
+ (if (eq (nth 1 elem) 'denied)
+ (progn
+ (gnus-message 1 "Denied server")
+ nil)
;; Open the server.
(let ((result
(funcall (gnus-get-function method 'open-server)
result))))
(defun gnus-close-server (method)
+ "Close the connection to METHOD."
(funcall (gnus-get-function method 'close-server) (nth 1 method)))
(defun gnus-request-list (method)
+ "Request the active file from METHOD."
(funcall (gnus-get-function method 'request-list) (nth 1 method)))
(defun gnus-request-list-newsgroups (method)
+ "Request the newsgroups file from METHOD."
(funcall (gnus-get-function method 'request-list-newsgroups) (nth 1 method)))
(defun gnus-request-newgroups (date method)
+ "Request all new groups since DATE from METHOD."
(funcall (gnus-get-function method 'request-newgroups)
date (nth 1 method)))
(defun gnus-server-opened (method)
+ "Check whether a connection to METHOD has been opened."
(funcall (gnus-get-function method 'server-opened) (nth 1 method)))
(defun gnus-status-message (method)
+ "Return the status message from METHOD.
+If METHOD is a string, it is interpreted as a group name. The method
+this group uses will be queried."
(let ((method (if (stringp method) (gnus-find-method-for-group method)
method)))
(funcall (gnus-get-function method 'status-message) (nth 1 method))))
(defun gnus-request-group (group &optional dont-check)
+ "Request GROUP. If DONT-CHECK, no information is required."
(let ((method (gnus-find-method-for-group group)))
(funcall (gnus-get-function method 'request-group)
(gnus-group-real-name group) (nth 1 method) dont-check)))
(defun gnus-request-asynchronous (group &optional articles)
+ "Request that GROUP behave asynchronously.
+ARTICLES is the `data' of the group."
(let ((method (gnus-find-method-for-group group)))
(funcall (gnus-get-function method 'request-asynchronous)
(gnus-group-real-name group) (nth 1 method) articles)))
(defun gnus-list-active-group (group)
+ "Request active information on GROUP."
(let ((method (gnus-find-method-for-group group))
(func 'list-active-group))
- (and (gnus-check-backend-function func group)
- (funcall (gnus-get-function method func)
- (gnus-group-real-name group) (nth 1 method)))))
+ (when (gnus-check-backend-function func group)
+ (funcall (gnus-get-function method func)
+ (gnus-group-real-name group) (nth 1 method)))))
(defun gnus-request-group-description (group)
+ "Request a description of GROUP."
(let ((method (gnus-find-method-for-group group))
(func 'request-group-description))
- (and (gnus-check-backend-function func group)
- (funcall (gnus-get-function method func)
- (gnus-group-real-name group) (nth 1 method)))))
+ (when (gnus-check-backend-function func group)
+ (funcall (gnus-get-function method func)
+ (gnus-group-real-name group) (nth 1 method)))))
(defun gnus-close-group (group)
+ "Request the GROUP be closed."
(let ((method (gnus-find-method-for-group group)))
(funcall (gnus-get-function method 'close-group)
(gnus-group-real-name group) (nth 1 method))))
(defun gnus-retrieve-headers (articles group &optional fetch-old)
+ "Request headers for ARTICLES in GROUP.
+If FETCH-OLD, retrieve all headers (or some subset thereof) in the group."
(let ((method (gnus-find-method-for-group group)))
(if (and gnus-use-cache (numberp (car articles)))
(gnus-cache-retrieve-headers articles group)
fetch-old))))
(defun gnus-retrieve-groups (groups method)
+ "Request active information on GROUPS from METHOD."
(funcall (gnus-get-function method 'retrieve-groups) groups (nth 1 method)))
(defun gnus-request-article (article group &optional buffer)
+ "Request the ARTICLE in GROUP.
+ARTICLE can either be an article number or an article Message-ID.
+If BUFFER, insert the article in that group."
(let ((method (gnus-find-method-for-group group)))
(funcall (gnus-get-function method 'request-article)
article (gnus-group-real-name group) (nth 1 method) buffer)))
(defun gnus-request-head (article group)
+ "Request the head of ARTICLE in GROUP."
(let ((method (gnus-find-method-for-group group)))
(funcall (gnus-get-function method 'request-head)
article (gnus-group-real-name group) (nth 1 method))))
(defun gnus-request-body (article group)
+ "Request the body of ARTICLE in GROUP."
(let ((method (gnus-find-method-for-group group)))
(funcall (gnus-get-function method 'request-body)
article (gnus-group-real-name group) (nth 1 method))))
-(defun gnus-request-post (method &optional force)
- (funcall (gnus-get-function method 'request-post)
- (nth 1 method)))
+(defun gnus-request-post (method)
+ "Post the current buffer using METHOD."
+ (funcall (gnus-get-function method 'request-post) (nth 1 method)))
(defun gnus-request-scan (group method)
+ "Request a SCAN being performed in GROUP from METHOD.
+If GROUP is nil, all groups on METHOD are scanned."
(let ((method (if group (gnus-find-method-for-group group) method)))
(funcall (gnus-get-function method 'request-scan)
(and group (gnus-group-real-name group)) (nth 1 method))))
(defun gnus-request-update-info (info method)
- (funcall (gnus-get-function method 'request-update-info)
- (gnus-group-real-name (gnus-info-group info)) info (nth 1 method)))
+ "Request that METHOD update INFO."
+ (when (gnus-check-backend-function 'request-update-info method)
+ (funcall (gnus-get-function method 'request-update-info)
+ (gnus-group-real-name (gnus-info-group info))
+ info (nth 1 method))))
(defun gnus-request-expire-articles (articles group &optional force)
(let ((method (gnus-find-method-for-group group)))
(mapatoms
(lambda (sym)
(if (or (null (setq group (symbol-name sym)))
+ (not (boundp sym))
(null (symbol-value sym))
(gnus-gethash group gnus-killed-hashtb)
(gnus-gethash group gnus-newsrc-hashtb))
;; We do this here because it would be awkward
;; to do it anywhere else. Hell, it's pretty
;; awkward here as well, but at least it's
- ;; reasonable efficient.
- (and (fboundp (intern (format "%s-request-update-info"
- (car fmethod))))
- (<= (gnus-info-level info) foreign-level)
+ ;; reasonably efficient.
+ (and (<= (gnus-info-level info) foreign-level)
(gnus-request-update-info info method)))))
(not (gnus-secondary-method-p method)))
;; These groups are foreign. Check the level.
;; Return the new active info.
active))))))
-(defun gnus-update-read-articles
- (group unread unselected ticked &optional domarks replied expirable killed
- dormant bookmark score)
+(defun gnus-update-read-articles (group unread)
"Update the list of read and ticked articles in GROUP using the
UNREAD and TICKED lists.
Note: UNSELECTED has to be sorted over `<'.
(info (nth 2 entry))
(marked (gnus-info-marks info))
(prev 1)
- (unread (sort (copy-sequence unread) (function <)))
+ (unread (sort (copy-sequence unread) '<))
read)
(if (or (not info) (not active))
;; There is no info on this group if it was, in fact,
;; Remove any expired article numbers
(while (and unread (< (car unread) (car active)))
(setq unread (cdr unread)))
- (while (and ticked (< (car ticked) (car active)))
- (setq ticked (cdr ticked)))
- (while (and dormant (< (car dormant) (car active)))
- (setq dormant (cdr dormant)))
- (setq unread (sort (append unselected unread) '<))
;; Compute the ranges of read articles by looking at the list of
;; unread articles.
(while unread
(cons prev (1- (car unread)))) read)))
(setq prev (1+ (car unread)))
(setq unread (cdr unread)))
- (if (<= prev (cdr active))
- (setq read (cons (cons prev (cdr active)) read)))
+ (when (<= prev (cdr active))
+ (setq read (cons (cons prev (cdr active)) read)))
;; Enter this list into the group info.
(gnus-info-set-read
info (if (> (length read) 1) (nreverse read) read))
- ;; Enter the list of ticked articles.
- (gnus-set-marked-articles
- info ticked
- (if domarks replied (cdr (assq 'reply marked)))
- (if domarks expirable (cdr (assq 'expire marked)))
- (if domarks killed (cdr (assq 'killed marked)))
- (if domarks dormant (cdr (assq 'dormant marked)))
- (if domarks bookmark (cdr (assq 'bookmark marked)))
- (if domarks score (cdr (assq 'score marked))))
;; Set the number of unread articles in gnus-newsrc-hashtb.
(gnus-get-unread-articles-in-group info (gnus-active group))
t)))
(error
(gnus-message 1 "Error in %s" ding-file)
(ding)))
- (and gnus-newsrc-assoc (setq gnus-newsrc-alist gnus-newsrc-assoc)))
- (let ((inhibit-quit t))
- (gnus-uncompress-newsrc-alist))
+ (when gnus-newsrc-assoc
+ (setq gnus-newsrc-alist gnus-newsrc-assoc)))
(gnus-make-hashtable-from-newsrc-alist)
- (if (not (file-newer-than-file-p file ding-file))
- ()
+ (when (file-newer-than-file-p file ding-file)
;; Old format quick file
(gnus-message 5 "Reading %s..." file)
;; The .el file is newer than the .eld file, so we read that one
gnus-newsrc-alist)))
(if (setq m (assoc (car group) marked))
(gnus-info-set-marks
- info (cons (list (cons 'tick (cdr m))) nil))))
+ info (cons (list (cons 'tick (gnus-compress-sequence
+ (sort (cdr m) '<) t)))
+ nil))))
(setq newsrc (cdr newsrc)))
(setq newsrc killed)
(while newsrc
(file-exists-p (concat real-file ".eld")))
real-file file)))
-(defun gnus-uncompress-newsrc-alist ()
- ;; Uncompress all lists of marked articles in the newsrc assoc.
- (let ((newsrc gnus-newsrc-alist)
- marked)
- (while newsrc
- (if (not (setq marked (nth 3 (car newsrc))))
- ()
- (while marked
- (or (eq 'score (car (car marked)))
- (eq 'bookmark (car (car marked)))
- (eq 'killed (car (car marked)))
- (setcdr (car marked) (gnus-uncompress-range (cdr (car marked)))))
- (setq marked (cdr marked))))
- (setq newsrc (cdr newsrc)))))
-
-(defun gnus-compress-newsrc-alist ()
- ;; Compress all lists of marked articles in the newsrc assoc.
- (let ((newsrc gnus-newsrc-alist)
- marked)
- (while newsrc
- (if (not (setq marked (nth 3 (car newsrc))))
- ()
- (while marked
- (or (eq 'score (car (car marked)))
- (eq 'bookmark (car (car marked)))
- (eq 'killed (car (car marked)))
- (setcdr (car marked)
- (condition-case ()
- (gnus-compress-sequence
- (sort (cdr (car marked)) '<) t)
- (error (cdr (car marked))))))
- (setq marked (cdr marked))))
- (setq newsrc (cdr newsrc)))))
-
(defun gnus-newsrc-to-gnus-format ()
(setq gnus-newsrc-options "")
(setq gnus-newsrc-options-n nil)
(setq gnus-newsrc-options-n out))))
-(defun gnus-save-newsrc-file ()
+(defun gnus-save-newsrc-file (&optional force)
"Save .newsrc file."
;; Note: We cannot save .newsrc file if all newsgroups are removed
;; from the variable gnus-newsrc-alist.
- (and (or gnus-newsrc-alist gnus-killed-list)
- gnus-current-startup-file
- (progn
- (save-excursion
- (if (and (or gnus-use-dribble-file gnus-slave)
- (or (not gnus-dribble-buffer)
- (not (buffer-name gnus-dribble-buffer))
- (zerop (save-excursion
- (set-buffer gnus-dribble-buffer)
- (buffer-size)))))
- (gnus-message 4 "(No changes need to be saved)")
- (run-hooks 'gnus-save-newsrc-hook)
- (if gnus-slave
- (gnus-slave-save-newsrc)
- (if gnus-save-newsrc-file
- (progn
- (gnus-message 5 "Saving %s..." gnus-current-startup-file)
- ;; Make backup file of master newsrc.
- (gnus-gnus-to-newsrc-format)
- (gnus-message 5 "Saving %s...done"
- gnus-current-startup-file)))
- ;; Quickly loadable .newsrc.
- (set-buffer (get-buffer-create " *Gnus-newsrc*"))
- (make-local-variable 'version-control)
- (setq version-control 'never)
- (setq buffer-file-name
- (concat gnus-current-startup-file ".eld"))
- (gnus-add-current-to-buffer-list)
- (buffer-disable-undo (current-buffer))
- (erase-buffer)
- (gnus-message 5 "Saving %s.eld..." gnus-current-startup-file)
- (gnus-gnus-to-quick-newsrc-format)
- (run-hooks 'gnus-save-quick-newsrc-hook)
- (save-buffer)
- (kill-buffer (current-buffer))
- (gnus-message
- 5 "Saving %s.eld...done" gnus-current-startup-file))
- (gnus-dribble-delete-file))))))
+ (when (and (or gnus-newsrc-alist gnus-killed-list)
+ gnus-current-startup-file)
+ (save-excursion
+ (if (and (or gnus-use-dribble-file gnus-slave)
+ (not force)
+ (or (not gnus-dribble-buffer)
+ (not (buffer-name gnus-dribble-buffer))
+ (zerop (save-excursion
+ (set-buffer gnus-dribble-buffer)
+ (buffer-size)))))
+ (gnus-message 4 "(No changes need to be saved)")
+ (run-hooks 'gnus-save-newsrc-hook)
+ (if gnus-slave
+ (gnus-slave-save-newsrc)
+ ;; Save .newsrc.
+ (when gnus-save-newsrc-file
+ (gnus-message 5 "Saving %s..." gnus-current-startup-file)
+ (gnus-gnus-to-newsrc-format)
+ (gnus-message 5 "Saving %s...done" gnus-current-startup-file))
+ ;; Save .newsrc.eld.
+ (set-buffer (get-buffer-create " *Gnus-newsrc*"))
+ (make-local-variable 'version-control)
+ (setq version-control 'never)
+ (setq buffer-file-name
+ (concat gnus-current-startup-file ".eld"))
+ (gnus-add-current-to-buffer-list)
+ (buffer-disable-undo (current-buffer))
+ (erase-buffer)
+ (gnus-message 5 "Saving %s.eld..." gnus-current-startup-file)
+ (gnus-gnus-to-quick-newsrc-format)
+ (run-hooks 'gnus-save-quick-newsrc-hook)
+ (save-buffer)
+ (kill-buffer (current-buffer))
+ (gnus-message
+ 5 "Saving %s.eld...done" gnus-current-startup-file))
+ (gnus-dribble-delete-file)))))
(defun gnus-gnus-to-quick-newsrc-format ()
"Insert Gnus variables such as gnus-newsrc-alist in lisp format."
(insert ";; to read .newsrc.\n")
(insert "(setq gnus-newsrc-file-version "
(prin1-to-string gnus-version) ")\n")
- (let ((variables gnus-variable-list)
- (inhibit-quit t)
+ (let ((variables
+ (if gnus-save-killed-list gnus-variable-list
+ ;; Remove the `gnus-killed-list' from the list of variables
+ ;; to be saved, if required.
+ (delq 'gnus-killed-list (copy-sequence gnus-variable-list))))
+ ;; Peel off the "dummy" group.
(gnus-newsrc-alist (cdr gnus-newsrc-alist))
variable)
- ;; insert lisp expressions.
- (gnus-compress-newsrc-alist)
+ ;; Insert the variables into the file.
(while variables
- (setq variable (car variables))
- (and (boundp variable)
- (symbol-value variable)
- (or gnus-save-killed-list (not (eq variable 'gnus-killed-list)))
- (insert "(setq " (symbol-name variable) " '"
- (prin1-to-string (symbol-value variable))
- ")\n"))
- (setq variables (cdr variables)))
- (gnus-uncompress-newsrc-alist)))
+ (when (and (boundp (setq variable (pop variables)))
+ (symbol-value variable))
+ (insert "(setq " (symbol-name variable) " '"
+ (prin1-to-string (symbol-value variable)) ")\n")))))
(defun gnus-gnus-to-newsrc-format ()
;; Generate and save the .newsrc file.
(defvar gnus-backlog-hashtb nil)
(defun gnus-backlog-buffer ()
+ "Return the backlog buffer."
(or (get-buffer gnus-backlog-buffer)
(save-excursion
(set-buffer (get-buffer-create gnus-backlog-buffer))
(let ((ident (get-text-property (point) 'gnus-backlog))
buffer-read-only)
;; Remove the ident from the list of articles.
- (and ident
- (setq gnus-backlog-articles (delq ident gnus-backlog-articles)))
+ (when ident
+ (setq gnus-backlog-articles (delq ident gnus-backlog-articles)))
;; Delete the article itself.
(delete-region
(point) (next-single-property-change
(let ((ident (intern (concat group ":" (int-to-string number))
gnus-backlog-hashtb))
beg end)
- (if (not (memq ident gnus-backlog-articles))
- () ; It wasn't in the backlog.
+ (when (memq ident gnus-backlog-articles)
+ ;; It was in the backlog.
(save-excursion
(set-buffer (gnus-backlog-buffer))
(if (not (setq beg (text-property-any
(setq end
(next-single-property-change
(1+ beg) 'gnus-backlog (current-buffer) (point-max)))))
- (erase-buffer)
- (insert-buffer-substring gnus-backlog-buffer beg end))))
+ (let ((buffer-read-only nil))
+ (erase-buffer)
+ (insert-buffer-substring gnus-backlog-buffer beg end)))))
;; Allow redefinition of Gnus functions.
(setq nnbabyl-current-server server)))
(defun nnbabyl-close-server (&optional server)
+ (setq nnbabyl-current-server nil)
t)
(defun nnbabyl-server-opened (&optional server)
`rfc1341' -- RFC 1341 digest (MIME, unique boundary, no quoting).")
(defconst nndoc-type-to-regexp
- (` ((mbox
- (, (concat "^" rmail-unix-mail-delimiter))
- (, (concat "^" rmail-unix-mail-delimiter))
- nil "^$" nil nil nil)
- (babyl "\^_\^L *\n" "\^_" "^[0-9].*\n" "^$" nil nil
- "^$")
- (digest
- "^------------------------------*[\n \t]+"
- "^------------------------------*[\n \t]+"
- nil "^ ?$"
- "^------------------------------*[\n \t]+"
- "^End of" nil)
- (forward
- "^-+ Start of forwarded message -+\n+"
- "^-+ End of forwarded message -+\n"
- nil "^ ?$" nil nil nil)))
+ `((mbox
+ ,(concat "^" rmail-unix-mail-delimiter)
+ ,(concat "^" rmail-unix-mail-delimiter)
+ nil "^$" nil nil nil)
+ (babyl "\^_\^L *\n" "\^_" "^[0-9].*\n" "^$" nil nil
+ "^$")
+ (digest
+ "^------------------------------*[\n \t]+"
+ "^------------------------------*[\n \t]+"
+ nil "^ ?$"
+ "^------------------------------*[\n \t]+"
+ "^End of" nil)
+ (forward
+ "^-+ Start of forwarded message -+\n+"
+ "^-+ End of forwarded message -+\n"
+ nil "^ ?$" nil nil nil)
+ (mmfd
+ "^\^A\^A\^A\^A\n" "^\^A\^A\^A\^A\n" nil "^$"
+ nil nil nil))
"Regular expressions for articles of the various types.
article-begin, article-end, head-begin, head-end,
first-article, end-of-file, body-begin.")
+
\f
(defvar nndoc-article-begin nil)
(setq nndoc-server-alist (delq state nndoc-server-alist)))
(nnheader-set-init-variables nndoc-server-variables defs)))
(setq nndoc-current-server server)
- (let ((defs (cdr (assq nndoc-article-type nndoc-type-to-regexp))))
- (setq nndoc-article-begin (nth 0 defs))
- (setq nndoc-article-end (nth 1 defs))
- (setq nndoc-head-begin (nth 2 defs))
- (setq nndoc-head-end (nth 3 defs))
- (setq nndoc-first-article (nth 4 defs))
- (setq nndoc-end-of-file (nth 5 defs))
- (setq nndoc-body-begin (nth 6 defs)))
+ (unless (eq nndoc-article-type 'guess)
+ (nndoc-set-delims))
t))
(defun nndoc-close-server (&optional server)
(defun nndoc-close-group (group &optional server)
(nndoc-possibly-change-buffer group server)
- (kill-buffer nndoc-current-buffer)
+ (and nndoc-current-buffer
+ (buffer-name nndoc-current-buffer)
+ (kill-buffer nndoc-current-buffer))
(setq nndoc-group-alist (delq (assoc group nndoc-group-alist)
nndoc-group-alist))
(setq nndoc-current-buffer nil)
(save-excursion
(set-buffer nndoc-address)
(widen))
- (insert-buffer-substring nndoc-address))
- t)))))
+ (insert-buffer-substring nndoc-address)))))
+ (when (eq nndoc-article-type 'guess)
+ (save-excursion
+ (set-buffer nndoc-current-buffer)
+ (setq nndoc-article-type (nndoc-guess-doc-type))
+ (nndoc-set-delims)))
+ t))
+
;; MIME (RFC 1341) digest hack by Ulrik Dickow <dickow@nbi.dk>.
(defun nndoc-set-header-dependent-regexps ()
(if (not (eq nndoc-article-type 'digest))
()
- (let ((case-fold-search t) ; We match a bit too much, keep it simple.
- (boundary-id) (b-delimiter))
+ (let ((case-fold-search t) ; We match a bit too much, keep it simple.
+ boundary-id b-delimiter)
(save-excursion
(set-buffer nndoc-current-buffer)
(goto-char (point-min))
(goto-char (point-min))
(while (and (re-search-forward nndoc-article-begin nil t)
(not (zerop (setq article (1- article))))))
- (if (not (zerop article))
- ()
+ (when (zerop article)
(narrow-to-region
(match-end 0)
(or (and (re-search-forward nndoc-article-end nil t)
(append-to-buffer ibuf (point) (point-max))
t))))
+(defun nndoc-guess-doc-type ()
+ "Guess what document type is in the current buffer.
+Returns one of `babyl', `mbox', `digest', `forward', `mmfd' or nil."
+ (goto-char (point-min))
+ (cond
+ ((looking-at rmail-unix-mail-delimiter)
+ 'mbox)
+ ((looking-at "\^A\^A\^A\^A$")
+ 'mmfd)
+ ((and (re-search-forward "^-+ Start of forwarded message -+\n+" nil t)
+ (not (re-search-forward "^Subject:.*digest" nil t)))
+ 'forward)
+ ((re-search-forward "\^_\^L *\n" nil t)
+ 'babyl)
+ (t
+ 'digest)))
+
+(defun nndoc-set-delims ()
+ (let ((defs (cdr (assq nndoc-article-type nndoc-type-to-regexp))))
+ (setq nndoc-article-begin (nth 0 defs))
+ (setq nndoc-article-end (nth 1 defs))
+ (setq nndoc-head-begin (nth 2 defs))
+ (setq nndoc-head-end (nth 3 defs))
+ (setq nndoc-first-article (nth 4 defs))
+ (setq nndoc-end-of-file (nth 5 defs))
+ (setq nndoc-body-begin (nth 6 defs))))
+
(provide 'nndoc)
;;; nndoc.el ends here
(require 'nnheader)
(require 'rmail)
(require 'nnmail)
+(eval-when-compile (require 'cl))
(defvar nnfolder-directory (expand-file-name "~/Mail/")
"The name of the mail box file in the users home directory.")
(setq nnfolder-current-server server)))
(defun nnfolder-close-server (&optional server)
+ (setq nnfolder-current-server nil)
t)
(defun nnfolder-server-opened (&optional server)
(let ((buf (current-buffer))
result)
(goto-char (point-min))
- (cond ((looking-at "X-From-Line: ")
- (replace-match "From "))
- ((not (looking-at "From "))
- (insert "From nobody " (current-time-string) "\n")))
+ (when (looking-at "X-From-Line: ")
+ (replace-match "From "))
(and
(nnfolder-request-list)
(save-excursion
(if group (list (list group "")) nnmail-split-methods))
(group-art-list
(nreverse (nnmail-article-group 'nnfolder-active-number)))
+ (delim (concat "^" rmail-unix-mail-delimiter))
save-list group-art)
+ (goto-char (point-min))
+ ;; This might come from somewhere else.
+ (unless (looking-at delim)
+ (insert "From nobody " (current-time-string) "\n")
+ (goto-char (point-min)))
+ ;; Quote all "From " lines in the article.
+ (forward-line 1)
+ (while (re-search-forward delim nil t)
+ (beginning-of-line)
+ (insert "> "))
(setq save-list group-art-list)
(nnmail-insert-lines)
(nnmail-insert-xref group-art-list)
nnfolder-group-alist)))
(cdr active))
(nnmail-save-active nnfolder-group-alist nnfolder-active-file)
- (nnfolder-possibly-activate-groups group)
- )))
+ (nnfolder-possibly-activate-groups group))))
;; This method has a problem if you've accidentally let the active list get
(set (car (car state)) (nth 1 (car state)))
(setq state (cdr state))))
+;; Read the head of an article by brute force
+(defvar nnheader-gnus-headers-program "/usr/local/bin/headers")
+
;; Read the head of an article.
(defun nnheader-insert-head (file)
(if (eq nnheader-max-head-length t)
;; Just read the entire file.
(nnheader-insert-file-contents-literally file)
- (let ((beg 0)
- (chop 1024))
+ (call-process nnheader-gnus-headers-program file t)
+ (goto-char (point-max))))
+
+; (let ((beg 0)
+; (chop 1024))
;; Read 1K blocks until we find a separator.
- (while (and (eq chop (nth 1 (nnheader-insert-file-contents-literally
- file nil beg (setq beg (+ chop beg)))))
- (prog1 (not (search-backward "\n\n" nil t))
- (goto-char (point-max)))
- (or (null nnheader-max-head-length)
- (< beg nnheader-max-head-length)))))))
+; (while (and (eq chop (nth 1 (nnheader-insert-file-contents-literally
+; file nil beg (setq beg (+ chop beg)))))
+; (prog1 (not (search-backward "\n\n" nil t))
+; (goto-char (point-max)))
+; (or (null nnheader-max-head-length)
+; (< beg nnheader-max-head-length)))))))
(defun nnheader-article-p ()
(goto-char (point-min))
If this variable is a list, all files mentioned in this list will be
used as incoming mailboxes.")
+(defvar nnmail-crash-box "~/.gnus-crash-box"
+ "*File where Gnus will store mail while processing it.")
+
(defvar nnmail-use-procmail nil
"*If non-nil, the mail backends will look in `nnmail-procmail-directory' for spool files.
The file(s) in `nnmail-spool-file' will also be read.")
(nth 1 d2) (nth 2 d2) (car d2)))))
;; Function taken from rmail.el.
-(defun nnmail-move-inbox (inbox tofile)
+(defun nnmail-move-inbox (inbox)
+ "Move INBOX to `nnmail-crash-box'."
(let ((inbox (file-truename
(expand-file-name (substitute-in-file-name inbox))))
+ (tofile (file-truename (expand-file-name
+ (substitute-in-file-name nnmail-crash-box))))
movemail popmail errors)
- ;; Check whether the inbox is to be moved to the special tmp dir.
- (if nnmail-tmp-directory
- (setq tofile (concat (file-name-as-directory nnmail-tmp-directory)
- (file-name-nondirectory tofile))))
- ;; Make the filename unique.
- (setq tofile (nnmail-make-complex-temp-name (expand-file-name tofile)))
- ;; We create the directory the tofile is to reside in if it
- ;; doesn't exist.
- (or (file-exists-p (file-name-directory tofile))
- (make-directory (file-name-directory tofile) 'parents))
;; If getting from mail spool directory,
;; use movemail to move rather than just renaming,
;; so as to interlock with the mailer.
- (or (setq popmail (string-match "^po:" (file-name-nondirectory inbox)))
- (setq movemail t))
- (if popmail (setq inbox (file-name-nondirectory inbox)))
- (if movemail
- ;; On some systems, /usr/spool/mail/foo is a directory
- ;; and the actual inbox is /usr/spool/mail/foo/foo.
- (if (file-directory-p inbox)
- (setq inbox (expand-file-name (user-login-name) inbox))))
+ (unless (setq popmail (string-match "^po:" (file-name-nondirectory inbox)))
+ (setq movemail t))
+ (when popmail
+ (setq inbox (file-name-nondirectory inbox)))
+ (when (and movemail
+ ;; On some systems, /usr/spool/mail/foo is a directory
+ ;; and the actual inbox is /usr/spool/mail/foo/foo.
+ (file-directory-p inbox))
+ (setq inbox (expand-file-name (user-login-name) inbox)))
(if popmail
(message "Getting mail from post office ...")
- (if (or (and (file-exists-p tofile)
- (/= 0 (nth 7 (file-attributes tofile))))
- (and (file-exists-p inbox)
- (/= 0 (nth 7 (file-attributes inbox)))))
- (message "Getting mail from %s..." inbox)))
+ (when (or (and (file-exists-p tofile)
+ (/= 0 (nth 7 (file-attributes tofile))))
+ (and (file-exists-p inbox)
+ (/= 0 (nth 7 (file-attributes inbox)))))
+ (message "Getting mail from %s..." inbox)))
;; Set TOFILE if have not already done so, and
;; rename or copy the file INBOX to TOFILE if and as appropriate.
- (cond ((or (file-exists-p tofile) (and (not popmail)
- (not (file-exists-p inbox))))
- nil)
+ (cond ((file-exists-p tofile)
+ ;; The crash box exists already.
+ t)
+ ((and (not popmail)
+ (not (file-exists-p inbox)))
+ ;; There is no inbox.
+ (setq tofile nil))
((and (not movemail) (not popmail))
;; Try copying. If that fails (perhaps no space),
;; rename instead.
(buffer-substring (point-min)
(point-max))))
(sit-for 3)
- nil)))))
+ (setq tofile nil))))))
(and errors
(buffer-name errors)
(kill-buffer errors))
group))
group))
+(defun nnmail-process-babyl-mail-format (func)
+ (let (start message-id content-length do-search end)
+ (while (not (eobp))
+ (goto-char (point-min))
+ (re-search-forward "\f\n0, *unseen,+\n\\*\\*\\* EOOH \\*\\*\\*\n" nil t)
+ (goto-char (match-end 0))
+ (delete-region (match-beginning 0) (match-end 0))
+ (setq start (point))
+ ;; Skip all the headers in case there are more "From "s...
+ (or (search-forward "\n\n" nil t)
+ (search-forward-regexp "^[^:]*\\( .*\\|\\)$" nil t)
+ (search-forward "\1f\f"))
+ ;; Find the Message-ID header.
+ (save-excursion
+ (if (re-search-backward "^Message-ID:[ \t]*\\(<[^>]*>\\)" nil t)
+ (setq message-id (buffer-substring (match-beginning 1)
+ (match-end 1)))
+ ;; There is no Message-ID here, so we create one.
+ (forward-line -1)
+ (insert "Message-ID: " (setq message-id (nnmail-message-id))
+ "\n")))
+ ;; Look for a Content-Length header.
+ (if (not (save-excursion
+ (and (re-search-backward
+ "^Content-Length: \\([0-9]+\\)" start t)
+ (setq content-length (string-to-int
+ (buffer-substring
+ (match-beginning 1)
+ (match-end 1))))
+ ;; We destroy the header, since none of
+ ;; the backends ever use it, and we do not
+ ;; want to confuse other mailers by having
+ ;; a (possibly) faulty header.
+ (progn (insert "X-") t))))
+ (setq do-search t)
+ (if (or (= (+ (point) content-length) (point-max))
+ (save-excursion
+ (goto-char (+ (point) content-length))
+ (looking-at "\1f")))
+ (progn
+ (goto-char (+ (point) content-length))
+ (setq do-search nil))
+ (setq do-search t)))
+ ;; Go to the beginning of the next article - or to the end
+ ;; of the buffer.
+ (if do-search
+ (if (re-search-forward "\n\1f" nil t)
+ (goto-char (+ 1 (match-beginning 0)))
+ (goto-char (- (point-max) 1))))
+ (delete-char 1) ; delete ^_
+ (save-excursion
+ (save-restriction
+ (narrow-to-region start (point))
+ (goto-char (point-min))
+ ;; If this is a duplicate message, then we do not save it.
+ (if (nnmail-cache-id-exists-p message-id)
+ (delete-region (point-min) (point-max))
+ (nnmail-cache-insert message-id)
+ (funcall func))
+ (setq end (point-max))))
+ (goto-char end))))
+
+(defun nnmail-process-unix-mail-format (func)
+ (let ((delim (concat "^" rmail-unix-mail-delimiter))
+ start message-id content-length end skip)
+ (if (not (and (re-search-forward delim nil t)
+ (goto-char (match-beginning 0))))
+ ;; Possibly wrong format?
+ (error "Found no mail!")
+ ;; Carry on until the bitter end.
+ (while (not (eobp))
+ (setq start (point)
+ end nil)
+ ;; Find the end of the head.
+ (narrow-to-region
+ start
+ (if (search-forward "\n\n" nil t)
+ (1- (point))
+ ;; This will never happen, but just to be on the safe side --
+ ;; if there is no head-body delimiter, we search a bit manually.
+ (while (and (looking-at "From \\|[^ \t]+:")
+ (not (eobp)))
+ (forward-line 1)
+ (point))))
+ ;; Find the Message-ID header.
+ (goto-char (point-min))
+ (if (re-search-forward "^Message-ID:[ \t]*\\(<[^>]+>\\)" nil t)
+ (setq message-id (match-string 1))
+ ;; There is no Message-ID here, so we create one.
+ (forward-line 1)
+ (insert "Message-ID: " (setq message-id (nnmail-message-id)) "\n"))
+ ;; Look for a Content-Length header.
+ (goto-char (point-min))
+ (when (re-search-forward "^Content-Length: \\([0-9]+\\)" nil t)
+ (setq content-length (string-to-int (match-string 1)))
+ ;; We destroy the header, since none of the backends ever
+ ;; use it, and we do not want to confuse other mailers by
+ ;; having a (possibly) faulty header.
+ (beginning-of-line)
+ (insert "X-"))
+ ;; Find the end of this article.
+ (goto-char (point-max))
+ (widen)
+ ;; We try the Content-Length value.
+ (when content-length
+ (forward-line 1)
+ (setq skip (+ (point) content-length))
+ (when (or (= skip (point-max))
+ (and (< skip (point-max))
+ (goto-char skip)
+ (looking-at delim)))
+ (setq end skip)))
+ (if end
+ (goto-char end)
+ ;; No Content-Length, so we find the beginning of the next
+ ;; article or the end of the buffer.
+ (if (re-search-forward delim nil t)
+ (goto-char (match-beginning 0))
+ (goto-char (point-max))))
+ ;; Allow the backend to save the article.
+ (save-excursion
+ (save-restriction
+ (narrow-to-region start (point))
+ (goto-char (point-min))
+ ;; If this is a duplicate message, then we do not save it.
+ (if (nnmail-cache-id-exists-p message-id)
+ (delete-region (point-min) (point-max))
+ (nnmail-cache-insert message-id)
+ (funcall func))
+ (setq end (point-max))))
+ (goto-char end)))))
+
+(defun nnmail-process-mmfd-mail-format (func)
+ (let ((delim "^\^A\^A\^A\^A$")
+ start message-id end)
+ (if (not (and (re-search-forward delim nil t)
+ (forward-line 1)))
+ ;; Possibly wrong format?
+ (error "Found no mail!")
+ ;; Carry on until the bitter end.
+ (while (not (eobp))
+ (setq start (point))
+ ;; Find the end of the head.
+ (narrow-to-region
+ start
+ (if (search-forward "\n\n" nil t)
+ (1- (point))
+ ;; This will never happen, but just to be on the safe side --
+ ;; if there is no head-body delimiter, we search a bit manually.
+ (while (and (looking-at "From \\|[^ \t]+:")
+ (not (eobp)))
+ (forward-line 1)
+ (point))))
+ ;; Find the Message-ID header.
+ (goto-char (point-min))
+ (if (re-search-forward "^Message-ID:[ \t]*\\(<[^>]+>\\)" nil t)
+ (setq message-id (match-string 1))
+ ;; There is no Message-ID here, so we create one.
+ (forward-line 1)
+ (insert "Message-ID: " (setq message-id (nnmail-message-id)) "\n"))
+ ;; Find the end of this article.
+ (goto-char (point-max))
+ (widen)
+ ;; We try the Content-Length value.
+ (if (re-search-forward delim nil t)
+ (beginning-of-line)
+ (goto-char (point-max)))
+ ;; Allow the backend to save the article.
+ (save-excursion
+ (save-restriction
+ (narrow-to-region start (point))
+ (goto-char (point-min))
+ ;; If this is a duplicate message, then we do not save it.
+ (if (nnmail-cache-id-exists-p message-id)
+ (delete-region (point-min) (point-max))
+ (nnmail-cache-insert message-id)
+ (funcall func))
+ (setq end (point-max))))
+ (goto-char end)))))
+
(defun nnmail-split-incoming (incoming func &optional exit-func group)
"Go through the entire INCOMING file and pick out each individual mail.
FUNC will be called with the buffer narrowed to each mail."
- (let ((delim (concat "^" rmail-unix-mail-delimiter))
- ;; If this is a group-specific split, we bind the split
+ (let (;; If this is a group-specific split, we bind the split
;; methods to just this group.
(nnmail-split-methods (if (and group
(or (eq nnmail-spool-file 'procmail)
(insert-file-contents incoming)
(goto-char (point-min))
(save-excursion (run-hooks 'nnmail-prepare-incoming-hook))
- ;; Go to the beginning of the first mail...
- (if (and (re-search-forward delim nil t)
- (goto-char (match-beginning 0)))
- ;; and then carry on until the bitter end.
- (while (not (eobp))
- (setq start (point))
- ;; Skip all the headers in case there are more "From "s...
- (if (not (search-forward "\n\n" nil t))
- (forward-line 1))
- ;; Find the Message-ID header.
- (save-excursion
- (if (re-search-backward "^Message-ID:[ \t]*\\(<[^>]*>\\)" nil t)
- (setq message-id (match-string 1))
- ;; There is no Message-ID here, so we create one.
- (forward-line -1)
- (insert "Message-ID: " (setq message-id (nnmail-message-id))
- "\n")))
- ;; Look for a Content-Length header.
- (if (not (save-excursion
- (when (re-search-backward
- "^Content-Length: \\([0-9]+\\)" start t)
- (setq content-length
- (string-to-int (match-string 1)))
- ;; We destroy the header, since none of
- ;; the backends ever use it, and we do not
- ;; want to confuse other mailers by having
- ;; a (possibly) faulty header.
- (insert "X-")
- t)))
- (setq do-search t)
- (if (or (= (+ (point) content-length) (point-max))
- (save-excursion
- (goto-char (+ (point) content-length))
- (looking-at delim)))
- (progn
- (goto-char (+ (point) content-length))
- (setq do-search nil))
- (setq do-search t)))
- ;; Go to the beginning of the next article - or to the end
- ;; of the buffer.
- (if do-search
- (if (re-search-forward delim nil t)
- (goto-char (match-beginning 0))
- (goto-char (point-max))))
- (save-excursion
- (save-restriction
- (narrow-to-region start (point))
- (goto-char (point-min))
- ;; If this is a duplicate message, then we do not save it.
- (if (nnmail-cache-id-exists-p message-id)
- (delete-region (point-min) (point-max))
- (nnmail-cache-insert message-id)
- (funcall func))
- (setq end (point-max))))
- (goto-char end)))
+ ;; Handle both babyl, MMFD and unix mail formats, since movemail will
+ ;; use the former when fetching from a mailbox, the latter when
+ ;; fetches from a file.
+ (cond ((looking-at "\^L")
+ (nnmail-process-babyl-mail-format func))
+ ((looking-at "\^A\^A\^A\^A")
+ (nnmail-process-mmfd-mail-format func))
+ (t
+ (nnmail-process-unix-mail-format func)))
;; Close the message-id cache.
(nnmail-cache-close)
(if exit-func (funcall exit-func))
(let ((methods nnmail-split-methods)
(obuf (current-buffer))
(beg (point-min))
- end group-art)
+ end group-art method)
(if (and (sequencep methods) (= (length methods) 1))
;; If there is only just one group to put everything in, we
;; just return a list with just this one method in.
;; Find headers.
(goto-char beg)
(setq end (if (search-forward "\n\n" nil t) (point) (point-max)))
- (set-buffer (get-buffer-create " *nnmail work*"))
- (buffer-disable-undo (current-buffer))
+ (set-buffer nntp-server-buffer)
(erase-buffer)
;; Copy the headers into the work buffer.
(insert-buffer-substring obuf beg end)
(replace-match " " t t))
(if (and (symbolp nnmail-split-methods)
(fboundp nnmail-split-methods))
+ ;; `nnmail-split-methods' is a function, so we just call
+ ;; this function here and use the result.
(setq group-art
(mapcar
(lambda (group) (cons group (funcall func group)))
(condition-case nil
(funcall nnmail-split-methods)
(error
- (message "\
-Problems with `nnmail-split-methods', using `bogus' mail group")
+ (message
+ "Error in `nnmail-split-methods'; using `bogus' mail group")
(sit-for 1)
'("bogus")))))
;; Go throught the split methods to find a match.
(while (and methods (or nnmail-crosspost (not group-art)))
(goto-char (point-max))
- (if (or (cdr methods)
- (not (equal "" (nth 1 (car methods)))))
- (if (and (condition-case ()
- (if (stringp (nth 1 (car methods)))
- (re-search-backward
- (car (cdr (car methods))) nil t)
- ;; Suggested by Brian Edmonds
- ;; <edmonds@cs.ubc.ca>.
- (funcall (nth 1 (car methods))
- (car (car methods))))
- (error nil))
- ;; Don't enter the article into the same group twice.
- (not (assoc (car (car methods)) group-art)))
- (setq group-art
- (cons (cons (car (car methods))
- (funcall func (car (car methods))))
- group-art)))
- (or group-art
- (setq group-art
- (list (cons (car (car methods))
- (funcall func (car (car methods))))))))
- (setq methods (cdr methods))))
- (kill-buffer (current-buffer))
+ (setq method (pop methods))
+ (if (or methods
+ (not (equal "" (nth 1 method))))
+ (when (and
+ (condition-case ()
+ (if (stringp (nth 1 method))
+ (re-search-backward (car (cdr method)) nil t)
+ ;; Function to say whether this is a match.
+ (funcall (nth 1 method) (car method)))
+ (error nil))
+ ;; Don't enter the article into the same
+ ;; group twice.
+ (not (assoc (car method) group-art)))
+ (push (cons (car method) (funcall func (car method)))
+ group-art))
+ ;; This is the final group, which is used as a
+ ;; catch-all.
+ (unless group-art
+ (setq group-art
+ (list (cons (car method)
+ (funcall func (car method)))))))))
group-art))))
(defun nnmail-insert-lines ()
- "Insert how many lines and chars there are in the body of the mail."
+ "Insert how many lines there are in the body of the mail.
+Return the number of characters in the body."
(let (lines chars)
(save-excursion
(goto-char (point-min))
- (if (search-forward "\n\n" nil t)
- (progn
- (setq chars (- (point-max) (point)))
- (setq lines (- (count-lines (point) (point-max)) 1))
- (forward-char -1)
- (save-excursion
- (if (re-search-backward "^Lines: " nil t)
- (delete-region (point) (progn (forward-line 1) (point)))))
- (insert (format "Lines: %d\n" lines))
- chars)))))
+ (when (search-forward "\n\n" nil t)
+ (setq chars (- (point-max) (point)))
+ (setq lines (- (count-lines (point) (point-max)) 1))
+ (forward-char -1)
+ (save-excursion
+ (when (re-search-backward "^Lines: " nil t)
+ (delete-region (point) (progn (forward-line 1) (point)))))
+ (insert (format "Lines: %d\n" lines))
+ chars))))
(defun nnmail-insert-xref (group-alist)
"Insert an Xref line based on the (group . article) alist."
(save-excursion
(goto-char (point-min))
- (if (search-forward "\n\n" nil t)
- (progn
- (forward-char -1)
- (if (re-search-backward "^Xref: " nil t)
- (delete-region (match-beginning 0)
- (progn (forward-line 1) (point))))
- (insert (format "Xref: %s" (system-name)))
- (while group-alist
- (insert (format " %s:%d" (car (car group-alist))
- (cdr (car group-alist))))
- (setq group-alist (cdr group-alist)))
- (insert "\n")))))
+ (when (search-forward "\n\n" nil t)
+ (forward-char -1)
+ (if (re-search-backward "^Xref: " nil t)
+ (delete-region (match-beginning 0)
+ (progn (forward-line 1) (point))))
+ (insert (format "Xref: %s" (system-name)))
+ (while group-alist
+ (insert (format " %s:%d" (car (car group-alist))
+ (cdr (car group-alist))))
+ (setq group-alist (cdr group-alist)))
+ (insert "\n"))))
;; Written by byer@mv.us.adobe.com (Scott Byer).
(defun nnmail-make-complex-temp-name (prefix)
(while (and (not done) (cdr split))
(setq split (cdr split)
done (nnmail-split-it (car split))))
- done)) ((assq split nnmail-split-cache)
- ;; A compiled match expression.
+ done))
+ ((assq split nnmail-split-cache)
+ ;; A compiled match expression.
(goto-char (point-max))
(if (re-search-backward (cdr (assq split nnmail-split-cache)) nil t)
(nnmail-split-it (nth 2 split))))
(defun nnmail-get-spool-files (&optional group)
(if (null nnmail-spool-file)
;; No spool file whatsoever.
- nil)
- (let* ((procmails
- ;; If procmail is used to get incoming mail, the files
- ;; are stored in this directory.
- (and (file-exists-p nnmail-procmail-directory)
- (directory-files
- nnmail-procmail-directory
- t (concat (if group group "")
- nnmail-procmail-suffix "$") t)))
- (p procmails))
- ;; Remove any directories that inadvertantly match the procmail
- ;; suffix, which might happen if the suffix is "".
- (while p
- (and (or (file-directory-p (car p))
- (file-symlink-p (car p)))
- (setq procmails (delete (car p) procmails)))
- (setq p (cdr p)))
- (cond ((listp nnmail-spool-file)
- (append nnmail-spool-file procmails))
- ((stringp nnmail-spool-file)
- (cons nnmail-spool-file procmails))
- (t
- procmails))))
+ nil
+ (let* ((procmails
+ ;; If procmail is used to get incoming mail, the files
+ ;; are stored in this directory.
+ (and (file-exists-p nnmail-procmail-directory)
+ (directory-files
+ nnmail-procmail-directory
+ t (concat (if group group "")
+ nnmail-procmail-suffix "$") t)))
+ (p procmails)
+ (crash (when (and (file-exists-p nnmail-crash-box)
+ (> (nth 7 (file-attributes nnmail-crash-box)) 0))
+ (list nnmail-crash-box))))
+ ;; Remove any directories that inadvertantly match the procmail
+ ;; suffix, which might happen if the suffix is "".
+ (while p
+ (and (or (file-directory-p (car p))
+ (file-symlink-p (car p)))
+ (setq procmails (delete (car p) procmails)))
+ (setq p (cdr p)))
+ ;; Return the list of spools.
+ (append
+ crash
+ (cond ((listp nnmail-spool-file)
+ (append nnmail-spool-file procmails))
+ ((stringp nnmail-spool-file)
+ (cons nnmail-spool-file procmails))
+ ((eq nnmail-spool-file 'pop)
+ (cons (format "po:%s" (user-login-name)) procmails))
+ (t
+ procmails))))))
;; Activate a backend only if it isn't already activated.
;; If FORCE, re-read the active file even if the backend is
"Read new incoming mail."
(let* ((spools (nnmail-get-spool-files group))
(group-in group)
- incoming incomings)
- (if (or (not (nnmail-get-value "%s-get-new-mail" method))
- (not nnmail-spool-file))
- () ; We don't want to look for new mail.
+ incoming incomings spool)
+ (when (and (nnmail-get-value "%s-get-new-mail" method)
+ nnmail-spool-file)
;; We first activate all the groups.
(nnmail-activate method)
;; The we go through all the existing spool files and split the
;; mail from each.
(while spools
- (and
- (file-exists-p (car spools))
- (> (nth 7 (file-attributes (car spools))) 0)
- (progn
- (and gnus-verbose-backends
- (message "%s: Reading incoming mail..." method))
- (if (not (setq incoming
- (nnmail-move-inbox
- (car spools)
- (concat temp "Incoming"))))
- () ; There is no new mail.
- (setq group (nnmail-get-split-group (car spools) group-in))
- (nnmail-split-incoming
- incoming (intern (format "%s-save-mail" method))
- spool-func group)
- (setq incomings (cons incoming incomings)))))
- (setq spools (cdr spools)))
+ (setq spool (pop spools))
+ ;; We read each spool file if either the spool is a POP-mail
+ ;; spool, or the file exists. We can't check for the
+ ;; existance of POPped mail.
+ (when (or (string-match "^po:" spool)
+ (and (file-exists-p spool)
+ (> (nth 7 (file-attributes spool)) 0)))
+ (when gnus-verbose-backends
+ (message "%s: Reading incoming mail..." method))
+ (when (and (nnmail-move-inbox spool)
+ (file-exists-p nnmail-crash-box))
+ ;; There is new mail. We first find out if all this mail
+ ;; is supposed to go to some specific group.
+ (setq group (nnmail-get-split-group spool group-in))
+ ;; We split the mail
+ (nnmail-split-incoming
+ nnmail-crash-box (intern (format "%s-save-mail" method))
+ spool-func group)
+ ;; Check whether the inbox is to be moved to the special tmp dir.
+ (setq incoming
+ (nnmail-make-complex-temp-name
+ (expand-file-name
+ (if nnmail-tmp-directory
+ (concat
+ (file-name-as-directory nnmail-tmp-directory)
+ (file-name-nondirectory (concat temp "Incoming")))
+ (concat temp "Incoming")))))
+ (rename-file nnmail-crash-box incoming t)
+ (push incoming incomings))))
;; If we did indeed read any incoming spools, we save all info.
(when incomings
(nnmail-save-active
(nnmail-get-value "%s-group-alist" method)
(nnmail-get-value "%s-active-file" method))
- (and exit-func (funcall exit-func))
+ (when exit-func
+ (funcall exit-func))
(run-hooks 'nnmail-read-incoming-hook)
- (and gnus-verbose-backends
- (message "%s: Reading incoming mail...done" method)))
+ (when gnus-verbose-backends
+ (message "%s: Reading incoming mail...done" method)))
+ ;; Delete all the temporary files.
(while incomings
- (setq incoming (car incomings))
+ (setq incoming (pop incomings))
(and nnmail-delete-incoming
(file-exists-p incoming)
(file-writable-p incoming)
- (delete-file incoming))
- (setq incomings (cdr incomings))))))
+ (delete-file incoming))))))
(provide 'nnmail)
(setq nnmbox-current-server server)))
(defun nnmbox-close-server (&optional server)
+ (setq nnmbox-current-server nil)
t)
(defun nnmbox-server-opened (&optional server)
"Called narrowed to an article."
(let* ((nnmail-split-methods
(if group (list (list group "")) nnmail-split-methods))
- (group-art (nreverse (nnmail-article-group 'nnmbox-active-number))))
+ (group-art (nreverse (nnmail-article-group 'nnmbox-active-number)))
+ (delim (concat "^" rmail-unix-mail-delimiter)))
+ (goto-char (point-min))
+ ;; This might come from somewhere else.
+ (unless (looking-at delim)
+ (insert "From nobody " (current-time-string) "\n")
+ (goto-char (point-min)))
+ ;; Quote all "From " lines in the article.
+ (forward-line 1)
+ (while (re-search-forward delim nil t)
+ (beginning-of-line)
+ (insert "> "))
(nnmail-insert-lines)
(nnmail-insert-xref group-art)
(nnmbox-insert-newsgroup-line group-art)
(setq nnmh-current-server server)))
(defun nnmh-close-server (&optional server)
+ (setq nnmh-current-server nil)
t)
(defun nnmh-server-opened (&optional server)
(setq nnml-current-server server)))
(defun nnml-close-server (&optional server)
+ (setq nnml-current-server nil)
t)
(defun nnml-server-opened (&optional server)
(nnsoup-write-active-file)
(nnsoup-write-replies)
(gnus-soup-save-areas)
- (while nnsoup-buffers
- (and (car nnsoup-buffers)
- (buffer-name (car nnsoup-buffers))
- (kill-buffer (car nnsoup-buffers)))
- (setq nnsoup-buffers (cdr nnsoup-buffers)))
+ ;; Kill all nnsoup buffers.
+ (let (buffer)
+ (while nnsoup-buffers
+ (setq buffer (cdr (pop nnsoup-buffers)))
+ (and buffer
+ (buffer-name buffer)
+ (kill-buffer buffer))))
(setq nnsoup-group-alist nil
nnsoup-current-group nil
nnsoup-current-server nil
t)
(defun nnsoup-close-group (group &optional server)
+ ;; Kill all nnsoup buffers.
+ (let ((buffers nnsoup-buffers)
+ elem)
+ (while buffers
+ (when (equal (car (setq elem (pop buffers))) group)
+ (setq nnsoup-buffers (delq elem nnsoup-buffers))
+ (and (cdr elem) (buffer-name (cdr elem))
+ (kill-buffer (cdr elem))))))
t)
(defun nnsoup-request-list (&optional server)
(save-excursion ; Load the file.
(set-buffer (get-buffer-create buffer-name))
(buffer-disable-undo (current-buffer))
- (setq nnsoup-buffers (cons (current-buffer) nnsoup-buffers))
+ (push (cons nnsoup-current-group (current-buffer)) nnsoup-buffers)
(insert-file-contents (concat nnsoup-directory file))
(current-buffer)))))
(match-end 1))))))))
active group lines ident elem min)
(set-buffer (get-buffer-create " *nnsoup work*"))
- (buffer-disable-undo)
+ (buffer-disable-undo (current-buffer))
(while files
(message "Doing %s..." (car files))
(erase-buffer)
(setq nnspool-current-server server)))
(defun nnspool-close-server (&optional server)
+ (setq nnspool-current-server nil)
t)
(defun nnspool-server-opened (&optional server)
(when (file-exists-p "~/.nntp-authinfo")
(save-excursion
(set-buffer (get-buffer-create " *authinfo*"))
- (buffer-disable-undo)
+ (buffer-disable-undo (current-buffer))
(erase-buffer)
(insert-file-contents "~/.nntp-authinfo")
(goto-char (point-min))
;; It is possible to change kanji-fileio-code in this hook.
(run-hooks 'nntp-server-hook)
(push proc nntp-opened-connections)
- nntp-server-process)))))
+ nntp-server-process)
+ (setq nntp-status-string (format "Couldn't open server %s" server))
+ nil))))
(defun nntp-open-network-stream (server)
(open-network-stream
(let ((unfetched (gnus-sorted-complement
articles (nreverse fetched-articles))))
(and unfetched
- (gnus-group-make-articles-read group unfetched nil))))
+ (gnus-group-make-articles-read group unfetched))))
;; The headers are ready for reading, so they are inserted into
;; the nntp-server-buffer, which is where Gnus expects to find
;; them.
"nnvirtual: LIST NEWSGROUPS is not implemented.")
nil)
-(defalias 'nnvirtual-request-post 'nntp-request-post)
-
\f
;;; Internal functions.
-;; Convert HEAD headers into NOV headers.
(defun nnvirtual-convert-headers ()
+ "Convert HEAD headers into NOV headers."
(save-excursion
(set-buffer nntp-server-buffer)
(let* ((gnus-newsgroup-dependencies (make-vector 100 0))
;;; easymenu.el - Easy menu support for Emacs 19 and XEmacs.
;;
-;; $Id: x-easymenu.el,v 2.1 1997/03/04 04:31:03 larsi Exp $
+;; $Id: x-easymenu.el,v 1.1 1995/11/26 04:01:08 steve Exp $
;;
;; LCD Archive Entry:
;; easymenu|Per Abrahamsen|abraham@iesd.auc.dk|
;; Easy menu support for XEmacs|
-;; $Date: 1997/03/04 04:31:03 $|$Revision: 2.1 $|~/misc/easymenu.el.gz|
+;; $Date: 1995/11/26 04:01:08 $|$Revision: 1.1 $|~/misc/easymenu.el.gz|
;; Copyright (C) 1992, 1993, 1994, 1995 Free Software Foundation, Inc.
;;
;;; easymenu.el ends here
;;; easymenu.el - Easy menu support for Emacs 19 and XEmacs.
;;
-;; $Id: easymenu.el,v 5.9 1995/02/14 19:44:00 amanda Exp $
+;; $Id: x-easymenu.el,v 1.1 1995/11/26 04:01:08 steve Exp $
;;
;; LCD Archive Entry:
;; easymenu|Per Abrahamsen|abraham@iesd.auc.dk|
;; Easy menu support for XEmacs|
-;; $Date: 1995/02/14 19:44:00 $|$Revision: 5.9 $|~/misc/easymenu.el.gz|
-
-;; Copyright (C) 1992, 1993, 1994, 1995 Free Software Foundation, Inc.
-;;
-;; This program is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
-;;
-;; This program is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-;;
-;; You should have received a copy of the GNU General Public License
-;; along with this program; if not, write to the Free Software
-;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
-
-;; Commentary:
-;;
-;; Easymenu allows you to define menus for both Emacs 19 and XEmacs.
-;;
-;; This file
-;; The advantages of using easymenu are:
-;;
-;; - Easier to use than either the Emacs 19 and XEmacs menu syntax.
-;;
-;; - Common interface for Emacs 18, Emacs 19, and XEmacs.
-;; (The code does nothing when run under Emacs 18).
-;;
-;; The public functions are:
-;;
-;; - Function: easy-menu-define SYMBOL MAPS DOC MENU
-;; SYMBOL is both the name of the variable that holds the menu and
-;; the name of a function that will present a the menu.
-;; MAPS is a list of keymaps where the menu should appear in the menubar.
-;; DOC is the documentation string for the variable.
-;; MENU is an XEmacs style menu description.
-;;
-;; See the documentation for easy-menu-define for details.
-;;
-;; - Function: easy-menu-change PATH NAME ITEMS
-;; Change an existing menu.
-;; The menu must already exist an be visible on the menu bar.
-;; PATH is a list of strings used for locating the menu on the menu bar.
-;; NAME is the name of the menu.
-;; ITEMS is a list of menu items, as defined in `easy-menu-define'.
-;;
-;; - Function: easy-menu-add MENU [ MAP ]
-;; Add MENU to the current menubar in MAP.
-;;
-;; - Function: easy-menu-remove MENU
-;; Remove MENU from the current menubar.
-;;
-;; Emacs 19 never uses `easy-menu-add' or `easy-menu-remove', menus
-;; automatically appear and disappear when the keymaps specified by
-;; the MAPS argument to `easy-menu-define' are activated.
-;;
-;; XEmacs will bind the map to button3 in each MAPS, but you must
-;; explicitly call `easy-menu-add' and `easy-menu-remove' to add and
-;; remove menus from the menu bar.
-
-;;; Code:
-
-;;;###autoload
-(defmacro easy-menu-define (symbol maps doc menu)
- "Define a menu bar submenu in maps MAPS, according to MENU.
-The arguments SYMBOL and DOC are ignored; they are present for
-compatibility only. SYMBOL is not evaluated. In other Emacs versions
-these arguments may be used as a variable to hold the menu data, and a
-doc string for that variable.
-
-The first element of MENU must be a string. It is the menu bar item name.
-The rest of the elements are menu items.
-
-A menu item is usually a vector of three elements: [NAME CALLBACK ENABLE]
-
-NAME is a string--the menu item name.
-
-CALLBACK is a command to run when the item is chosen,
-or a list to evaluate when the item is chosen.
-
-ENABLE is an expression; the item is enabled for selection
-whenever this expression's value is non-nil.
-
-Alternatively, a menu item may have the form:
-
- [ NAME CALLBACK [ KEYWORD ARG ] ... ]
-
-Where KEYWORD is one of the symbol defined below.
-
- :keys KEYS
-
-KEYS is a string; a complex keyboard equivalent to this menu item.
-
- :active ENABLE
-
-ENABLE is an expression; the item is enabled for selection
-whenever this expression's value is non-nil.
-
- :suffix NAME
-
-NAME is a string; the name of an argument to CALLBACK.
-
- :style STYLE
-
-STYLE is a symbol describing the type of menu item. The following are
-defined:
-
-toggle: A checkbox.
- Currently just prepend the name with the string \"Toggle \".
-radio: A radio button.
-nil: An ordinary menu item.
-
- :selected SELECTED
-
-SELECTED is an expression; the checkbox or radio button is selected
-whenever this expression's value is non-nil.
-Currently just disable radio buttons, no effect on checkboxes.
-
-A menu item can be a string. Then that string appears in the menu as
-unselectable text. A string consisting solely of hyphens is displayed
-as a solid horizontal line.
-
-A menu item can be a list. It is treated as a submenu.
-The first element should be the submenu name. That's used as the
-menu item in the top-level menu. The cdr of the submenu list
-is a list of menu items, as above."
- (` (progn
- (defvar (, symbol) nil (, doc))
- (easy-menu-do-define (quote (, symbol)) (, maps) (, doc) (, menu)))))
-
-(defun easy-menu-do-define (symbol maps doc menu)
- (set symbol menu)
- (fset symbol (list 'lambda '(e)
- doc
- '(interactive "@e")
- '(run-hooks 'activate-menubar-hook)
- '(setq zmacs-region-stays 't)
- (list 'popup-menu symbol)))
- (mapcar (function (lambda (map) (define-key map 'button3 symbol)))
- (if (keymapp maps) (list maps) maps)))
-
-(fset 'easy-menu-change (symbol-function 'add-menu))
-
-(defun easy-menu-add (menu &optional map)
- "Add MENU to the current menu bar."
- (cond ((null current-menubar)
- ;; Don't add it to a non-existing menubar.
- nil)
- ((assoc (car menu) current-menubar)
- ;; Already present.
- nil)
- ((equal current-menubar '(nil))
- ;; Set at left if only contains right marker.
- (set-buffer-menubar (list menu nil)))
- (t
- ;; Add at right.
- (set-buffer-menubar (copy-sequence current-menubar))
- (add-menu nil (car menu) (cdr menu)))))
-
-(defun easy-menu-remove (menu)
- "Remove MENU from the current menu bar."
- (and current-menubar
- (assoc (car menu) current-menubar)
- (delete-menu-item (list (car menu)))))
-
-(provide 'easymenu)
-
-;;; easymenu.el ends here
-;;; easymenu.el - Easy menu support for Emacs 19 and XEmacs.
-;;
-;; $Id: x-easymenu.el,v 2.1 1997/03/04 04:31:03 larsi Exp $
-;;
-;; LCD Archive Entry:
-;; easymenu|Per Abrahamsen|abraham@iesd.auc.dk|
-;; Easy menu support for XEmacs|
-;; $Date: 1997/03/04 04:31:03 $|$Revision: 2.1 $|~/misc/easymenu.el.gz|
+;; $Date: 1995/11/26 04:01:08 $|$Revision: 1.1 $|~/misc/easymenu.el.gz|
;; Copyright (C) 1992, 1993, 1994, 1995 Free Software Foundation, Inc.
;;
You should definitely byte-compile the source files. To do that, you
can simply say "make" in this directory. If you are using XEmacs, you
-*must* say "make EMACS=xemacs".
+*must* say "make EMACS=xemacs". If you use XEmacs 19.12 (or earlier)
+you should rename "lisp/x-easymenu.el" to "lisp/easymenu.el".
Then you have to tell Emacs where Gnus is. You might put something
like
+Fri Nov 24 13:38:25 1995 Lars Ingebrigtsen <lars@eyesore.no>
+
+ * gnus.texi (Formatting Variables): Addition.
+
+Thu Nov 23 10:37:59 1995 Lars Ingebrigtsen <lars@eyesore.no>
+
+ * gnus.texi (Listing Groups): Addition.
+ (Process/Prefix): Addition.
+ (nndoc): Addition.
+
+Wed Nov 22 08:57:14 1995 Lars Ingebrigtsen <lars@eyesore.no>
+
+ * gnus.texi (Topic Commands): New.
+ (Topic Topology): New.
+
+Tue Nov 21 16:45:33 1995 Lars Ingebrigtsen <lars@eyesore.no>
+
+ * gnus.texi (Formatting Variables): New.
+
+Sat Nov 18 07:21:01 1995 Lars Ingebrigtsen <lars@eyesore.no>
+
+ * gnus.texi (Group Parameters): Addition.
+
Mon Nov 13 00:14:30 1995 Lars Ingebrigtsen <lars@eyesore.no>
* gnus.texi (Various File Formats): New.
@item
GNU XEmacs support has been added by Fabrice Popineau.
@item
+POP mail support was written by Ken Raeburn.
+@item
Various bits and pieces, especially dealing with .newsrc files, were
suggested and added by Hallvard B Furuseth.
@item
@code{gnus-group-line-format} variable. This variable works along the
lines of a @code{format} specification, which is pretty much the same as
a @code{printf} specifications, for those of you who use (feh!) C.
-
-(All these format variables can also be random elisp forms. In that
-case, they will be @code{eval}ed to insert the required lines.)
-
-(All these format variables can also be random elisp forms. In that
-case, they will be @code{eval}ed to insert the required lines.)
-
-In addition to the normal "padding" specs that @code{format} supports
-(eg. @samp{%7d}), specifications like @samp{%7,12s} are allowed. A spec
-of this type means that the field will be at least 7 characters long,
-and never more that 12 characters long.
+@xref{Formatting Variables}.
The default value that produced those lines above is
@samp{"%M%S%5y: %(%g%)\n"}.
@kindex G f (Group)
@findex gnus-group-make-doc-group
Make a group based on some file or other
-(@code{gnus-group-make-doc-group}). You will be prompted for a file
-name and a file type. Currently supported types are @code{babyl},
-@code{mbox} and @code{digest}.
+(@code{gnus-group-make-doc-group}). If you give a prefix to this
+command, you will be prompted for a file name and a file type.
+Currently supported types are @code{babyl}, @code{mbox}, @code{digest},
+@code{mmfd}, and @code{forward}. If you run this command without a
+prefix, Gnus will guess at the file type.
@item G DEL
@kindex G DEL (Group)
@cindex documentation group
@cindex help group
-@code{nndoc} is a cute little thing that will let you read a single file as a
-newsgroup. Currently supported file types are @code{babyl}, @code{mbox}
-and @code{digest}.
+@code{nndoc} is a cute little thing that will let you read a single file
+as a newsgroup. Currently supported file types are @code{babyl} (the
+RMAIL file type), @code{mbox} (standard Unix mbox files), @code{digest}
+(various digests, MIME and otherwise), @code{mmfd} (the MMFD mail box
+format), and @code{forward} (a single forwarded mail). You can also use
+the special "file type" @code{guess}, which means that @code{nndoc} will
+try to guess what file type it is looking at.
@code{nndoc} will not try to change the file or insert any extra headers into
it---it will simply, like, let you use the file as the basis for a
@table @code
@item nndoc-article-type
@vindex nndoc-article-type
-This should be one of @code{mbox}, @code{babyl} or @code{digest}.
+This should be one of @code{mbox}, @code{babyl}, @code{digest},
+@code{mmfd}, @code{forward}, or @code{guess}.
@end table
programs, if you want to.
@vindex nnmail-spool-file
+@cindex POP mail
@code{nnmail-spool-file} says where to look for new mail. If this
variable is @code{nil}, the mail backends will never attempt to fetch
-mail by themselves. It is quite likely that Gnus supports POP-mail.
-Set this variable to begin with the string @samp{po:}, and everything
-should go smoothly, even though I have never tested this.
+mail by themselves. If you are using a POP mail server and your name is
+@samp{"larsi"}, you should set this variable to @samp{"po:larsi"}. If
+your name is not @samp{"larsi"}, you should probably modify that
+slightly, but you may have guessed that already, you smart & handsome
+devil! You can also set this variable to @code{pop}, and Gnus will try
+to figure out the POP mail string by itself.
When you use a mail backend, Gnus will slurp all your mail from your
inbox and plonk it down in your home directory. Gnus doesn't move any
If the group parameter list contains an element that looks like
@samp{(to-address . "some@@where.com")}, that address will be used by
the backend when doing followups and posts. This is primarily useful in
-mail groups that represent mailing lists. You just set this address to
-whatever the list address is.
+mail groups that represent close mailing lists. You just set this
+address to whatever the list address is.
This trick will actually work whether the group is foreign or not.
Let's say there's a group on the server that is called @samp{fa.4ad-l}.
impossible---you have to send mail to the mailing list address instead.
Also @xref{Mail & Post}.
+@item to-list
+@cindex to-list
+If the group parameter list has an element that looks like
+@samp{(to-list . "some@@where.com")}, that address will be used when
+doing a @kbd{a} in any group. It is totally ignored when doing a
+followup---except that if it is present in a news group, you'll get mail
+group semantics when doing @kbd{f}.
+
@item to-group
@cindex to-group
If the group parameter list contains an element like @code{(to-group
@end table
+@vindex gnus-permanently-visible-groups
+@cindex visible group paramenter
+Groups that match the @code{gnus-permanently-visible-groups} regexp will
+always be shown, whether they have unread articles or not. You can also
+add the @code{visible} element to the group parameters in question to
+get the same effect.
@node Sorting Groups
@section Sorting Groups
@end table
+When given a prefix, all these commands will sort in reverse order.
+
+
@node Group Maintenance
@section Group Maintenance
@cindex topics
If you read lots and lots of groups, it might be convenient to group
-them according to topics. You put your Emacs groups over here, your sex
-groups over there, and the rest (what, two groups or so?) you put in
-some misc section that you never bother with anyway.
-
-To get this @emph{fab} functionality:
-
-@lisp
-(setq gnus-group-prepare-function 'gnus-group-prepare-topics)
-@end lisp
+them hierarchically according to topics. You put your Emacs groups over
+here, your sex groups over there, and the rest (what, two groups or so?)
+you put in some misc section that you never bother with anyway. You can
+even group the Emacs sex groups as a sub-topic to either the Emacs
+groups or the sex groups---or both! Go wild!
+
+@findex gnus-topic-mode
+@kindex t (Group)
+To get this @emph{fab} functionality you simply turn on (ooh!) the
+@code{gnus-topic} minor mode---type @kbd{t} in the group buffer. (This
+is a toggling command.)
Go ahead, just try it. I'll still be here when you get back. La de
dum... Nice tune, that... la la la... What, you're back? Yes, and now
@samp{misc}. Doesn't that make you feel all warm and fuzzy? Hot and
bothered?
+If you want this permanently enabled, you should add that minor mode to
+the hook for the group mode:
+
+@lisp
+(add-hook 'gnus-group-mode 'gnus-topic-mode)
+@end lisp
+
+There are, in general, two methods for dividing the groups into topics.
+You can either sniff around some variables, or you can use some handy
+commands.
+
+@menu
+* Topic Variables:: How to customize the topics the Lisp Way.
+* Topic Commands:: Interactive E-Z commands.
+* Topic Topology:: A map of the world.
+@end menu
+
+
+@node Topic Variables
+@subsection Topic Variables
+@cindex topic variables
+
@vindex gnus-group-topics
-To get an even more exciting division, you have to fiddle with
-@code{gnus-group-topics}. That is an alist where each entry looks like
-this:
+
+@code{gnus-group-topics} is the main variable that specifies what topics
+each group belong to. That is an alist where each entry looks like
+this:
@lisp
(TOPIC REGEXP SHOW)
I'm sure you'll agree. This is all modified on a topic-by-topic basis
by the @var{show} parameter. It makes perfect sense, really.
-@vindex gnus-group-topic-face
-Topics are shown with @code{gnus-group-topic-face}.
-
@vindex gnus-topic-unique
If @code{gnus-topic-unique} is non-@code{nil}, each group will be member
of (tops) one topic each. If this is @code{nil}, each group might end
("The Rest" "." nil))
@end lisp
-If you want to add a group to a topic, you can use the @kbd{G t}
-(@code{gnus-group-add-to-topic}) command. It understands the
-process/prefix convention (@pxref{Process/Prefix}).
+@vindex gnus-topic-line-format
+The topic lines themselves are created according to the
+@code{gnus-topic-line-format} variable. @xref{Formatting Variables}.
+Elements allowed are:
+
+@table @samp
+@item i
+Indentation.
+@item n
+Topic name.
+@item v
+Visibility.
+@item l
+Level.
+@item g
+Number of groups in the topic.
+@item a
+Number of unread articles in the topic.
+@end table
+
+
+@node Topic Commands
+@subsection Topic Commands
+@cindex topic commands
+
+When the topic minor mode is turned on, a new @kbd{T} submap will be
+available. In addition, a few of the standard keys change their
+definitions slightly.
+
+@table @kbd
+
+@item T c
+@kindex T c (Group)
+@findex gnus-topic-create-topic
+Create a new topic (@code{gnus-topic-create-subtopic}). You will be
+prompted for a topic name and the name of the parent topic.
+
+@item T m
+@kindex T m (Group)
+@findex gnus-topic-move-to-topic
+Move the current group to some other topic
+(@code{gnus-topic-move-to-topic}). This command understands the
+process/prefix convention (@pxref{Process/Prefix}).
+
+@item RET
+@kindex RET (Group)
+@findex gnus-topic-select-group
+@itemx SPACE
+Either select a group or fold a topic (@code{gnus-topic-select-group}).
+When you perform this command on a group, you'll enter the group, as
+usual. When done on a topic line, the topic will be folded (if it was
+visible) or unfolded (if it was folded already). So it's basically a
+toggling command on topics. In addition, if you give a numerical
+prefix, group on that level (and lower) will be displayed.
+
+@item C-k
+@kindex C-k (Group)
+@findex gnus-topic-kill-group
+Kill a group or topic (@code{gnus-topic-kill-group}).
+
+@item C-y
+@kindex C-y (Group)
+@findex gnus-topic-yank-group
+Yank the previosuly killed group or topic (@code{gnus-topic-yank-group}).
+Note that all topics will be yanked before all groups.
+
+@end table
+
+
+@node Topic Topology
+@subsection Topic Topology
+@cindex topic topology
+@cindex topology
+
+So, let's have a look at an example group buffer:
+
+@example
+Gnus
+ Emacs -- I wuw it!
+ 3: comp.emacs
+ 2: alt.religion.emacs
+ Naughty Emacs
+ 452: alt.sex.emacs
+ 0: comp.talk.emacs.recovery
+ Misc
+ 8: comp.binaries.fractals
+ 13: comp.sources.unix
+@end example
+
+So, here we have one top-level topic, two topics under that, and one
+sub-topic under one of the sub-topics. (There is always just one (1)
+top-level topic). This topology can be expressed as follows:
+
+@lisp
+(("Gnus" visible)
+ (("Emacs -- I wuw it!" visible)
+ (("Naughty Emacs" visible)))
+ (("Misc" visible)))
+@end lisp
+
+This is in fact how the variable @code{gnus-topic-topology} would look
+for the display above. That variable is saved in the @file{.newsrc.eld}
+file, and shouldn't be messed with manually---unless you really want
+to. Since this variable is read from the @file{.newsrc.eld} file,
+setting it in any other startup files will have no effect.
+
+This topology shows what topics are sub-topics of what topics (right),
+and which topics are visible. Two settings are currently
+allowed---@code{visible} and @code{invisible}.
+
+@vindex gnus-topic-hide-subtopics
+If @code{gnus-topic-hide-subtopics} is non-@code{nil} (which it is by
+default), sub-topics will be folded along with any groups that belong to
+the topic. If this variable is @code{nil}, all topics will always be
+visible, even though the parent topics are folded.
-@kbd{A t} (@code{gnus-topic-toggle-topic} toggles between the normal
-flat group buffer display and the topic folded display.
@node Misc Group Stuff
@section Misc Group Stuff
@kindex s (Group)
@findex gnus-group-save-newsrc
Save the @file{.newsrc.eld} file (and @file{.newsrc} if wanted)
-(@code{gnus-group-save-newsrc}).
+(@code{gnus-group-save-newsrc}). If given a prefix, force saving the
+file(s) whether Gnus thinks it is necessary or not.
@item Z
@kindex Z (Group)
@findex gnus-group-clear-dribble
into the summary just like information from any other summary specifier.
@end table
-Text between @samp{%(} and @samp{%)} will be highlighted with
-@code{gnus-mouse-face} when the mouse point is placed inside the area.
-There can only be one such area.
-
The @samp{%U} (status), @samp{%R} (replied) and @samp{%z} (zcore) specs
have to be handled with care. For reasons of efficiency, Gnus will
compute what column these characters will end up in, and "hard-code"
negative, perform the operation on the previous N articles, starting
with the current one.
+If @code{transient-mark-mode} in non-@code{nil} and the region is
+active, all articles in the region will be worked upon.
+
If there is no numeric prefix, but some articles are marked with the
process mark, perform the operation on the articles that are marked with
the process mark.
@kindex A D (Summary)
@findex gnus-summary-enter-digest-group
If the current article is a digest, you might use this command to enter
-you into a group based on the current digest to ease reading
-(@code{gnus-summary-enter-digest-group}).
+a group based on the current digest
+(@code{gnus-summary-enter-digest-group}). Gnus will try to guess what
+article type is currently displayed unless you give a prefix to this
+command, which forces a "digest" interpretation.
+
@item C-t
@kindex C-t (Summary)
@findex gnus-summary-toggle-truncation
Toggle truncation of summary lines (@code{gnus-summary-toggle-truncation}).
+
@item =
@kindex = (Summary)
@findex gnus-summary-expand-window
If given a prefix, force an @code{article} window configuration.
@end table
+
@node The Article Buffer
@chapter The Article Buffer
@cindex article buffer
@menu
* Interactive:: Making Gnus ask you many questions.
+* Formatting Variables:: How to control the look of the buffers.
* Windows Configuration:: Configuring the Gnus buffer windows.
* Buttons:: Get tendonitis in ten easy steps!
* Compilation & Init File:: How to speed Gnus up.
@end table
+@node Formatting Variables
+@section Formatting Variables
+@cindex formatting variables
+
+Throughout this manual you've probably noticed lots of variables that
+are called things like @code{gnus-group-line-format} and
+@code{gnus-summary-mode-line-format}. These control how Gnus is to
+output lines in the various buffers. There's quite a lot of them.
+Fortunately, they all use the same syntax, so there's not that much to
+be annoyed by.
+
+Here's an example format spec (from the group buffer): @samp{"%M%S%5y:
+%(%g%)\n"}. We see that it is indeed extremely ugly, and that there are
+lots of percentages everywhere.
+
+Each @samp{%} element will be replaced by some string or other when the
+buffer in question is generated. @samp{%5y} means "insert the @samp{y}
+spec, and pad with spaces to get a 5-character field". Just like a
+normal format spec, almost.
+
+You can also say @samp{%6,4y}, which means that the field will never be
+more than 6 characters wide and never less than 4 characters wide.
+
+There are also specs for highlighting, and these are shared by all the
+format variables. Text inside the @samp{%(} and @samp{%)} specifiers
+will get the special @code{mouse-face} property set, which means that it
+will be highlighted (with @code{gnus-mouse-face}) when you put the mouse
+pointer over it.
+
+Text inside the @samp{%[} and @samp{%]} specifiers will have their
+normal faces set using @code{gnus-face-0}, which is @code{bold} by
+default. If you say @samp{%1[} instead, you'll get @code{gnus-face-1}
+instead, and so on. Create as many faces as you wish. The same goes
+for the @code{mouse-face} specs---you can say @samp{%3(hello%)} to have
+@samp{hello} mouse-highlighted with @code{gnus-mouse-face-3}.
+
+Here's an alternative recipe for the group buffer:
+
+@lisp
+;; Create three face types.
+(setq gnus-face-1 'bold)
+(setq gnus-face-3 'italic)
+
+;; We want the article count to be in
+;; a bold and green face. So we create
+;; a new face called `my-green-bold'.
+(copy-face 'bold 'my-green-bold)
+;; Set the color.
+(set-face-foreground 'my-green-bold "ForestGreen")
+(setq gnus-face-2 'my-green-bold)
+
+;; Set the new & fancy format.
+(setq gnus-group-line-format
+ "%M%S%3[%5y%]%2[:%] %(%1[%g%]%)\n")
+@end lisp
+
+I'm sure you'll be able to use this scheme to create totally unreadable
+and extremely vulgar displays. Have fun!
+
+Currently Gnus uses the following formatting variables:
+@code{gnus-group-line-format}, @code{gnus-summary-line-format},
+@code{gnus-server-line-format}, @code{gnus-topic-line-format},
+@code{gnus-group-mode-line-format},
+@code{gnus-summary-mode-line-format},
+@code{gnus-article-mode-line-format},
+@code{gnus-server-mode-line-format}.
+
+Note that the @samp{%(} specs (and friends) do not make any sense on the
+mode-line variables.
+
+All these format variables can also be random elisp forms. In that
+case, they will be @code{eval}ed to insert the required lines.
+
+@kindex M-x gnus-update-format
+@findex gnus-update-format
+Gnus includes a command to help you while creating your own format
+specs. @kbd{M-x gnus-update-format} will @code{eval} the current form,
+update the spec in question and pop you to a buffer where you can
+examine the resulting lisp code to be run to generate the line.
+
+
@node Windows Configuration
@section Windows Configuration
@cindex windows configuration
If you just need help, you are better off asking on
@samp{gnu.emacs.gnus}. I'm not very helpful.
+@cindex gnu.emacs.gnus
+@cindex ding mailing list
+You can also ask on the ding mailing list---samp{ding@@ifi.uio.no}.
+Write to @samp{ding-request@@ifi.uio.no} to subscribe.
+
@node The End
@chapter The End
projects / gnus / commitdiff