+Wed Jul 31 15:23:54 1996 Ken Olstad <ken@mn.cheyenne.com>
+
+ * gnus-xmas.el (gnus-xmas-redefine): Disbale XFace when running
+ under tty.
+
+Wed Jul 31 14:21:38 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
+
+ * gnus.el (gnus-group-read-group): Use `gnus-range-length' instead
+ of `length'.
+
+Fri Aug 2 21:48:17 1996 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus-dup.el (gnus-dup-suppress-articles): Wouldn't mark articles
+ properly.
+
+Fri Aug 2 21:40:33 1996 Glenn Coombs <glenn@prl.research.philips.com>
+
+ * gnus-vis.el (gnus-button-url): New definition.
+
+Fri Aug 2 19:08:55 1996 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus-group.el (gnus-update-read-articles): Moved here.
+
+ * gnus-sum.el (gnus-update-read-articles): Moved here.
+
+ * gnus-async.el (gnus-async-request-fetched-article): Would bug
+ out on Message-IDs.
+
+ * gnus-score.el (gnus-score-save): Would kill wrong buffer.
+
+ * nntp.el (nntp-process-filter): Insert at point-max.
+
+ * nnheader.el (nnheader-set-temp-buffer): Accept a noerase param.
+
+Fri Aug 2 00:14:16 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
+
+ * gnus-topic.el (gnus-topic-edit-parameters): New command.
+ (gnus-group-topic-parameters): New function.
+ (gnus-topic-set-parameters): New function.
+ (gnus-topic-parameters): New function.
+
+ * gnus-group.el (gnus-group-edit-group-done): Newish definition.
+
+ * gnus-srvr.el (gnus-server-edit-server): Use new edit function.
+ (gnus-server-edit-server-done): Removed.
+
+ * gnus-group.el: Use new edit function.
+
+ * gnus-eform.el (gnus-eform): New file.
+
+ * gnus-group.el (gnus-group-goto-group): Tippy-toe around some
+ more to find the most likely instance of the group.
+ (gnus-edit-form): New function.
+ (gnus-edit-form-mode): New command.
+ (gnus-edit-form-make-menu-bar): New function.
+ (gnus-edit-form-mode-hook): New variable.
+ (gnus-edit-form-exit): New command and keystroke.
+ (gnus-edit-form-done): Ditto.
+
+ * gnus-topic.el: Moved functions around.
+ (gnus-current-topic): Renamed.
+ (gnus-current-topics): New function.
+ (gnus-group-parent-topic): New function.
+
+ * article.el (gnus-signature-separator): New default.
+ (gnus-signature-limit): Extended value.
+ (article-narrow-to-signature): Use it.
+
+ * gnus-cite.el (gnus-cite-parse): Use new signature functions.
+
+ * article.el (article-search-signature): New function.
+ (gnus-signature-separator): Allow wider syntax.
+
+ * gnus-async.el (gnus-use-header-prefetch): New variable.
+ (gnus-async-set-article-buffer): Removed.
+ (gnus-async-prefetch-headers): New function.
+ (gnus-asynch-retrieve-fetched-headers): New function.
+ (gnus-async-prefetch-header-buffer): New variable.
+
+ * gnus-salt.el (gnus-summary-pick-line-format): New variable.
+ (gnus-pick-mode): Use it.
+ (gnus-pick-line-number): New function.
+ (gnus-pick-article): New command and keystroke.
+ (gnus-pick-mode-map): Changed " " to `gnus-pick-next-page'.
+ (gnus-pick-next-page): New command and keystroke.
+ (gnus-mark-unpicked-articles-as-read): New variable.
+ (gnus-pick-start-reading): Use it.
+
+ * gnus-sum.el (gnus-summary-line-format-alist): Add pick line
+ number.
+
+Thu Aug 1 23:32:15 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
+
+ * nntp.el (nntp-request-list): Decode.
+ (nntp-request-list-newsgroups): Ditto.
+
+ * gnus-gl.el (gnus-grouplens-mode): Update summary line specs.
+
+ * gnus-msg.el (gnus-debug): Would bug out.
+
+Thu Aug 1 23:24:48 1996 Glenn Coombs <glenn@prl.research.philips.com>
+
+ * gnus-sum.el (gnus-summary-update-mark): Work on hidden threads.
+
+Thu Aug 1 00:00:16 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
+
+ * gnus-score.el (gnus-score-save): Wouldn't save scores.
+
+ * gnus-load.el (gnus-summary-line-format): Moved here.
+
+ * gnus.el (gnus-alive-p): More thorough definition.
+ (gnus-info-set-entry): New macro.
+
+ * gnus-move.el: New file.
+ (gnus-move-group-to-server): New function.
+ (gnus-change-server): New command.
+ (gnus-group-move-group-to-server): New command.
+
+ * gnus-start.el (gnus-parse-active): New function.
+
+ * gnus.el (gnus-read-method): Mew function.
+ * gnus-group.el: Use it.
+
+ * gnus-load.el (gnus-suppress-duplicates): New variable.
+
+ * gnus-dup.el: New file.
+
+ * gnus-sum.el (gnus-data-read-p): New macro.
+ (gnus-duplicate-mark): New variable.
+
+Wed Jul 31 23:09:35 1996 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+
+ * gnus.el: Red Gnus v0.3 is released.
+
Wed Jul 31 21:38:08 1996 Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
* nntp.el (nntp-retrieve-headers-with-xover): Didn't work.
Possible values in this list are `empty', `newsgroups', `followup-to',
`reply-to', and `date'.")
-(defvar gnus-signature-separator "^-- *$"
- "Regexp matching signature separator.")
+(defvar gnus-signature-separator '("^-- $" "^-- *$")
+ "Regexp matching signature separator.
+This can also be a list of regexps. In that case, it will be checked
+from head to tail looking for a separator. Searches will be done from
+the end of the buffer.")
(defvar gnus-signature-limit nil
"Provide a limit to what is considered a signature.
If it is a number, no signature may not be longer (in characters) than
-that number. If it is a function, the function will be called without
-any parameters, and if it returns nil, there is no signature in the
-buffer. If it is a string, it will be used as a regexp. If it
-matches, the text in question is not a signature.")
+that number. If it is a floating point number, no signature may be
+longer (in lines) than that number. If it is a function, the function
+will be called without any parameters, and if it returns nil, there is
+no signature in the buffer. If it is a string, it will be used as a
+regexp. If it matches, the text in question is not a signature.")
(defvar gnus-hidden-properties '(invisible t intangible t)
"Property list to use for hiding text.")
(defun article-narrow-to-signature ()
"Narrow to the signature."
(widen)
- (if (and (boundp 'mime::preview/content-list)
- mime::preview/content-list)
- (let ((pcinfo (car (last mime::preview/content-list))))
- (condition-case ()
- (narrow-to-region
- (funcall (intern "mime::preview-content-info/point-min") pcinfo)
- (point-max))
- (error nil))))
- (goto-char (point-max))
- (when (re-search-backward gnus-signature-separator nil t)
+ (when (and (boundp 'mime::preview/content-list)
+ mime::preview/content-list)
+ ;; We have a MIMEish article, so we use the MIME data to narrow.
+ (let ((pcinfo (car (last mime::preview/content-list))))
+ (condition-case ()
+ (narrow-to-region
+ (funcall (intern "mime::preview-content-info/point-min") pcinfo)
+ (point-max))
+ (error nil))))
+
+ (when (article-search-signature)
(forward-line 1)
- (when (or (null gnus-signature-limit)
- (and (numberp gnus-signature-limit)
- (< (- (point-max) (point)) gnus-signature-limit))
- (and (gnus-functionp gnus-signature-limit)
- (funcall gnus-signature-limit))
- (and (stringp gnus-signature-limit)
- (not (re-search-forward gnus-signature-limit nil t))))
- (narrow-to-region (point) (point-max))
- t)))
+ ;; Check whether we have some limits to what we consider
+ ;; to be a signature.
+ (let ((limits (if (listp gnus-signature-limit) gnus-signature-limit
+ (list gnus-signature-limit)))
+ limit limited)
+ (while (setq limit (pop limits))
+ (if (or (and (integerp limit)
+ (< (- (point-max) (point)) limit))
+ (and (floatp limit)
+ (< (count-lines (point) (point-max)) limit))
+ (and (gnus-functionp limit)
+ (funcall limit))
+ (and (stringp limit)
+ (not (re-search-forward limit nil t))))
+ () ; This limit did not succeed.
+ (setq limited t
+ limits nil)))
+ (unless limited
+ (narrow-to-region (point) (point-max))
+ t))))
+
+(defun article-search-signature ()
+ "Search the current buffer for the signature separator.
+Put point at the beginning of the signature separator."
+ (let ((cur (point)))
+ (goto-char (point-max))
+ (if (if (stringp gnus-signature-separator)
+ (re-search-backward gnus-signature-separator nil t)
+ (let ((seps gnus-signature-separator))
+ (while (and seps
+ (not (re-search-backward (car seps) nil t)))
+ (pop seps))
+ seps))
+ t
+ (goto-char cur)
+ nil)))
(defun article-hidden-arg ()
"Return the current prefix arg as a number, or 0 if no prefix."
that all articles belonging to a group are removed on exit
from that group.")
+(defvar gnus-use-header-prefetch nil
+ "*If non-nil, prefetch the headers to the next group.")
+
;;; Internal variables.
+(defvar gnus-async-prefetch-article-buffer " *Async Prefetch Article*")
(defvar gnus-async-article-alist nil)
-(defvar gnus-async-prefetch-article-buffer " *Async Prefetch Article*")
+(defvar gnus-async-prefetch-headers-buffer " *Async Prefetch Headers*")
+(defvar gnus-asynch-header-prefetched nil)
;;; Utility functions.
"Say whether GROUP is fetched from a server that supports asynchronocity."
(gnus-asynchronous-p (gnus-find-method-for-group group)))
+;;;
;;; Article prefetch
+;;;
(gnus-add-shutdown 'gnus-async-close 'gnus)
(defun gnus-async-close ()
(gnus-kill-buffer gnus-async-prefetch-article-buffer)
- (setq gnus-async-article-alist nil))
-
-(defun gnus-async-set-prefetch-buffer ()
- (if (get-buffer gnus-async-prefetch-article-buffer)
- (set-buffer gnus-async-prefetch-article-buffer)
- (set-buffer (get-buffer-create gnus-async-prefetch-article-buffer))
- (buffer-disable-undo (current-buffer))
- (gnus-add-current-to-buffer-list)))
+ (gnus-kill-buffer gnus-async-prefetch-headers-buffer)
+ (setq gnus-async-article-alist nil
+ gnus-asynch-header-prefetched nil))
(defun gnus-async-prefetch-next (group article summary)
"Possibly prefetch several articles starting with the article after ARTICLE."
(set-buffer summary)
(let ((next (caadr (gnus-data-find-list article)))
mark)
- (gnus-async-set-prefetch-buffer)
+ (nnheader-set-temp-buffer gnus-async-prefetch-article-buffer t)
(goto-char (point-max))
(setq mark (point-marker))
(let ((nnheader-callback-function
`(lambda (arg)
(save-excursion
- (gnus-async-set-prefetch-buffer)
+ (nnheader-set-temp-buffer
+ gnus-async-prefetch-article-buffer t)
(push (list ',(intern (format "%s-%d" group article))
,mark (set-marker (make-marker) (point-max))
,group ,article)
(defun gnus-async-request-fetched-article (group article buffer)
"See whether we have ARTICLE from GROUP and put it in BUFFER."
- (let ((entry (gnus-async-prefetched-article-entry group article)))
- (when entry
- (save-excursion
- (gnus-async-set-prefetch-buffer)
- (copy-to-buffer buffer (cadr entry) (caddr entry))
- ;; Remove the read article from the prefetch buffer.
- (when (memq 'read gnus-prefetched-article-deletion-strategy)
- (gnus-asynch-delete-prefected-entry entry))
- ;; Decode the article. Perhaps this shouldn't be done
- ;; here?
- (set-buffer buffer)
- (nntp-decode-text)
- (goto-char (point-min))
- (gnus-delete-line)
- t))))
+ (when (numberp article)
+ (let ((entry (gnus-async-prefetched-article-entry group article)))
+ (when entry
+ (save-excursion
+ (nnheader-set-temp-buffer gnus-async-prefetch-article-buffer t)
+ (copy-to-buffer buffer (cadr entry) (caddr entry))
+ ;; Remove the read article from the prefetch buffer.
+ (when (memq 'read gnus-prefetched-article-deletion-strategy)
+ (gnus-asynch-delete-prefected-entry entry))
+ ;; Decode the article. Perhaps this shouldn't be done
+ ;; here?
+ (set-buffer buffer)
+ (nntp-decode-text)
+ (goto-char (point-min))
+ (gnus-delete-line)
+ t)))))
(defun gnus-asynch-delete-prefected-entry (entry)
"Delete ENTRY from buffer and alist."
(memq 'exit gnus-prefetched-article-deletion-strategy))
(let ((alist gnus-async-article-alist))
(save-excursion
- (gnus-async-set-prefetch-buffer)
+ (nnheader-set-temp-buffer gnus-async-prefetch-article-buffer t)
(while alist
(when (equal group (nth 3 (car alist)))
(gnus-asynch-delete-prefected-entry (car alist)))
(assq (intern (format "%s-%d" group article))
gnus-async-article-alist))
+;;;
+;;; Header prefetch
+;;;
+
+(defun gnus-async-prefetch-headers (group)
+ "Prefetch the headers for group GROUP."
+ (save-excursion
+ (let (unread)
+ (when (and gnus-use-header-prefetch
+ (gnus-group-asynchronous-p group)
+ (listp gnus-asynch-header-prefetched)
+ (setq unread (gnus-list-of-unread-articles group)))
+ ;; Mark that a fetch is in progress.
+ (setq gnus-asynch-header-prefetched t)
+ (nnheader-set-temp-buffer gnus-async-prefetch-headers-buffer t)
+ (erase-buffer)
+ (let ((nntp-server-buffer (current-buffer))
+ (nnheader-callback-function
+ `(lambda (arg)
+ (setq gnus-asynch-header-prefetched
+ ,(cons group unread)))))
+ (gnus-retrieve-headers unread group gnus-fetch-old-headers))))))
+
+(defun gnus-asynch-retrieve-fetched-headers (articles group)
+ "See whether we have prefetched headers."
+ (when (and gnus-use-header-prefetch
+ (gnus-group-asynchronous-p group)
+ (listp gnus-asynch-header-prefetched)
+ (equal group (car gnus-asynch-header-prefetched))
+ (equal articles (cdr gnus-asynch-header-prefetched)))
+ (save-excursion
+ (nnheader-set-temp-buffer gnus-async-prefetch-headers-buffer t)
+ (nntp-decode-text)
+ (copy-to-buffer nntp-server-buffer (point-min) (point-max))
+ (erase-buffer)
+ (setq gnus-asynch-header-prefetched nil)
+ t)))
+
(provide 'gnus-async)
;;; gnus-async.el ends here
(require 'gnus-load)
(require 'gnus-int)
(require 'gnus-range)
+(require 'gnus-sum)
+(require 'gnus-start)
(require 'gnus)
(defvar gnus-cache-directory
(search-forward "\n\n" nil t)
(push (cons (point-marker) "") marks)
(goto-char (point-max))
- (re-search-backward gnus-signature-separator nil t)
+ (article-search-signature)
(push (cons (point-marker) "") marks)
(setq marks (sort marks (lambda (m1 m2) (< (car m1) (car m2)))))
(let* ((omarks marks))
(hiden 0)
total)
(goto-char (point-max))
- (re-search-backward gnus-signature-separator nil t)
+ (article-search-signature)
(setq total (count-lines start (point)))
(while atts
(setq hiden (+ hiden (length (cdr (assoc (cdar atts)
(case-fold-search t)
(max (save-excursion
(goto-char (point-max))
- (re-search-backward gnus-signature-separator nil t)
+ (article-search-signature)
(point)))
alist entry start begin end numbers prefix)
;; Get all potential prefixes in `alist'.
--- /dev/null
+;;; gnus-dup.el --- suppression of duplicate articles in Gnus
+;; Copyright (C) 1996 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, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; This package tries to mark articles as read the second time the
+;; user reads a copy. This is useful if the server doesn't support
+;; Xref properly, or if the user reads the same group from several
+;; servers.
+
+;;; Code:
+
+(require 'gnus-load)
+(require 'gnus-art)
+(require 'gnus)
+
+(defvar gnus-save-duplicate-list nil
+ "*If non-nil, save the duplicate list when shutting down Gnus.
+If nil, duplicate suppression will only work on duplicates
+seen in the same session.")
+
+(defvar gnus-duplicate-list-length 10000
+ "*The number of Message-IDs to keep in the duplicate suppression list.")
+
+(defvar gnus-duplicate-file (nnheader-concat gnus-directory "suppression")
+ "*The name of the file to store the duplicate suppression list.")
+
+;;; Internal variables
+
+(defvar gnus-dup-list nil)
+(defvar gnus-dup-hashtb nil)
+
+;;;
+;;; Starting and stopping
+;;;
+
+(gnus-add-shutdown 'gnus-dup-close 'gnus)
+
+(defun gnus-dup-close ()
+ "Possibly save the duplicate suppression list and shut down the subsystem."
+ (when gnus-save-duplicate-list
+ (gnus-dup-save))
+ (setq gnus-dup-list nil
+ gnus-dup-hashtb nil))
+
+(defun gnus-dup-open ()
+ "Possibly read the duplicate suppression list and start the subsystem."
+ (if gnus-save-duplicate-list
+ (gnus-dup-read)
+ (setq gnus-dup-list nil))
+ (setq gnus-dup-hashtb (gnus-make-hashtable gnus-duplicate-list-length))
+ ;; Enter all Message-IDs into the hash table.
+ (let ((list gnus-dup-list)
+ (obarray gnus-dup-hashtb))
+ (while list
+ (intern (pop list)))))
+
+(defun gnus-dup-read ()
+ "Read the duplicate suppression list."
+ (setq gnus-dup-list nil)
+ (when (file-exists-p gnus-duplicate-file)
+ (load gnus-duplicate-file t t t)))
+
+(defun gnus-dup-save ()
+ "Save the duplicate suppression list."
+ (nnheader-temp-write gnus-duplicate-file
+ (prin1 `(setq gnus-duplicate-file ',gnus-duplicate-file)
+ (current-buffer))))
+
+;;;
+;;; Interface functions
+;;;
+
+(defun gnus-dup-enter-articles ()
+ "Enter articles from the current group for future duplicate suppression."
+ (unless gnus-dup-list
+ (gnus-dup-open))
+ (let ((data gnus-newsgroup-data)
+ id)
+ ;; Enter the Message-IDs of all read articles into the list
+ ;; and hash table.
+ (while data
+ (when (gnus-data-read-p (car data))
+ (intern (car (push (mail-header-id (gnus-data-header (car data)))
+ gnus-dup-list))
+ gnus-dup-hashtb))
+ (pop data))
+ ;; Chop off excess Message-IDs from the list.
+ (let ((end (nthcdr gnus-duplicate-list-length gnus-dup-list)))
+ (when end
+ (setcdr end nil)))))
+
+(defun gnus-dup-suppress-articles ()
+ "Mark duplicate articles as read."
+ (unless gnus-dup-list
+ (gnus-dup-open))
+ (let ((headers gnus-newsgroup-headers)
+ number)
+ (while headers
+ (when (intern-soft (mail-header-id (car headers)) gnus-dup-hashtb)
+ (setq gnus-newsgroup-unreads
+ (delq (setq number (mail-header-number (car headers)))
+ gnus-newsgroup-unreads))
+ (push (cons number gnus-duplicate-mark)
+ gnus-newsgroup-reads))
+ (pop headers))))
+
+(provide 'gnus-dup)
+
+;;; gnus-dup.el ends here
--- /dev/null
+;;; gnus-eform.el --- a mode for editing forms for Gnus
+;; Copyright (C) 1996 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, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'gnus-load)
+(require 'gnus-win)
+(require 'gnus)
+
+;;;
+;;; Editing forms
+;;;
+
+(defvar gnus-edit-form-mode-hook nil
+ "Hook run in `gnus-edit-form-mode' buffers.")
+
+(defvar gnus-edit-form-menu-hook nil
+ "Hook run when creating menus in `gnus-edit-form-mode' buffers.")
+
+;;; Internal variables
+
+(defvar gnus-edit-form-done-function nil)
+(defvar gnus-edit-form-buffer "*Gnus edit form*")
+
+(defvar gnus-edit-form-mode-map nil)
+(unless gnus-edit-form-mode-map
+ (set gnus-edit-form-mode-map (copy-keymap emacs-lisp-mode-map))
+ (gnus-define-keys gnus-edit-form-mode-map
+ "\C-c\C-c" gnus-edit-form-done
+ "\C-c\C-k" gnus-edit-form-exit))
+
+(defun gnus-edit-form-make-menu-bar ()
+ (unless (boundp 'gnus-edit-form-menu)
+ (easy-menu-define
+ gnus-edit-form-menu gnus-edit-form-mode-map ""
+ '("Edit Form"
+ ["Exit and save changes" gnus-edit-form-done t]
+ ["Exit" gnus-edit-form-exit t]))
+ (run-hooks 'gnus-edit-form-menu-hook)))
+
+(defun gnus-edit-form-mode ()
+ "Major mode for editing forms.
+It is a slightly enhanced emacs-lisp-mode.
+
+\\{gnus-edit-form-mode-map}"
+ (interactive)
+ (when (and menu-bar-mode
+ (gnus-visual-p 'group-menu 'menu))
+ (gnus-edit-form-make-menu-bar))
+ (kill-all-local-variables)
+ (setq major-mode 'gnus-edit-form-mode)
+ (setq mode-name "Edit Form")
+ (use-local-map gnus-edit-form-mode-map)
+ (make-local-variable 'gnus-edit-form-done-function)
+ (make-local-variable 'gnus-prev-winconf)
+ (run-hooks 'gnus-edit-form-mode-hook))
+
+(defun gnus-edit-form (form documentation exit-func)
+ "Edit FORM in a new buffer.
+Call EXIT-FUNC on exit. Display DOCUMENTATION in the beginning
+of the buffer."
+ (let ((winconf (current-window-configuration)))
+ (set-buffer (setq gnus-edit-form-buffer
+ (get-buffer-create gnus-edit-form-buffer)))
+ (gnus-configure-windows 'edit-form)
+ (gnus-add-current-to-buffer-list)
+ (gnus-edit-form-mode)
+ (setq gnus-prev-winconf winconf)
+ (setq gnus-edit-form-done-function exit-func)
+ (erase-buffer)
+ (insert documentation)
+ (unless (bolp)
+ (insert "\n"))
+ (goto-char (point-min))
+ (while (not (eobp))
+ (insert ";;; ")
+ (forward-line 1))
+ (insert ";; Type `C-c C-c' after you've finished editing.\n")
+ (insert "\n")
+ (let ((p (point)))
+ (pp form (current-buffer))
+ (insert "\n")
+ (goto-char p))))
+
+(defun gnus-edit-form-done ()
+ "Update changes and kill the current buffer."
+ (interactive)
+ (goto-char (point-min))
+ (let ((form (read (current-buffer))))
+ (gnus-edit-form-exit)
+ (funcall gnus-edit-form-done-function form)))
+
+(defun gnus-edit-form-exit ()
+ "Kill the current buffer."
+ (interactive)
+ (let ((winconf gnus-prev-winconf))
+ (kill-buffer (current-buffer))
+ (set-window-configuration winconf)))
+
+(provide 'gnus-eform)
+
+;;; gnus-eform.el ends here
(setq gnus-summary-line-format
gnus-summary-grouplens-line-format)
(make-local-variable 'gnus-summary-line-format-spec)
- (setq gnus-summary-line-format-spec nil)
+ (setq gnus-summary-line-format nil)
+ (gnus-update-format-specifications nil 'summary)
+ (gnus-update-summary-mark-positions)
;; Set up the menu.
(when (and menu-bar-mode
"*Default listing level.
Ignored if `gnus-group-use-permanent-levels' is non-nil.")
-(defvar gnus-group-use-permanent-levels nil
- "*If non-nil, once you set a level, Gnus will use this level.")
-
(defvar gnus-group-list-inactive-groups t
"*If non-nil, inactive groups will be listed.")
"Function to override finding the next group after listing groups.")
(defvar gnus-group-edit-buffer nil)
+(defvar gnus-edit-form-buffer nil)
(defvar gnus-group-line-format-alist
`((?M gnus-tmp-marked-mark ?c)
(- (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)))))))
+ (zerop (+ number (gnus-range-length
+ (cdr (assq 'tick marked)))
+ (gnus-range-length
+ (cdr (assq 'dormant marked)))))))
no-article)))
(defun gnus-group-select-group (&optional all)
(defun gnus-group-goto-group (group)
"Goto to newsgroup GROUP."
(when group
- ;; It's quite likely that we are on the right line, so
- ;; we check the current line first.
(beginning-of-line)
- (if (eq (get-text-property (point) 'gnus-group)
- (gnus-intern-safe group gnus-active-hashtb))
- (point)
+ (cond
+ ;; It's quite likely that we are on the right line, so
+ ;; we check the current line first.
+ ((eq (get-text-property (point) 'gnus-group)
+ (gnus-intern-safe group gnus-active-hashtb))
+ (point))
+ ;; Previous and next line are also likely, so we check them as well.
+ ((save-excursion
+ (forward-line -1)
+ (eq (get-text-property (point) 'gnus-group)
+ (gnus-intern-safe group gnus-active-hashtb)))
+ (forward-line -1)
+ (point))
+ ((save-excursion
+ (forward-line 1)
+ (eq (get-text-property (point) 'gnus-group)
+ (gnus-intern-safe group gnus-active-hashtb)))
+ (forward-line 1)
+ (point))
+ (t
;; Search through the entire buffer.
- (let ((b (text-property-any
- (point-min) (point-max)
- 'gnus-group (gnus-intern-safe group gnus-active-hashtb))))
- (when b
- (goto-char b))))))
+ (gnus-goto-char
+ (text-property-any
+ (point-min) (point-max)
+ 'gnus-group (gnus-intern-safe group gnus-active-hashtb)))))))
(defun gnus-group-next-group (n &optional silent)
"Go to next N'th newsgroup.
The user will be prompted for a NAME, for a select METHOD, and an
ADDRESS."
(interactive
- (cons
+ (list
(read-string "Group name: ")
- (let ((method
- (completing-read
- "Method: " (append gnus-valid-select-methods gnus-server-alist)
- nil t nil 'gnus-method-history)))
- (cond
- ((equal method "")
- (setq method gnus-select-method))
- ((assoc method gnus-valid-select-methods)
- (list method
- (if (memq 'prompt-address
- (assoc method gnus-valid-select-methods))
- (read-string "Address: ")
- "")))
- ((assoc method gnus-server-alist)
- (list method))
- (t
- (list method ""))))))
+ (gnus-read-server "From method: ")))
(let* ((meth (when (and method
(not (gnus-server-equal method gnus-select-method)))
(defun gnus-group-edit-group (group &optional part)
"Edit the group on the current line."
(interactive (list (gnus-group-group-name)))
- (let* ((part (or part 'info))
- (done-func `(lambda ()
- "Exit editing mode and update the information."
- (interactive)
- (gnus-group-edit-group-done ',part ,group)))
- (winconf (current-window-configuration))
- info)
- (or group (error "No group on current line"))
- (or (setq info (gnus-get-info group))
- (error "Killed group; can't be edited"))
- (set-buffer (setq gnus-group-edit-buffer
- (get-buffer-create
- (format "*Gnus edit %s*" group))))
- (gnus-configure-windows 'edit-group)
- (gnus-add-current-to-buffer-list)
- (emacs-lisp-mode)
- ;; Suggested by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>.
- (use-local-map (copy-keymap emacs-lisp-mode-map))
- (local-set-key "\C-c\C-c" done-func)
- (make-local-variable 'gnus-prev-winconf)
- (setq gnus-prev-winconf winconf)
- (erase-buffer)
- (insert
- (cond
- ((eq part 'method)
- ";; Type `C-c C-c' after editing the select method.\n\n")
- ((eq part 'params)
- ";; Type `C-c C-c' after editing the group parameters.\n\n")
- ((eq part 'info)
- ";; Type `C-c C-c' after editing the group info.\n\n")))
- (insert
- (pp-to-string
- (cond ((eq part 'method)
- (or (gnus-info-method info) "native"))
- ((eq part 'params)
- (gnus-info-params info))
- (t info)))
- "\n")))
+ (let ((part (or part 'info))
+ info)
+ (unless group
+ (error "No group on current line"))
+ (unless (setq info (gnus-get-info group))
+ (error "Killed group; can't be edited"))
+ (gnus-edit-form
+ ;; Find the proper form to edit.
+ (cond ((eq part 'method)
+ (or (gnus-info-method info) "native"))
+ ((eq part 'params)
+ (gnus-info-params info))
+ (t info))
+ ;; The proper documentation.
+ (format
+ "Editing the %s."
+ (cond
+ ((eq part 'method) "select method")
+ ((eq part 'params) "group parameters")
+ (t "group info")))
+ `(lambda (form)
+ (gnus-group-edit-group-done ',part ,group form)))))
(defun gnus-group-edit-group-method (group)
"Edit the select method of GROUP."
(interactive (list (gnus-group-group-name)))
(gnus-group-edit-group group 'params))
-(defun gnus-group-edit-group-done (part group)
- "Get info from buffer, update variables and jump to the group buffer."
- (when (and gnus-group-edit-buffer
- (buffer-name gnus-group-edit-buffer))
- (set-buffer gnus-group-edit-buffer)
- (goto-char (point-min))
- (let* ((form (read (current-buffer)))
- (winconf gnus-prev-winconf)
- (method (cond ((eq part 'info) (nth 4 form))
- ((eq part 'method) form)
- (t nil)))
- (info (cond ((eq part 'info) form)
- ((eq part 'method) (gnus-get-info group))
+(defun gnus-group-edit-group-done (part group form)
+ "Update variables."
+ (let* ((method (cond ((eq part 'info) (nth 4 form))
+ ((eq part 'method) form)
(t nil)))
- (new-group (if info
- (if (or (not method)
- (gnus-server-equal
- gnus-select-method method))
- (gnus-group-real-name (car info))
- (gnus-group-prefixed-name
- (gnus-group-real-name (car info)) method))
- nil)))
- (when (and new-group
- (not (equal new-group group)))
- (when (gnus-group-goto-group group)
- (gnus-group-kill-group 1))
- (gnus-activate-group new-group))
- ;; Set the info.
- (if (and info new-group)
- (progn
- (setq info (gnus-copy-sequence info))
- (setcar info new-group)
- (unless (gnus-server-equal method "native")
- (unless (nthcdr 3 info)
- (nconc info (list nil nil)))
- (unless (nthcdr 4 info)
- (nconc info (list nil)))
- (gnus-info-set-method info method))
- (gnus-group-set-info info))
- (gnus-group-set-info form (or new-group group) part))
- (kill-buffer (current-buffer))
- (and winconf (set-window-configuration winconf))
- (set-buffer gnus-group-buffer)
- (gnus-group-update-group (or new-group group))
- (gnus-group-position-point))))
+ (info (cond ((eq part 'info) form)
+ ((eq part 'method) (gnus-get-info group))
+ (t nil)))
+ (new-group (if info
+ (if (or (not method)
+ (gnus-server-equal
+ gnus-select-method method))
+ (gnus-group-real-name (car info))
+ (gnus-group-prefixed-name
+ (gnus-group-real-name (car info)) method))
+ nil)))
+ (when (and new-group
+ (not (equal new-group group)))
+ (when (gnus-group-goto-group group)
+ (gnus-group-kill-group 1))
+ (gnus-activate-group new-group))
+ ;; Set the info.
+ (if (not (and info new-group))
+ (gnus-group-set-info form (or new-group group) part)
+ (setq info (gnus-copy-sequence info))
+ (setcar info new-group)
+ (unless (gnus-server-equal method "native")
+ (unless (nthcdr 3 info)
+ (nconc info (list nil nil)))
+ (unless (nthcdr 4 info)
+ (nconc info (list nil)))
+ (gnus-info-set-method info method))
+ (gnus-group-set-info info))
+ (gnus-group-update-group (or new-group group))
+ (gnus-group-position-point)))
(defun gnus-group-make-help-group ()
"Create the Gnus documentation group."
(defun gnus-group-set-params-info (group params)
(gnus-group-set-info params group 'params))
+(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 killed))
+ marked m)
+ (or (not info)
+ (and (not (setq marked (nthcdr 3 info)))
+ (or (null articles)
+ (setcdr (nthcdr 2 info)
+ (list (list (cons type (gnus-compress-sequence
+ articles t)))))))
+ (and (not (setq m (assq type (car marked))))
+ (or (null articles)
+ (setcar marked
+ (cons (cons type (gnus-compress-sequence articles t) )
+ (car marked)))))
+ (if force
+ (if (null articles)
+ (setcar (nthcdr 3 info)
+ (delq (assq type (car marked)) (car marked)))
+ (setcdr m (gnus-compress-sequence articles t)))
+ (setcdr m (gnus-compress-sequence
+ (sort (nconc (gnus-uncompress-range (cdr m))
+ (copy-sequence articles)) '<) t))))))
+
+(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 `<'.
+Returns whether the updating was successful."
+ (let* ((active (or gnus-newsgroup-active (gnus-active group)))
+ (entry (gnus-gethash group gnus-newsrc-hashtb))
+ (info (nth 2 entry))
+ (prev 1)
+ (unread (sort (copy-sequence unread) '<))
+ read)
+ (if (or (not info) (not active))
+ ;; There is no info on this group if it was, in fact,
+ ;; killed. Gnus stores no information on killed groups, so
+ ;; there's nothing to be done.
+ ;; One could store the information somewhere temporarily,
+ ;; perhaps... Hmmm...
+ ()
+ ;; Remove any negative articles numbers.
+ (while (and unread (< (car unread) 0))
+ (setq unread (cdr unread)))
+ ;; Remove any expired article numbers
+ (while (and unread (< (car unread) (car active)))
+ (setq unread (cdr unread)))
+ ;; Compute the ranges of read articles by looking at the list of
+ ;; unread articles.
+ (while unread
+ (if (/= (car unread) prev)
+ (setq read (cons (if (= prev (1- (car unread))) prev
+ (cons prev (1- (car unread)))) read)))
+ (setq prev (1+ (car unread)))
+ (setq unread (cdr unread)))
+ (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))
+ ;; Set the number of unread articles in gnus-newsrc-hashtb.
+ (gnus-get-unread-articles-in-group info (gnus-active group))
+ t)))
+
(provide 'gnus-group)
;;; gnus-group.el ends here
;; Stream is already opened.
nil
;; Open NNTP server.
- (if (null gnus-nntp-service) (setq gnus-nntp-server nil))
- (if confirm
- (progn
- ;; Read server name with completion.
- (setq gnus-nntp-server
- (completing-read "NNTP server: "
- (mapcar (lambda (server) (list server))
- (cons (list gnus-nntp-server)
- gnus-secondary-servers))
- nil nil gnus-nntp-server))))
-
- (if (and gnus-nntp-server
- (stringp gnus-nntp-server)
- (not (string= gnus-nntp-server "")))
- (setq gnus-select-method
- (cond ((or (string= gnus-nntp-server "")
- (string= gnus-nntp-server "::"))
- (list 'nnspool (system-name)))
- ((string-match "^:" gnus-nntp-server)
- (list 'nnmh gnus-nntp-server
- (list 'nnmh-directory
- (file-name-as-directory
- (expand-file-name
- (concat "~/" (substring
- gnus-nntp-server 1)))))
- (list 'nnmh-get-new-mail nil)))
- (t
- (list 'nntp gnus-nntp-server)))))
+ (unless gnus-nntp-service
+ (setq gnus-nntp-server nil))
+ (when confirm
+ ;; Read server name with completion.
+ (setq gnus-nntp-server
+ (completing-read "NNTP server: "
+ (mapcar (lambda (server) (list server))
+ (cons (list gnus-nntp-server)
+ gnus-secondary-servers))
+ nil nil gnus-nntp-server)))
+
+ (when (and gnus-nntp-server
+ (stringp gnus-nntp-server)
+ (not (string= gnus-nntp-server "")))
+ (setq gnus-select-method
+ (cond ((or (string= gnus-nntp-server "")
+ (string= gnus-nntp-server "::"))
+ (list 'nnspool (system-name)))
+ ((string-match "^:" gnus-nntp-server)
+ (list 'nnmh gnus-nntp-server
+ (list 'nnmh-directory
+ (file-name-as-directory
+ (expand-file-name
+ (concat "~/" (substring
+ gnus-nntp-server 1)))))
+ (list 'nnmh-get-new-mail nil)))
+ (t
+ (list 'nntp gnus-nntp-server)))))
(setq how (car gnus-select-method))
- (cond ((eq how 'nnspool)
- (require 'nnspool)
- (gnus-message 5 "Looking up local news spool..."))
- ((eq how 'nnmh)
- (require 'nnmh)
- (gnus-message 5 "Looking up mh spool..."))
- (t
- (require 'nntp)))
+ (cond
+ ((eq how 'nnspool)
+ (require 'nnspool)
+ (gnus-message 5 "Looking up local news spool..."))
+ ((eq how 'nnmh)
+ (require 'nnmh)
+ (gnus-message 5 "Looking up mh spool..."))
+ (t
+ (require 'nntp)))
(setq gnus-current-select-method gnus-select-method)
(run-hooks 'gnus-open-server-hook)
(or
that case, just return a fully prefixed name of the group --
\"nnml+private:mail.misc\", for instance.")
+(defvar gnus-secondary-servers nil
+ "*List of NNTP servers that the user can choose between interactively.
+To make Gnus query you for a server, you have to give `gnus' a
+non-numeric prefix - `C-u M-x gnus', in short.")
+
+(defvar gnus-nntp-server nil
+ "*The name of the host running the NNTP server.
+This variable is semi-obsolete. Use the `gnus-select-method'
+variable instead.")
+
(defvar gnus-secondary-select-methods nil
"*A list of secondary methods that will be used for reading news.
This is a list where each element is a complete select method (see
(defvar gnus-use-nocem nil
"*If non-nil, Gnus will read NoCeM cancel messages.")
+(defvar gnus-suppress-duplicates nil
+ "*If non-nil, Gnus will mark duplicate copies of the same article as read.")
+
(defvar gnus-use-demon nil
"If non-nil, Gnus might use some demons.")
(defvar gnus-group-uncollapsed-levels 1
"Number of group name elements to leave alone when making a short group name.")
+(defvar gnus-group-use-permanent-levels nil
+ "*If non-nil, once you set a level, Gnus will use this level.")
+
;; Hooks.
(defvar gnus-load-hook nil
("pp" pp pp-to-string pp-eval-expression)
("mail-extr" mail-extract-address-components)
("nnmail" nnmail-split-fancy nnmail-article-group)
- ("nnvirtual" nnvirtual-catchup-group)
+ ("nnvirtual" nnvirtual-catchup-group nnvirtual-convert-headers)
("timezone" timezone-make-date-arpa-standard timezone-fix-time
timezone-make-sortable-date timezone-make-time-string)
("rmailout" rmail-output)
("gnus-group" gnus-group-insert-group-line gnus-group-quit
gnus-group-list-groups gnus-group-first-unread-group
gnus-group-set-mode-line gnus-group-set-info gnus-group-save-newsrc
- gnus-group-setup-buffer gnus-group-get-new-news)
+ gnus-group-setup-buffer gnus-group-get-new-news
+ gnus-group-make-help-group gnus-group-update-group)
("gnus-bcklg" gnus-backlog-request-article gnus-backlog-enter-article
gnus-backlog-remove-article)
("gnus-art" gnus-article-read-summary-keys gnus-article-save
gnus-article-hide-pem gnus-article-hide-signature
gnus-article-strip-leading-blank-lines gnus-article-date-local
gnus-article-date-original gnus-article-date-lapsed
- gnus-decode-rfc1522 gnus-article-show-all-headers)
+ gnus-decode-rfc1522 gnus-article-show-all-headers
+ gnus-article-edit-mode)
("gnus-int" gnus-request-type)
- ("gnus-start" gnus-newsrc-parse-options gnus-1 gnus-no-server-1)
+ ("gnus-start" gnus-newsrc-parse-options gnus-1 gnus-no-server-1
+ gnus-dribble-enter)
+ ("gnus-dup" gnus-dup-suppress-articles gnus-dup-enter-articles)
("gnus-range" gnus-copy-sequence)
("gnus-vm" gnus-vm-mail-setup)
+ ("gnus-eform" gnus-edit-form)
+ ("gnus-move" :interactive t
+ gnus-group-move-group-to-server gnus-change-server)
("gnus-logic" gnus-score-advanced)
("gnus-async" gnus-async-request-fetched-article gnus-async-prefetch-next
gnus-async-prefetch-article gnus-async-prefetch-remove-group)
("gnus-vm" :interactive t gnus-summary-save-in-vm
gnus-summary-save-article-vm))))
+;;; gnus-sum.el thingies
+
+
+(defvar gnus-summary-line-format "%U\%R\%z\%I\%(%[%4L: %-20,20n%]%) %s\n"
+ "*The format specification of the lines in the summary buffer.
+
+It works along the same lines as a normal formatting string,
+with some simple extensions.
+
+%N Article number, left padded with spaces (string)
+%S Subject (string)
+%s Subject if it is at the root of a thread, and \"\" otherwise (string)
+%n Name of the poster (string)
+%a Extracted name of the poster (string)
+%A Extracted address of the poster (string)
+%F Contents of the From: header (string)
+%x Contents of the Xref: header (string)
+%D Date of the article (string)
+%d Date of the article (string) in DD-MMM format
+%M Message-id of the article (string)
+%r References of the article (string)
+%c Number of characters in the article (integer)
+%L Number of lines in the article (integer)
+%I Indentation based on thread level (a string of spaces)
+%T A string with two possible values: 80 spaces if the article
+ is on thread level two or larger and 0 spaces on level one
+%R \"A\" if this article has been replied to, \" \" otherwise (character)
+%U Status of this article (character, \"R\", \"K\", \"-\" or \" \")
+%[ Opening bracket (character, \"[\" or \"<\")
+%] Closing bracket (character, \"]\" or \">\")
+%> Spaces of length thread-level (string)
+%< Spaces of length (- 20 thread-level) (string)
+%i Article score (number)
+%z Article zcore (character)
+%t Number of articles under the current thread (number).
+%e Whether the thread is empty or not (character).
+%l GroupLens score (string).
+%P The line number (number).
+%u User defined specifier. The next character in the format string should
+ be a letter. Gnus will call the function gnus-user-format-function-X,
+ where X is the letter following %u. The function will be passed the
+ current header as argument. The function should return a string, which
+ will be inserted into the summary just like information from any other
+ summary specifier.
+
+Text between %( and %) will be highlighted with `gnus-mouse-face'
+when the mouse point is placed inside the area. There can only be one
+such area.
+
+The %U (status), %R (replied) and %z (zcore) specs have to be handled
+with care. For reasons of efficiency, Gnus will compute what column
+these characters will end up in, and \"hard-code\" that. This means that
+it is illegal to have these specs after a variable-length spec. Well,
+you might not be arrested, but your summary buffer will look strange,
+which is bad enough.
+
+The smart choice is to have these specs as for to the left as
+possible.
+
+This restriction may disappear in later versions of Gnus.")
+
;;;
;;; Skeleton keymaps
;;;
--- /dev/null
+;;; gnus-move.el --- commands for moving Gnus from one server to another
+;; Copyright (C) 1996 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, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'gnus-load)
+(require 'gnus-start)
+(require 'gnus-int)
+(require 'gnus-range)
+(require 'gnus)
+
+;;;
+;;; Moving by comparing Message-ID's.
+;;;
+
+;;;###autoload
+(defun gnus-change-server (from-server to-server)
+ "Move from FROM-SERVER to TO-SERVER.
+Update the .newsrc.eld file to reflect the change of nntp server."
+ (interactive
+ (list gnus-select-method (gnus-read-server "Move to method: ")))
+
+ ;; First start Gnus.
+ (let ((gnus-activate-level 0)
+ (nnmail-spool-file nil))
+ (gnus))
+
+ (save-excursion
+ ;; Go through all groups and translate.
+ (let ((newsrc gnus-newsrc-alist)
+ (nntp-nov-gap nil)
+ info)
+ (while (setq info (pop newsrc))
+ (when (gnus-group-native-p (gnus-info-group info))
+ (gnus-move-group-to-server info from-server to-server))))))
+
+(defun gnus-move-group-to-server (info from-server to-server)
+ "Move group INFO from FROM-SERVER to TO-SERVER."
+ (let ((group (gnus-info-group info))
+ to-active hashtb type mark marks
+ to-article to-reads to-marks article)
+ (gnus-message 7 "Translating %s..." group)
+ (when (gnus-request-group group nil to-server)
+ (setq to-active (gnus-parse-active)
+ hashtb (make-vector 1023 0))
+ ;; Fetch the headers from the `to-server'.
+ (when (setq type (gnus-retrieve-headers
+ (car to-active) (cdr to-active)))
+ ;; Convert HEAD headers. I don't care.
+ (when (eq type 'headers)
+ (nnvirtual-convert-headers))
+ ;; Create a mapping from Message-ID to article number.
+ (set-buffer nntp-server-buffer)
+ (goto-char (point-min))
+ (while (looking-at
+ "^[0-9]+\t[^\t]*\t[^\t]*\t[^\t]*\t\\([^\t]*\\)\t"
+ nil t)
+ (gnus-sethash
+ (buffer-substring (match-beginning 1) (match-end 1))
+ (read (current-buffer))
+ hashtb)
+ (forward-line 1))
+ ;; Then we read the headers from the `from-server'.
+ (when (and (gnus-request-group group nil from-server)
+ (gnus-active group)
+ (setq type (gnus-retrieve-headers
+ (car (gnus-active group))
+ (cdr (gnus-active group)))))
+ ;; Make it easier to map marks.
+ (let ((mark-lists (gnus-info-marks info))
+ ms type m)
+ (while mark-lists
+ (setq type (caar mark-lists)
+ ms (gnus-uncompress-range (cdr (pop mark-lists))))
+ (while ms
+ (if (setq m (assq (car ms) marks))
+ (setcdr m (cons type (cdr m)))
+ (push (list (car ms) type) marks))
+ (pop ms))))
+ ;; Convert.
+ (when (eq type 'headers)
+ (nnvirtual-convert-headers))
+ ;; Go through the headers and map away.
+ (set-buffer nntp-server-buffer)
+ (goto-char (point-min))
+ (while (looking-at
+ "^[0-9]+\t[^\t]*\t[^\t]*\t[^\t]*\t\\([^\t]*\\)\t"
+ nil t)
+ (setq to-article
+ (gnus-gethash
+ (buffer-substring (match-beginning 1) (match-end 1))
+ hashtb))
+ ;; Add this article to the list of read articles.
+ (push to-article to-reads)
+ ;; See if there are any marks and then add them.
+ (when (setq mark (assq (read (current-buffer)) marks))
+ (setq marks (delq mark marks))
+ (setcar mark to-article)
+ (push mark to-marks))
+ (forward-line 1))
+ ;; Now we know what the read articles are and what the
+ ;; article marks are. We transform the information
+ ;; into the Gnus info format.
+ (setq to-reads
+ (gnus-range-add
+ (gnus-compress-sequence (sort to-reads '<) t)
+ (cons 1 (1- (car to-active)))))
+ (gnus-info-set-read info to-reads)
+ ;; Do the marks. I'm sure y'all understand what's
+ ;; going on down below, so I won't bother with any
+ ;; further comments. <duck>
+ (let ((mlists gnus-article-mark-lists)
+ lists ms a)
+ (while mlists
+ (push (list (cdr (pop mlists))) lists))
+ (while (setq ms (pop marks))
+ (setq article (pop ms))
+ (while ms
+ (setcdr (setq a (assq (pop ms) lists))
+ (cons article (cdr a)))))
+ (setq a lists)
+ (while a
+ (setcdr (car a) (gnus-compress-sequence (sort (cdar a) '<)))
+ (pop a))
+ (gnus-info-set-marks info lists)))))
+ (gnus-message 7 "Translating %s...done" group)))
+
+(defun gnus-group-move-group-to-server (info from-server to-server)
+ "Move the group on the current line from FROM-SERVER to TO-SERVER."
+ (interactive
+ (let ((info (gnus-get-info (gnus-group-group-name))))
+ (list info (gnus-find-method-for-group (gnus-info-group info))
+ (gnus-read-server (format "Move group %s to method: "
+ (gnus-info-group info))))))
+ (save-excursion
+ (gnus-move-group-to-server info from-server to-server)
+ ;; We have to update the group info to point use the right server.
+ (gnus-info-set-method info to-server t)
+ ;; We also have to change the name of the group and stuff.
+ (let* ((group (gnus-info-group info))
+ (new-name (gnus-group-prefixed-name
+ (gnus-group-real-name group) to-server)))
+ (gnus-info-set-group info new-name)
+ (gnus-sethash new-name (gnus-gethash group gnus-newsrc-hashtb)
+ gnus-newsrc-hashtb)
+ (gnus-sethash group nil gnus-newsrc-hashtb))))
+
+(provide 'gnus-move)
+
+;;; gnus-move.el ends here
"Attemps to go through the Gnus source file and report what variables have been changed.
The source file has to be in the Emacs load path."
(interactive)
- (let ((files '("gnus.el" "gnus-msg.el" "gnus-score.el" "nnmail.el"
- "message.el"))
+ (let ((files '("gnus-sum.el" "gnus-group.el"
+ "gnus-art.el" "gnus-start.el"
+ "gnus-msg.el" "gnus-score.el"
+ "nnmail.el" "message.el"))
file dirs expr olist sym)
(gnus-message 4 "Please wait while we snoop your variables...")
(sit-for 0)
sublist nil)))
sublistp))
+(defun gnus-range-add (range1 range2)
+ "Add RANGE2 to RANGE1 destructively."
+ (cond
+ ;; If either are nil, then the job is quite easy.
+ ((or (null range1) (null range2))
+ (or range1 range2))
+ (t
+ ;; I don't like thinking.
+ (gnus-compress-sequence
+ (sort
+ (nconc
+ (gnus-uncompress-range range1)
+ (gnus-uncompress-range range2))
+ '<)))))
+
(provide 'gnus-range)
;;; gnus-range.el ends here
(defvar gnus-pick-mode-hook nil
"Hook run in summary pick mode buffers.")
+(defvar gnus-mark-unpicked-articles-as-read nil
+ "*If non-nil, mark all unpicked articles as read.")
+
+(defvar gnus-summary-pick-line-format
+ "%-5p %U\%R\%z\%I\%(%[%4L: %-20,20n%]%) %s\n"
+ "*The format specification of the lines in pick buffers.
+It accepts the same format specs that `gnus-summary-line-format' does.")
+
;;; Internal variables.
(defvar gnus-pick-mode-map nil)
gnus-pick-mode-map
"t" gnus-uu-mark-thread
"T" gnus-uu-unmark-thread
- " " gnus-summary-mark-as-processable
+ " " gnus-pick-next-page
"u" gnus-summary-unmark-as-processable
"U" gnus-summary-unmark-all-processable
"v" gnus-uu-mark-over
"E" gnus-uu-mark-by-regexp
"b" gnus-uu-mark-buffer
"B" gnus-uu-unmark-buffer
+ "." gnus-pick-article
"\r" gnus-pick-start-reading))
(defun gnus-pick-make-menu-bar ()
;; Make sure that we don't select any articles upon group entry.
(make-local-variable 'gnus-auto-select-first)
(setq gnus-auto-select-first nil)
+ ;; Change line format.
+ (make-local-variable 'gnus-summary-line-format)
+ (setq gnus-summary-line-format
+ gnus-summary-pick-line-format)
+ (make-local-variable 'gnus-summary-line-format-spec)
+ (setq gnus-summary-line-format nil)
+ (gnus-update-format-specifications nil 'summary)
+ (gnus-update-summary-mark-positions)
;; Set up the menu.
(when (and menu-bar-mode
(gnus-visual-p 'pick-menu 'menu))
minor-mode-map-alist))
(run-hooks 'gnus-pick-mode-hook))))
+(defvar gnus-pick-line-number 1)
+(defun gnus-pick-line-number ()
+ "Return the current line number."
+ (if (bobp)
+ (setq gnus-pick-line-number 1)
+ (incf gnus-pick-line-number)))
+
(defun gnus-pick-start-reading (&optional catch-up)
"Start reading the picked articles.
If given a prefix, mark all unpicked articles as read."
(unless gnus-newsgroup-processable
(error "No articles have been picked"))
(gnus-summary-limit-to-articles nil)
- (when catch-up
+ (when (or catch-up gnus-mark-unpicked-articles-as-read)
(gnus-summary-limit-mark-excluded-as-read))
(gnus-summary-first-unread-article)
(gnus-configure-windows (if gnus-pick-display-summary 'article 'pick) t))
+(defun gnus-pick-article (&optional arg)
+ "Pick the article on the current line.
+If ARG, pick the article on that line instead."
+ (interactive "P")
+ (when arg
+ (let (pos)
+ (save-excursion
+ (goto-char (point-min))
+ (when (zerop (forward-line (1- (prefix-numeric-value arg))))
+ (setq pos (point))))
+ (if (not pos)
+ (gnus-error 2 "No such line: %s" arg)
+ (goto-char pos))))
+ (gnus-summary-mark-as-processable 1))
+
+(defun gnus-pick-next-page ()
+ "Go to the next page. If at the end of the buffer, start reading articles."
+ (interactive)
+ (condition-case ()
+ (scroll-up)
+ (gnus-pick-start-reading)))
;;;
;;; gnus-binary-mode
(let ((score (gnus-score-default score))
(header (format "%s" (downcase header)))
new)
- (and prompt (setq match (read-string
- (format "Match %s on %s, %s: "
- (cond ((eq date 'now)
- "now")
- ((stringp date)
- "temp")
- (t "permanent"))
- header
- (if (< score 0) "lower" "raise"))
- (if (numberp match)
- (int-to-string match)
- match))))
+ (when prompt
+ (setq match (read-string
+ (format "Match %s on %s, %s: "
+ (cond ((eq date 'now)
+ "now")
+ ((stringp date)
+ "temp")
+ (t "permanent"))
+ header
+ (if (< score 0) "lower" "raise"))
+ (if (numberp match)
+ (int-to-string match)
+ match))))
;; Get rid of string props.
(setq match (format "%s" match))
(defun gnus-score-save ()
;; Save all score information.
- (let ((cache gnus-score-cache))
+ (let ((cache gnus-score-cache)
+ entry score file)
(save-excursion
(setq gnus-score-alist nil)
- (set-buffer (get-buffer-create "*Score*"))
- (buffer-disable-undo (current-buffer))
- (let (entry score file)
- (while cache
- (setq entry (car cache)
- cache (cdr cache)
- file (car entry)
- score (cdr entry))
- (if (or (not (equal (gnus-score-get 'touched score) '(t)))
- (gnus-score-get 'read-only score)
- (and (file-exists-p file)
- (not (file-writable-p file))))
- ()
- (setq score (setcdr entry (delq (assq 'touched score) score)))
- (erase-buffer)
- (let (emacs-lisp-mode-hook)
- (if (string-match
- (concat (regexp-quote gnus-adaptive-file-suffix)
- "$") file)
- ;; This is an adaptive score file, so we do not run
- ;; it through `pp'. These files can get huge, and
- ;; are not meant to be edited by human hands.
- (prin1 score (current-buffer))
- ;; This is a normal score file, so we print it very
- ;; prettily.
- (pp score (current-buffer))))
- (if (not (make-directory (file-name-directory file) t))
- ()
- ;; If the score file is empty, we delete it.
- (if (zerop (buffer-size))
- (delete-file file)
- ;; There are scores, so we write the file.
- (when (file-writable-p file)
- (write-region (point-min) (point-max) file nil 'silent)
- (and gnus-score-after-write-file-function
- (funcall gnus-score-after-write-file-function file)))))
- (and gnus-score-uncacheable-files
- (string-match gnus-score-uncacheable-files file)
- (gnus-score-remove-from-cache file)))))
+ (nnheader-set-temp-buffer "*Score*")
+ (while cache
+ (current-buffer)
+ (setq entry (pop cache)
+ file (car entry)
+ score (cdr entry))
+ (if (or (not (equal (gnus-score-get 'touched score) '(t)))
+ (gnus-score-get 'read-only score)
+ (and (file-exists-p file)
+ (not (file-writable-p file))))
+ ()
+ (setq score (setcdr entry (delq (assq 'touched score) score)))
+ (erase-buffer)
+ (let (emacs-lisp-mode-hook)
+ (if (string-match
+ (concat (regexp-quote gnus-adaptive-file-suffix)
+ "$") file)
+ ;; This is an adaptive score file, so we do not run
+ ;; it through `pp'. These files can get huge, and
+ ;; are not meant to be edited by human hands.
+ (prin1 score (current-buffer))
+ ;; This is a normal score file, so we print it very
+ ;; prettily.
+ (pp score (current-buffer))))
+ (if (and (not (file-exists-p (file-name-directory file)))
+ (make-directory (file-name-directory file) t))
+ (gnus-error 1 "Can't create directory %s"
+ (file-name-directory file))
+ ;; If the score file is empty, we delete it.
+ (if (zerop (buffer-size))
+ (delete-file file)
+ ;; There are scores, so we write the file.
+ (when (file-writable-p file)
+ (write-region (point-min) (point-max) file nil 'silent)
+ (when gnus-score-after-write-file-function
+ (funcall gnus-score-after-write-file-function file)))))
+ (and gnus-score-uncacheable-files
+ (string-match gnus-score-uncacheable-files file)
+ (gnus-score-remove-from-cache file))))
(kill-buffer (current-buffer)))))
(defun gnus-score-headers (score-files &optional trace)
(error "No server on current line"))
(unless (assoc server gnus-server-alist)
(error "This server can't be edited"))
- (let ((winconf (current-window-configuration))
- (info (cdr (assoc server gnus-server-alist))))
+ (let ((info (cdr (assoc server gnus-server-alist))))
(gnus-close-server info)
- (get-buffer-create gnus-server-edit-buffer)
- (gnus-configure-windows 'edit-server)
- (gnus-add-current-to-buffer-list)
- (emacs-lisp-mode)
- (make-local-variable 'gnus-prev-winconf)
- (setq gnus-prev-winconf winconf)
- (use-local-map (copy-keymap (current-local-map)))
- (let ((done-func '(lambda ()
- "Exit editing mode and update the information."
- (interactive)
- (gnus-server-edit-server-done 'group))))
- (setcar (cdr (nth 4 done-func)) server)
- (local-set-key "\C-c\C-c" done-func))
- (erase-buffer)
- (insert ";; Type `C-c C-c' after you have edited the server.\n\n")
- (insert (pp-to-string info))))
-
-(defun gnus-server-edit-server-done (server)
- (interactive)
- (set-buffer (get-buffer-create gnus-server-edit-buffer))
- (goto-char (point-min))
- (let ((form (read (current-buffer)))
- (winconf gnus-prev-winconf))
- (gnus-server-set-info server form)
- (kill-buffer (current-buffer))
- (and winconf (set-window-configuration winconf))
- (set-buffer gnus-server-buffer)
- (gnus-server-update-server server)
- (gnus-server-list-servers)
- (gnus-server-position-point)))
+ (gnus-edit-form
+ info "Editing the server."
+ `(lambda (form)
+ (gnus-server-set-info ,server form)
+ (gnus-server-list-servers)
+ (gnus-server-position-point)))))
(defun gnus-server-read-server (server)
"Browse a server."
(require 'gnus-range)
(require 'message)
-(defvar gnus-secondary-servers nil
- "*List of NNTP servers that the user can choose between interactively.
-To make Gnus query you for a server, you have to give `gnus' a
-non-numeric prefix - `C-u M-x gnus', in short.")
-
-(defvar gnus-nntp-server nil
- "*The name of the host running the NNTP server.
-This variable is semi-obsolete. Use the `gnus-select-method'
-variable instead.")
-
(defvar gnus-startup-file "~/.newsrc"
"*Your `.newsrc' file.
`.newsrc-SERVER' will be used instead if that exists.")
t)
(condition-case ()
(gnus-request-group group dont-check method)
- ; (error nil)
+ ; (error nil)
(quit nil))
- (save-excursion
- (set-buffer nntp-server-buffer)
- (goto-char (point-min))
- ;; Parse the result we got from `gnus-request-group'.
- (and (looking-at "[0-9]+ [0-9]+ \\([0-9]+\\) [0-9]+")
- (progn
- (goto-char (match-beginning 1))
- (gnus-set-active
- group (setq active (cons (read (current-buffer))
- (read (current-buffer)))))
- ;; Return the new active info.
- active))))))
-
-(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 `<'.
-Returns whether the updating was successful."
- (let* ((active (or gnus-newsgroup-active (gnus-active group)))
- (entry (gnus-gethash group gnus-newsrc-hashtb))
- (info (nth 2 entry))
- (prev 1)
- (unread (sort (copy-sequence unread) '<))
- read)
- (if (or (not info) (not active))
- ;; There is no info on this group if it was, in fact,
- ;; killed. Gnus stores no information on killed groups, so
- ;; there's nothing to be done.
- ;; One could store the information somewhere temporarily,
- ;; perhaps... Hmmm...
- ()
- ;; Remove any negative articles numbers.
- (while (and unread (< (car unread) 0))
- (setq unread (cdr unread)))
- ;; Remove any expired article numbers
- (while (and unread (< (car unread) (car active)))
- (setq unread (cdr unread)))
- ;; Compute the ranges of read articles by looking at the list of
- ;; unread articles.
- (while unread
- (if (/= (car unread) prev)
- (setq read (cons (if (= prev (1- (car unread))) prev
- (cons prev (1- (car unread)))) read)))
- (setq prev (1+ (car unread)))
- (setq unread (cdr unread)))
- (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))
- ;; Set the number of unread articles in gnus-newsrc-hashtb.
- (gnus-get-unread-articles-in-group info (gnus-active group))
- t)))
+ (gnus-set-active group (setq active (gnus-parse-active)))
+ ;; Return the new active info.
+ active)))
+
+(defun gnus-parse-active ()
+ "Parse active info in the nntp server buffer."
+ (save-excursion
+ (set-buffer nntp-server-buffer)
+ (goto-char (point-min))
+ ;; Parse the result we got from `gnus-request-group'.
+ (when (looking-at "[0-9]+ [0-9]+ \\([0-9]+\\) [0-9]+")
+ (goto-char (match-beginning 1))
+ (cons (read (current-buffer))
+ (read (current-buffer))))))
(defun gnus-make-articles-unread (group articles)
"Mark ARTICLES in GROUP as unread."
"*Mark used for sparsely reffed articles.")
(defvar gnus-canceled-mark ?G
"*Mark used for canceled articles.")
+(defvar gnus-duplicate-mark ?M
+ "*Mark used for duplicate articles.")
(defvar gnus-score-over-mark ?+
"*Score mark used for articles with high scores.")
(defvar gnus-score-below-mark ?-
(defvar gnus-insert-pseudo-articles t
"*If non-nil, insert pseudo-articles when decoding articles.")
-(defvar gnus-summary-line-format "%U\%R\%z\%I\%(%[%4L: %-20,20n%]%) %s\n"
- "*The format specification of the lines in the summary buffer.
-
-It works along the same lines as a normal formatting string,
-with some simple extensions.
-
-%N Article number, left padded with spaces (string)
-%S Subject (string)
-%s Subject if it is at the root of a thread, and \"\" otherwise (string)
-%n Name of the poster (string)
-%a Extracted name of the poster (string)
-%A Extracted address of the poster (string)
-%F Contents of the From: header (string)
-%x Contents of the Xref: header (string)
-%D Date of the article (string)
-%d Date of the article (string) in DD-MMM format
-%M Message-id of the article (string)
-%r References of the article (string)
-%c Number of characters in the article (integer)
-%L Number of lines in the article (integer)
-%I Indentation based on thread level (a string of spaces)
-%T A string with two possible values: 80 spaces if the article
- is on thread level two or larger and 0 spaces on level one
-%R \"A\" if this article has been replied to, \" \" otherwise (character)
-%U Status of this article (character, \"R\", \"K\", \"-\" or \" \")
-%[ Opening bracket (character, \"[\" or \"<\")
-%] Closing bracket (character, \"]\" or \">\")
-%> Spaces of length thread-level (string)
-%< Spaces of length (- 20 thread-level) (string)
-%i Article score (number)
-%z Article zcore (character)
-%t Number of articles under the current thread (number).
-%e Whether the thread is empty or not (character).
-%l GroupLens score (string).
-%u User defined specifier. The next character in the format string should
- be a letter. Gnus will call the function gnus-user-format-function-X,
- where X is the letter following %u. The function will be passed the
- current header as argument. The function should return a string, which
- will be inserted into the summary just like information from any other
- summary specifier.
-
-Text between %( and %) will be highlighted with `gnus-mouse-face'
-when the mouse point is placed inside the area. There can only be one
-such area.
-
-The %U (status), %R (replied) and %z (zcore) specs have to be handled
-with care. For reasons of efficiency, Gnus will compute what column
-these characters will end up in, and \"hard-code\" that. This means that
-it is illegal to have these specs after a variable-length spec. Well,
-you might not be arrested, but your summary buffer will look strange,
-which is bad enough.
-
-The smart choice is to have these specs as for to the left as
-possible.
-
-This restriction may disappear in later versions of Gnus.")
-
(defvar gnus-summary-dummy-line-format
"* %(: :%) %S\n"
"*The format specification for the dummy roots in the summary buffer.
(?e (gnus-summary-number-of-articles-in-thread
(and (boundp 'thread) (car thread)) gnus-tmp-level t)
?c)
- (?u gnus-tmp-user-defined ?s))
+ (?u gnus-tmp-user-defined ?s)
+ (?P (gnus-pick-line-number) ?d))
"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).")
(defmacro gnus-data-unread-p (data)
`(= (nth 1 ,data) gnus-unread-mark))
+(defmacro gnus-data-read-p (data)
+ `(/= (nth 1 ,data) gnus-unread-mark))
+
(defmacro gnus-data-pseudo-p (data)
`(consp (nth 3 ,data)))
(when cached
(setq gnus-newsgroup-cached cached))
+ ;; Suppress duplicates?
+ (when gnus-suppress-duplicates
+ (gnus-dup-suppress-articles))
+
;; Set the initial limit.
(setq gnus-newsgroup-limit (copy-sequence articles))
;; Remove canceled articles from the list of unread articles.
(when (nthcdr (decf i) info)
(setcdr (nthcdr i info) nil)))))))
-(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 killed))
- marked m)
- (or (not info)
- (and (not (setq marked (nthcdr 3 info)))
- (or (null articles)
- (setcdr (nthcdr 2 info)
- (list (list (cons type (gnus-compress-sequence
- articles t)))))))
- (and (not (setq m (assq type (car marked))))
- (or (null articles)
- (setcar marked
- (cons (cons type (gnus-compress-sequence articles t) )
- (car marked)))))
- (if force
- (if (null articles)
- (setcar (nthcdr 3 info)
- (delq (assq type (car marked)) (car marked)))
- (setcdr m (gnus-compress-sequence articles t)))
- (setcdr m (gnus-compress-sequence
- (sort (nconc (gnus-uncompress-range (cdr m))
- (copy-sequence articles)) '<) t))))))
-
(defun gnus-set-mode-line (where)
"This function sets the mode line of the article or summary buffers.
If WHERE is `summary', the summary mode line format will be used."
(gnus-summary-reselect-current-group all t))
(defun gnus-summary-update-info ()
- (let* ((group gnus-newsgroup-name))
+ (let ((group gnus-newsgroup-name))
(when gnus-newsgroup-kill-headers
(setq gnus-newsgroup-killed
(gnus-compress-sequence
(gnus-cache-possibly-remove-articles)
(gnus-cache-save-buffers))
(gnus-async-prefetch-remove-group group)
+ (when gnus-suppress-duplicates
+ (gnus-dup-enter-articles))
(when gnus-use-trees
(gnus-tree-close group))
;; Make all changes in this group permanent.
(list gnus-del-mark gnus-read-mark gnus-ancient-mark
gnus-killed-mark gnus-kill-file-mark
gnus-low-score-mark gnus-expirable-mark
- gnus-canceled-mark gnus-catchup-mark gnus-sparse-mark)
+ gnus-canceled-mark gnus-catchup-mark gnus-sparse-mark
+ gnus-duplicate-mark)
'reverse)))
(defalias 'gnus-summary-delete-marked-with 'gnus-summary-limit-to-marks)
(or (= mark gnus-killed-mark) (= mark gnus-del-mark)
(= mark gnus-catchup-mark) (= mark gnus-low-score-mark)
(= mark gnus-ancient-mark)
- (= mark gnus-read-mark) (= mark gnus-souped-mark)))
+ (= mark gnus-read-mark) (= mark gnus-souped-mark)
+ (= mark gnus-duplicate-mark)))
(setq mark gnus-expirable-mark)
(push article gnus-newsgroup-expirable))
;; Set the mark in the buffer.
(and (numberp mark)
(or (= mark gnus-killed-mark) (= mark gnus-del-mark)
(= mark gnus-catchup-mark) (= mark gnus-low-score-mark)
- (= mark gnus-read-mark) (= mark gnus-souped-mark))))
+ (= mark gnus-read-mark) (= mark gnus-souped-mark)
+ (= mark gnus-duplicate-mark))))
(setq mark gnus-expirable-mark))
(let* ((mark (or mark gnus-del-mark))
(article (or article (gnus-summary-article-number))))
t)
(defun gnus-summary-update-mark (mark type)
- (beginning-of-line)
(let ((forward (cdr (assq type gnus-summary-mark-positions)))
- (buffer-read-only nil))
+ (buffer-read-only nil))
+ (re-search-backward "[\n\r]" (gnus-point-at-bol) 'move-to-limit)
+ (and (looking-at "\r") (setq forward (1+ forward)))
(when (and forward
- (<= (+ forward (point)) (point-max)))
+ (<= (+ forward (point)) (point-max)))
;; Go to the right position on the line.
(goto-char (+ forward (point)))
;; Replace the old mark with the new mark.
(subst-char-in-region (point) (1+ (point)) (following-char) mark)
;; Optionally update the marks by some user rule.
(when (eq type 'unread)
- (gnus-data-set-mark
- (gnus-data-find (gnus-summary-article-number)) mark)
- (gnus-summary-update-line (eq mark gnus-unread-mark))))))
+ (gnus-data-set-mark
+ (gnus-data-find (gnus-summary-article-number)) mark)
+ (gnus-summary-update-line (eq mark gnus-unread-mark))))))
(defun gnus-mark-article-as-read (article &optional mark)
"Enter ARTICLE in the pertinent lists and remove it from others."
(defvar gnus-topic-line-format-spec nil)
-;; Functions.
+;;; Utility functions
(defun gnus-group-topic-name ()
"The name of the topic on the current line."
(gnus-group-topic-unread)))
0))
-(defun gnus-topic-init-alist ()
- "Initialize the topic structures."
- (setq gnus-topic-topology
- (cons (list "Gnus" 'visible)
- (mapcar (lambda (topic)
- (list (list (car topic) 'visible)))
- '(("misc")))))
- (setq gnus-topic-alist
- (list (cons "misc"
- (mapcar (lambda (info) (gnus-info-group info))
- (cdr gnus-newsrc-alist)))
- (list "Gnus")))
- (gnus-topic-enter-dribble))
+(defun gnus-group-topic-p ()
+ "Return non-nil if the current line is a topic."
+ (gnus-group-topic-name))
+
+(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-articles-in-topic (entries)
+ (let ((total 0)
+ number)
+ (while entries
+ (when (numberp (setq number (car (pop entries))))
+ (incf total number)))
+ total))
+
+(defun gnus-group-topic (group)
+ "Return the topic GROUP is a member of."
+ (let ((alist gnus-topic-alist)
+ out)
+ (while alist
+ (when (member group (cdar alist))
+ (setq out (caar alist)
+ alist nil))
+ (setq alist (cdr alist)))
+ out))
+
+(defun gnus-group-parent-topic (group)
+ "Return the topic GROUP is member of by looking at the group buffer."
+ (save-excursion
+ (set-buffer gnus-group-buffer)
+ (if (gnus-group-goto-group group)
+ (gnus-current-topic)
+ (gnus-group-topic group))))
+
+(defun gnus-topic-goto-topic (topic)
+ "Go to TOPIC."
+ (when topic
+ (gnus-goto-char (text-property-any (point-min) (point-max)
+ 'gnus-topic (intern topic)))))
+
+(defun gnus-current-topic ()
+ "Return the name of the current topic."
+ (let ((result
+ (or (get-text-property (point) 'gnus-topic)
+ (save-excursion
+ (and (gnus-goto-char (previous-single-property-change
+ (point) 'gnus-topic))
+ (get-text-property (max (1- (point)) (point-min))
+ 'gnus-topic))))))
+ (when result
+ (symbol-name result))))
+
+(defun gnus-current-topics ()
+ "Return a list of all current topics, lowest in hierarchy first."
+ (let ((topic (gnus-current-topic))
+ topics)
+ (while topic
+ (push topic topics)
+ (setq topic (gnus-topic-parent-topic topic)))
+ (nreverse topics)))
+
+(defun gnus-group-active-topic-p ()
+ "Say whether the current topic comes from the active topics."
+ (save-excursion
+ (beginning-of-line)
+ (get-text-property (point) 'gnus-active)))
+
+(defun gnus-topic-find-groups (topic &optional level all)
+ "Return entries for all visible groups in TOPIC."
+ (let ((groups (cdr (assoc topic gnus-topic-alist)))
+ info clevel unread group lowest params visible-groups entry active)
+ (setq lowest (or lowest 1))
+ (setq level (or level 7))
+ ;; We go through the newsrc to look for matches.
+ (while groups
+ (setq entry (gnus-gethash (setq group (pop groups)) gnus-newsrc-hashtb)
+ info (nth 2 entry)
+ params (gnus-info-params info)
+ active (gnus-active group)
+ unread (or (car entry)
+ (and (not (equal group "dummy.group"))
+ active
+ (- (1+ (cdr active)) (car active))))
+ clevel (or (gnus-info-level info)
+ (if (member group gnus-zombie-list) 8 9)))
+ (and
+ unread ; nil means that the group is dead.
+ (<= clevel level)
+ (>= clevel lowest) ; Is inside the level we want.
+ (or all
+ (if (eq unread t)
+ gnus-group-list-inactive-groups
+ (> unread 0))
+ (and gnus-list-groups-with-ticked-articles
+ (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)))
+ ;; Add this group to the list of visible groups.
+ (push (or entry group) visible-groups)))
+ (nreverse visible-groups)))
+
+(defun gnus-topic-previous-topic (topic)
+ "Return the previous topic on the same level as TOPIC."
+ (let ((top (cddr (gnus-topic-find-topology
+ (gnus-topic-parent-topic topic)))))
+ (unless (equal topic (caaar top))
+ (while (and top (not (equal (caaadr top) topic)))
+ (setq top (cdr top)))
+ (caaar top))))
+
+(defun gnus-topic-parent-topic (topic &optional topology)
+ "Return the parent of TOPIC."
+ (unless topology
+ (setq topology gnus-topic-topology))
+ (let ((parent (car (pop topology)))
+ result found)
+ (while (and topology
+ (not (setq found (equal (caaar topology) topic)))
+ (not (setq result (gnus-topic-parent-topic topic
+ (car topology)))))
+ (setq topology (cdr topology)))
+ (or result (and found parent))))
+
+(defun gnus-topic-next-topic (topic &optional previous)
+ "Return the next sibling of TOPIC."
+ (let ((parentt (cddr (gnus-topic-find-topology
+ (gnus-topic-parent-topic topic))))
+ prev)
+ (while (and parentt
+ (not (equal (caaar parentt) topic)))
+ (setq prev (caaar parentt)
+ parentt (cdr parentt)))
+ (if previous
+ prev
+ (caaadr parentt))))
+
+(defun gnus-topic-find-topology (topic &optional topology level remove)
+ "Return the topology of TOPIC."
+ (unless topology
+ (setq topology gnus-topic-topology)
+ (setq level 0))
+ (let ((top topology)
+ result)
+ (if (equal (caar 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)))
+
+(defvar gnus-tmp-topics nil)
+(defun gnus-topic-list (&optional topology)
+ "Return a list of all topics in the topology."
+ (unless topology
+ (setq topology gnus-topic-topology
+ gnus-tmp-topics nil))
+ (push (caar topology) gnus-tmp-topics)
+ (mapcar 'gnus-topic-list (cdr topology))
+ gnus-tmp-topics)
+
+;;; Topic parameter jazz
+
+(defun gnus-topic-parameters (topic)
+ "Return the parameters for TOPIC."
+ (let ((top (gnus-topic-find-topology topic)))
+ (unless top
+ (error "No such topic: %s" topic))
+ (nth 2 (car top))))
+
+(defun gnus-topic-set-parameters (topic parameters)
+ "Set the topic parameters of TOPIC to PARAMETERS."
+ (let ((top (gnus-topic-find-topology topic)))
+ (unless top
+ (error "No such topic: %s" topic))
+ ;; We may have to extend if there is no parameters here
+ ;; to begin with.
+ (unless (nthcdr 2 (car top))
+ (nconc (car top) (list nil)))
+ (setcar (nthcdr 2 (car top)) parameters)))
+
+(defun gnus-group-topic-parameters (group)
+ "Compute the group parameters for GROUP taking into account inheretance from topics."
+ (let ((params-list (list (gnus-group-get-parameter group)))
+ topics params param out)
+ (save-excursion
+ (gnus-group-goto-group group)
+ (setq topics (gnus-current-topics))
+ (while topics
+ (push (gnus-topic-parameters (pop topics)) params-list))
+ ;; We probably have lots of nil elements here, so
+ ;; we remove them. Probably faster than doing this "properly".
+ (setq params-list (delq nil params-list))
+ ;; Now we have all the parameters, so we go through them
+ ;; and do inheretance in the obvious way.
+ (while (setq params (pop params-list))
+ (while (setq param (pop params))
+ (when (atom param)
+ (setq param (cons param t)))
+ ;; Override any old versions of this param.
+ (setq out (delq (assq (car param) out) out))
+ (push param out)))
+ ;; Return the resulting parameter list.
+ out)))
+
+;;; General utility funtions
+
+(defun gnus-topic-enter-dribble ()
+ (gnus-dribble-enter
+ (format "(setq gnus-topic-topology '%S)" gnus-topic-topology)))
+
+;;; Generating group buffers
(defun gnus-group-prepare-topics (level &optional all lowest regexp list-topic topic-level)
"List all newsgroups with unread articles of level LEVEL or lower, and
(goto-char end)
unread))
-(defun gnus-topic-find-groups (topic &optional level all)
- "Return entries for all visible groups in TOPIC."
- (let ((groups (cdr (assoc topic gnus-topic-alist)))
- info clevel unread group lowest params visible-groups entry active)
- (setq lowest (or lowest 1))
- (setq level (or level 7))
- ;; We go through the newsrc to look for matches.
- (while groups
- (setq entry (gnus-gethash (setq group (pop groups)) gnus-newsrc-hashtb)
- info (nth 2 entry)
- params (gnus-info-params info)
- active (gnus-active group)
- unread (or (car entry)
- (and (not (equal group "dummy.group"))
- active
- (- (1+ (cdr active)) (car active))))
- clevel (or (gnus-info-level info)
- (if (member group gnus-zombie-list) 8 9)))
- (and
- unread ; nil means that the group is dead.
- (<= clevel level)
- (>= clevel lowest) ; Is inside the level we want.
- (or all
- (if (eq unread t)
- gnus-group-list-inactive-groups
- (> unread 0))
- (and gnus-list-groups-with-ticked-articles
- (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)))
- ;; Add this group to the list of visible groups.
- (push (or entry group) visible-groups)))
- (nreverse visible-groups)))
-
(defun gnus-topic-remove-topic (&optional insert total-remove hide in-level)
"Remove the current topic."
(let ((topic (gnus-group-topic-name))
(gnus-topic-remove-topic
(or insert (not (gnus-topic-visible-p))) nil nil 9)))))))
-(defun gnus-group-topic-p ()
- "Return non-nil if the current line is a topic."
- (gnus-group-topic-name))
-
-(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 entries
&optional unread)
(let* ((visible (if visiblep "" "..."))
'gnus-active active-topic
'gnus-topic-visible visiblep))))
-(defun gnus-topic-previous-topic (topic)
- "Return the previous topic on the same level as TOPIC."
- (let ((top (cddr (gnus-topic-find-topology
- (gnus-topic-parent-topic topic)))))
- (unless (equal topic (caaar top))
- (while (and top (not (equal (caaadr top) topic)))
- (setq top (cdr top)))
- (caaar top))))
+(defun gnus-topic-update-topic ()
+ "Update all parent topics to the current group."
+ (when (and (eq major-mode 'gnus-group-mode)
+ gnus-topic-mode)
+ (let ((group (gnus-group-group-name))
+ (buffer-read-only nil))
+ (when (and group (gnus-get-info group)
+ (gnus-topic-goto-topic (gnus-current-topic)))
+ (gnus-topic-update-topic-line (gnus-group-topic-name))
+ (gnus-group-goto-group group)
+ (gnus-group-position-point)))))
-(defun gnus-topic-parent-topic (topic &optional topology)
- "Return the parent of TOPIC."
- (unless topology
- (setq topology gnus-topic-topology))
- (let ((parent (car (pop topology)))
- result found)
- (while (and topology
- (not (setq found (equal (caaar topology) topic)))
- (not (setq result (gnus-topic-parent-topic topic
- (car topology)))))
- (setq topology (cdr topology)))
- (or result (and found parent))))
+(defun gnus-topic-goto-missing-group (group)
+ "Place point where GROUP is supposed to be inserted."
+ (let* ((topic (gnus-group-topic group))
+ (groups (cdr (assoc topic gnus-topic-alist)))
+ (g (cdr (member group groups)))
+ (unfound t))
+ (while (and g unfound)
+ (when (gnus-group-goto-group (pop g))
+ (beginning-of-line)
+ (setq unfound nil)))
+ (when unfound
+ (setq g (cdr (member group (reverse groups))))
+ (while (and g unfound)
+ (when (gnus-group-goto-group (pop g))
+ (forward-line 1)
+ (setq unfound nil)))
+ (when unfound
+ (gnus-topic-goto-topic topic)
+ (forward-line 1)))))
-(defun gnus-topic-next-topic (topic &optional previous)
- "Return the next sibling of TOPIC."
- (let ((topology gnus-topic-topology)
- (parentt (cddr (gnus-topic-find-topology
- (gnus-topic-parent-topic topic))))
- prev)
- (while (and parentt
- (not (equal (caaar parentt) topic)))
- (setq prev (caaar parentt)
- parentt (cdr parentt)))
- (if previous
- prev
- (caaadr parentt))))
+(defun gnus-topic-update-topic-line (topic-name &optional reads)
+ (let* ((top (gnus-topic-find-topology topic-name))
+ (type (cadr top))
+ (children (cddr top))
+ (entries (gnus-topic-find-groups
+ (car type) (car gnus-group-list-mode)
+ (cdr gnus-group-list-mode)))
+ (parent (gnus-topic-parent-topic topic-name))
+ (all-entries entries)
+ (unread 0)
+ old-unread entry)
+ (when (gnus-topic-goto-topic (car type))
+ ;; Tally all the groups that belong in this topic.
+ (if reads
+ (setq unread (- (gnus-group-topic-unread) reads))
+ (while children
+ (incf unread (gnus-topic-unread (caar (pop children)))))
+ (while (setq entry (pop entries))
+ (when (numberp (car entry))
+ (incf unread (car entry)))))
+ (setq old-unread (gnus-group-topic-unread))
+ ;; Insert the topic line.
+ (gnus-topic-insert-topic-line
+ (car type) (gnus-topic-visible-p)
+ (not (eq (nth 2 type) 'hidden))
+ (gnus-group-topic-level) all-entries unread)
+ (gnus-delete-line))
+ (when parent
+ (forward-line -1)
+ (gnus-topic-update-topic-line
+ parent (- old-unread (gnus-group-topic-unread))))
+ unread))
-(defun gnus-topic-find-topology (topic &optional topology level remove)
- "Return the topology of TOPIC."
- (unless topology
- (setq topology gnus-topic-topology)
- (setq level 0))
- (let ((top topology)
- result)
- (if (equal (caar 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-group-indentation ()
+ (make-string
+ (* gnus-topic-indent-level
+ (or (save-excursion
+ (gnus-topic-goto-topic (gnus-current-topic))
+ (gnus-group-topic-level)) 0)) ? ))
+
+;;; Initialization
(gnus-add-shutdown 'gnus-topic-close 'gnus)
(setq topic (cdr topic))
(setcdr topic (cddr topic)))))))
-(defvar gnus-tmp-topics nil)
-(defun gnus-topic-list (&optional topology)
- "Return a list of all topics in the topology."
- (unless topology
- (setq topology gnus-topic-topology
- gnus-tmp-topics nil))
- (push (caar topology) gnus-tmp-topics)
- (mapcar 'gnus-topic-list (cdr topology))
- gnus-tmp-topics)
-
-(defun gnus-topic-enter-dribble ()
- (gnus-dribble-enter
- (format "(setq gnus-topic-topology '%S)" gnus-topic-topology)))
-
-(defun gnus-topic-articles-in-topic (entries)
- (let ((total 0)
- number)
- (while entries
- (when (numberp (setq number (car (pop entries))))
- (incf total number)))
- total))
+(defun gnus-topic-init-alist ()
+ "Initialize the topic structures."
+ (setq gnus-topic-topology
+ (cons (list "Gnus" 'visible)
+ (mapcar (lambda (topic)
+ (list (list (car topic) 'visible)))
+ '(("misc")))))
+ (setq gnus-topic-alist
+ (list (cons "misc"
+ (mapcar (lambda (info) (gnus-info-group info))
+ (cdr gnus-newsrc-alist)))
+ (list "Gnus")))
+ (gnus-topic-enter-dribble))
-(defun gnus-group-topic (group)
- "Return the topic GROUP is a member of."
- (let ((alist gnus-topic-alist)
- out)
- (while alist
- (when (member group (cdar alist))
- (setq out (caar alist)
- alist nil))
- (setq alist (cdr alist)))
- out))
+;;; Maintenance
-(defun gnus-topic-goto-topic (topic)
- "Go to TOPIC."
- (when topic
- (gnus-goto-char (text-property-any (point-min) (point-max)
- 'gnus-topic (intern topic)))))
+(defun gnus-topic-clean-alist ()
+ "Remove bogus groups from the topic alist."
+ (let ((topic-alist gnus-topic-alist)
+ result topic)
+ (unless gnus-killed-hashtb
+ (gnus-make-hashtable-from-killed))
+ (while (setq topic (pop topic-alist))
+ (let ((topic-name (pop topic))
+ group filtered-topic)
+ (while (setq group (pop topic))
+ (if (and (gnus-gethash group gnus-active-hashtb)
+ (not (gnus-gethash group gnus-killed-hashtb)))
+ (push group filtered-topic)))
+ (push (cons topic-name (nreverse filtered-topic)) result)))
+ (setq gnus-topic-alist (nreverse result))))
-(defun gnus-group-parent-topic ()
- "Return the name of the current topic."
- (let ((result
- (or (get-text-property (point) 'gnus-topic)
- (save-excursion
- (and (gnus-goto-char (previous-single-property-change
- (point) 'gnus-topic))
- (get-text-property (max (1- (point)) (point-min))
- 'gnus-topic))))))
- (when result
- (symbol-name result))))
-
-(defun gnus-topic-update-topic ()
- "Update all parent topics to the current group."
- (when (and (eq major-mode 'gnus-group-mode)
- gnus-topic-mode)
- (let ((group (gnus-group-group-name))
- (buffer-read-only nil))
- (when (and group (gnus-get-info group)
- (gnus-topic-goto-topic (gnus-group-parent-topic)))
- (gnus-topic-update-topic-line (gnus-group-topic-name))
- (gnus-group-goto-group group)
- (gnus-group-position-point)))))
+(defun gnus-topic-change-level (group level oldlevel)
+ "Run when changing levels to enter/remove groups from topics."
+ (save-excursion
+ (set-buffer gnus-group-buffer)
+ (when (and gnus-topic-mode
+ gnus-topic-alist
+ (not gnus-topic-inhibit-change-level))
+ ;; Remove the group from the topics.
+ (when (and (< oldlevel gnus-level-zombie)
+ (>= level gnus-level-zombie))
+ (let (alist)
+ (forward-line -1)
+ (when (setq alist (assoc (gnus-current-topic) gnus-topic-alist))
+ (setcdr alist (gnus-delete-first group (cdr alist))))))
+ ;; If the group is subscribed. then we enter it into the topics.
+ (when (and (< level gnus-level-zombie)
+ (>= oldlevel gnus-level-zombie))
+ (let* ((prev (gnus-group-group-name))
+ (gnus-topic-inhibit-change-level t)
+ (gnus-group-indentation
+ (make-string
+ (* gnus-topic-indent-level
+ (or (save-excursion
+ (gnus-topic-goto-topic (gnus-current-topic))
+ (gnus-group-topic-level)) 0)) ? ))
+ (yanked (list group))
+ alist talist end)
+ ;; Then we enter the yanked groups into the topics they belong
+ ;; to.
+ (when (setq alist (assoc (save-excursion
+ (forward-line -1)
+ (or
+ (gnus-current-topic)
+ (caar gnus-topic-topology)))
+ gnus-topic-alist))
+ (setq talist alist)
+ (when (stringp yanked)
+ (setq yanked (list yanked)))
+ (if (not prev)
+ (nconc alist yanked)
+ (if (not (cdr alist))
+ (setcdr alist (nconc yanked (cdr alist)))
+ (while (and (not end) (cdr alist))
+ (when (equal (cadr alist) prev)
+ (setcdr alist (nconc yanked (cdr alist)))
+ (setq end t))
+ (setq alist (cdr alist)))
+ (unless end
+ (nconc talist yanked))))))
+ (gnus-topic-update-topic)))))
-(defun gnus-topic-goto-missing-group (group)
- "Place point where GROUP is supposed to be inserted."
- (let* ((topic (gnus-group-topic group))
- (groups (cdr (assoc topic gnus-topic-alist)))
- (g (cdr (member group groups)))
- (unfound t))
- (while (and g unfound)
- (when (gnus-group-goto-group (pop g))
- (beginning-of-line)
- (setq unfound nil)))
- (when unfound
- (setq g (cdr (member group (reverse groups))))
- (while (and g unfound)
- (when (gnus-group-goto-group (pop g))
- (forward-line 1)
- (setq unfound nil)))
- (when unfound
- (gnus-topic-goto-topic topic)
- (forward-line 1)))))
+(defun gnus-topic-goto-next-group (group props)
+ "Go to group or the next group after group."
+ (if (null group)
+ (gnus-topic-goto-topic (symbol-name (cadr (memq 'gnus-topic props))))
+ (if (gnus-group-goto-group group)
+ t
+ ;; The group is no longer visible.
+ (let* ((list (assoc (gnus-current-topic) gnus-topic-alist))
+ (after (cdr (member group (cdr list)))))
+ ;; First try to put point on a group after the current one.
+ (while (and after
+ (not (gnus-group-goto-group (car after))))
+ (setq after (cdr after)))
+ ;; Then try to put point on a group before point.
+ (unless after
+ (setq after (cdr (member group (reverse (cdr list)))))
+ (while (and after
+ (not (gnus-group-goto-group (car after))))
+ (setq after (cdr after))))
+ ;; Finally, just put point on the topic.
+ (unless after
+ (gnus-topic-goto-topic (car list))
+ (setq after nil))
+ t))))
-(defun gnus-topic-update-topic-line (topic-name &optional reads)
- (let* ((top (gnus-topic-find-topology topic-name))
- (type (cadr top))
- (children (cddr top))
- (entries (gnus-topic-find-groups
- (car type) (car gnus-group-list-mode)
- (cdr gnus-group-list-mode)))
- (parent (gnus-topic-parent-topic topic-name))
- (all-entries entries)
- (unread 0)
- old-unread entry)
- (when (gnus-topic-goto-topic (car type))
- ;; Tally all the groups that belong in this topic.
- (if reads
- (setq unread (- (gnus-group-topic-unread) reads))
- (while children
- (incf unread (gnus-topic-unread (caar (pop children)))))
- (while (setq entry (pop entries))
- (when (numberp (car entry))
- (incf unread (car entry)))))
- (setq old-unread (gnus-group-topic-unread))
- ;; Insert the topic line.
- (gnus-topic-insert-topic-line
- (car type) (gnus-topic-visible-p)
- (not (eq (nth 2 type) 'hidden))
- (gnus-group-topic-level) all-entries unread)
- (gnus-delete-line))
- (when parent
- (forward-line -1)
- (gnus-topic-update-topic-line
- parent (- old-unread (gnus-group-topic-unread))))
- unread))
+;;; Topic-active functions
(defun gnus-topic-grok-active (&optional force)
"Parse all active groups and create topic structures for them."
;; to this topic.
groups))
-(defun gnus-group-active-topic-p ()
- "Return whether the current active comes from the active topics."
- (save-excursion
- (beginning-of-line)
- (get-text-property (point) 'gnus-active)))
-
;;; Topic mode, commands and keymap.
(defvar gnus-topic-mode-map nil)
"\C-y" gnus-topic-yank-group
"\M-g" gnus-topic-get-new-news-this-topic
"AT" gnus-topic-list-active
+ "Gp" gnus-topic-edit-parameters
gnus-mouse-2 gnus-mouse-pick-topic)
;; Define a new submap.
(interactive
(list
(read-string "New topic: ")
- (gnus-group-parent-topic)))
+ (gnus-current-topic)))
;; Check whether this topic already exists.
(when (gnus-topic-find-topology topic)
(error "Topic aleady exists"))
(mapcar (lambda (g)
(gnus-group-remove-mark g)
(when (and
- (setq entry (assoc (gnus-group-parent-topic)
+ (setq entry (assoc (gnus-current-topic)
gnus-topic-alist))
(not copyp))
(setcdr entry (gnus-delete-first g (cdr entry))))
(defun gnus-topic-remove-group ()
"Remove the current group from the topic."
(interactive)
- (let ((topicl (assoc (gnus-group-parent-topic) gnus-topic-alist))
+ (let ((topicl (assoc (gnus-current-topic) gnus-topic-alist))
(group (gnus-group-group-name))
(buffer-read-only nil))
(when (and topicl group)
(completing-read "Copy to topic: " gnus-topic-alist nil t)))
(gnus-topic-move-group n topic t))
-(defun gnus-topic-group-indentation ()
- (make-string
- (* gnus-topic-indent-level
- (or (save-excursion
- (gnus-topic-goto-topic (gnus-group-parent-topic))
- (gnus-group-topic-level)) 0)) ? ))
-
-(defun gnus-topic-clean-alist ()
- "Remove bogus groups from the topic alist."
- (let ((topic-alist gnus-topic-alist)
- result topic)
- (unless gnus-killed-hashtb
- (gnus-make-hashtable-from-killed))
- (while (setq topic (pop topic-alist))
- (let ((topic-name (pop topic))
- group filtered-topic)
- (while (setq group (pop topic))
- (if (and (gnus-gethash group gnus-active-hashtb)
- (not (gnus-gethash group gnus-killed-hashtb)))
- (push group filtered-topic)))
- (push (cons topic-name (nreverse filtered-topic)) result)))
- (setq gnus-topic-alist (nreverse result))))
-
-(defun gnus-topic-change-level (group level oldlevel)
- "Run when changing levels to enter/remove groups from topics."
- (save-excursion
- (set-buffer gnus-group-buffer)
- (when (and gnus-topic-mode
- gnus-topic-alist
- (not gnus-topic-inhibit-change-level))
- ;; Remove the group from the topics.
- (when (and (< oldlevel gnus-level-zombie)
- (>= level gnus-level-zombie))
- (let (alist)
- (forward-line -1)
- (when (setq alist (assoc (gnus-group-parent-topic) gnus-topic-alist))
- (setcdr alist (gnus-delete-first group (cdr alist))))))
- ;; If the group is subscribed. then we enter it into the topics.
- (when (and (< level gnus-level-zombie)
- (>= oldlevel gnus-level-zombie))
- (let* ((prev (gnus-group-group-name))
- (gnus-topic-inhibit-change-level t)
- (gnus-group-indentation
- (make-string
- (* gnus-topic-indent-level
- (or (save-excursion
- (gnus-topic-goto-topic (gnus-group-parent-topic))
- (gnus-group-topic-level)) 0)) ? ))
- (yanked (list group))
- alist talist end)
- ;; Then we enter the yanked groups into the topics they belong
- ;; to.
- (when (setq alist (assoc (save-excursion
- (forward-line -1)
- (or
- (gnus-group-parent-topic)
- (caar gnus-topic-topology)))
- gnus-topic-alist))
- (setq talist alist)
- (when (stringp yanked)
- (setq yanked (list yanked)))
- (if (not prev)
- (nconc alist yanked)
- (if (not (cdr alist))
- (setcdr alist (nconc yanked (cdr alist)))
- (while (and (not end) (cdr alist))
- (when (equal (cadr alist) prev)
- (setcdr alist (nconc yanked (cdr alist)))
- (setq end t))
- (setq alist (cdr alist)))
- (unless end
- (nconc talist yanked))))))
- (gnus-topic-update-topic)))))
-
-(defun gnus-topic-goto-next-group (group props)
- "Go to group or the next group after group."
- (if (null group)
- (gnus-topic-goto-topic (symbol-name (cadr (memq 'gnus-topic props))))
- (if (gnus-group-goto-group group)
- t
- ;; The group is no longer visible.
- (let* ((list (assoc (gnus-group-parent-topic) gnus-topic-alist))
- (after (cdr (member group (cdr list)))))
- ;; First try to put point on a group after the current one.
- (while (and after
- (not (gnus-group-goto-group (car after))))
- (setq after (cdr after)))
- ;; Then try to put point on a group before point.
- (unless after
- (setq after (cdr (member group (reverse (cdr list)))))
- (while (and after
- (not (gnus-group-goto-group (car after))))
- (setq after (cdr after))))
- ;; Finally, just put point on the topic.
- (unless after
- (gnus-topic-goto-topic (car list))
- (setq after nil))
- t))))
-
(defun gnus-topic-kill-group (&optional n discard)
"Kill the next N groups."
(interactive "P")
(if gnus-topic-killed-topics
(let ((previous
(or (gnus-group-topic-name)
- (gnus-topic-next-topic (gnus-group-parent-topic))))
+ (gnus-topic-next-topic (gnus-current-topic))))
(item (cdr (pop gnus-topic-killed-topics))))
(gnus-topic-create-topic
(caar item) (gnus-topic-parent-topic previous) previous
(make-string
(* gnus-topic-indent-level
(or (save-excursion
- (gnus-topic-goto-topic (gnus-group-parent-topic))
+ (gnus-topic-goto-topic (gnus-current-topic))
(gnus-group-topic-level)) 0)) ? ))
yanked alist)
;; We first yank the groups the normal way...
;; to.
(setq alist (assoc (save-excursion
(forward-line -1)
- (gnus-group-parent-topic))
+ (gnus-current-topic))
gnus-topic-alist))
(when (stringp yanked)
(setq yanked (list yanked)))
(defun gnus-topic-hide-topic ()
"Hide the current topic."
(interactive)
- (when (gnus-group-parent-topic)
- (gnus-topic-goto-topic (gnus-group-parent-topic))
+ (when (gnus-current-topic)
+ (gnus-topic-goto-topic (gnus-current-topic))
(gnus-topic-remove-topic nil nil 'hidden)))
(defun gnus-topic-show-topic ()
(defun gnus-topic-mark-topic (topic &optional unmark)
"Mark all groups in the topic with the process mark."
- (interactive (list (gnus-group-parent-topic)))
+ (interactive (list (gnus-current-topic)))
(save-excursion
(let ((groups (gnus-topic-find-groups topic 9 t)))
(while groups
(defun gnus-topic-unmark-topic (topic &optional unmark)
"Remove the process mark from all groups in the topic."
- (interactive (list (gnus-group-parent-topic)))
+ (interactive (list (gnus-current-topic)))
(gnus-topic-mark-topic topic t))
(defun gnus-topic-get-new-news-this-topic (&optional n)
(defun gnus-topic-rename (old-name new-name)
"Rename a topic."
(interactive
- (let ((topic (gnus-group-parent-topic)))
+ (let ((topic (gnus-current-topic)))
(list topic
(read-string (format "Rename %s to: " topic)))))
(let ((top (gnus-topic-find-topology old-name))
(interactive "P")
(if unindent
(gnus-topic-unindent)
- (let* ((topic (gnus-group-parent-topic))
+ (let* ((topic (gnus-current-topic))
(parent (gnus-topic-previous-topic topic)))
(unless parent
(error "Nothing to indent %s into" topic))
(defun gnus-topic-unindent ()
"Unindent a topic."
(interactive)
- (let* ((topic (gnus-group-parent-topic))
+ (let* ((topic (gnus-current-topic))
(parent (gnus-topic-parent-topic topic))
(grandparent (gnus-topic-parent-topic parent)))
(unless grandparent
gnus-killed-list gnus-zombie-list)
(gnus-group-list-groups 9 nil 1)))
+(defun gnus-topic-edit-parameters (group)
+ "Edit the group parameters of GROUP.
+If performed on a topic, edit the topic parameters instead."
+ (interactive (list (gnus-group-group-name)))
+ (if group
+ (gnus-group-edit-group-parameters group)
+ (if (not (gnus-group-topic-p))
+ (error "Nothing to edit on the current line.")
+ (let ((topic (gnus-group-topic-name)))
+ (gnus-edit-form
+ (gnus-topic-parameters topic)
+ "Editing the topic parameters."
+ `(lambda (form)
+ (gnus-topic-set-parameters ,topic form)))))))
+
(provide 'gnus-topic)
;;; gnus-topic.el ends here
(and (not (,(car funs) t2 t1))
,(gnus-make-sort-function (cdr funs))))
`(,(car funs) t1 t2)))
-
+
(provide 'gnus-util)
;;; gnus-util.el ends here
(require 'gnus-load)
(require 'gnus-art)
(require 'message)
+(require 'gnus-msg)
;; Default viewing action rules
(gnus-overlay-put (gnus-make-overlay (point-min) (point-max))
'face gnus-signature-face)
(widen)
- (re-search-backward gnus-signature-separator nil t)
+ (article-search-signature)
(let ((start (match-beginning 0))
(end (set-marker (make-marker) (1+ (match-end 0)))))
(gnus-article-add-button start (1- end) 'gnus-signature-toggle
(defun gnus-button-url (address)
"Browse ADDRESS."
- (funcall browse-url-browser-function address))
+ (funcall browse-url-browser-function address browse-url-new-window-p))
;;; Next/prev buttons in the article buffer.
(vertical 1.0
(summary 0.25)
(faq 1.0 point)))
- (edit-group
+ (edit-form
(vertical 1.0
(group 0.5)
- (edit-group 1.0 point)))
- (edit-server
- (vertical 1.0
- (server 0.5)
- (edit-server 1.0 point)))
+ (edit-form 1.0 point)))
(edit-score
(vertical 1.0
(summary 0.25)
(server . gnus-server-buffer)
(browse . "*Gnus Browse Server*")
(edit-group . gnus-group-edit-buffer)
+ (edit-group . gnus-edit-form-buffer)
(edit-server . gnus-server-edit-buffer)
(group-carpal . gnus-carpal-group-buffer)
(summary-carpal . gnus-carpal-summary-buffer)
(when (and (<= emacs-major-version 19)
(<= emacs-minor-version 13))
+ (setq gnus-article-x-face-too-ugly (if (eq (device-type) 'tty) "."))
(fset 'gnus-highlight-selected-summary
'gnus-xmas-highlight-selected-summary)
(fset 'gnus-group-remove-excess-properties
(eval '(run-hooks 'gnus-load-hook))
-(defconst gnus-version-number "0.3"
+(defconst gnus-version-number "0.4"
"Version number for this version of Gnus.")
(defconst gnus-version (format "Red Gnus v%s" gnus-version-number)
(defun gnus-alive-p ()
"Say whether Gnus is running or not."
(and gnus-group-buffer
- (get-buffer gnus-group-buffer)))
+ (get-buffer gnus-group-buffer)
+ (save-excursion
+ (set-buffer gnus-group-buffer)
+ (eq major-mode 'gnus-group-mode))))
;; Info access macros.
`(setcar (nthcdr 1 ,info) ,rank))
(defmacro gnus-info-set-read (info read)
`(setcar (nthcdr 2 ,info) ,read))
-(defmacro gnus-info-set-marks (info marks)
- `(setcar (nthcdr 3 ,info) ,marks))
-(defmacro gnus-info-set-method (info method)
- `(setcar (nthcdr 4 ,info) ,method))
-(defmacro gnus-info-set-params (info params)
- `(setcar (nthcdr 5 ,info) ,params))
+(defmacro gnus-info-set-marks (info marks &optional extend)
+ (if extend
+ `(gnus-info-set-entry ,info ,marks 3)
+ `(setcar (nthcdr 3 ,info) ,marks)))
+(defmacro gnus-info-set-method (info method &optional extend)
+ (if extend
+ `(gnus-info-set-entry ,info ,method 4)
+ `(setcar (nthcdr 4 ,info) ,method)))
+(defmacro gnus-info-set-params (info params &optional extend)
+ (if extend
+ `(gnus-info-set-entry ,info ,params 5)
+ `(setcar (nthcdr 5 ,info) ,params)))
+
+(defun gnus-info-set-entry (info entry number)
+ ;; Extend the info until we have enough elements.
+ (while (< (length info) number)
+ (nconc info (list nil)))
+ ;; Set the entry.
+ (setcar (nthcdr number info) entry))
(defmacro gnus-info-set-level (info level)
`(let ((rank (cdr ,info)))
(defmacro gnus-get-info (group)
`(nth 2 (gnus-gethash ,group gnus-newsrc-hashtb)))
+;; Byte-compiler warning.
+(defvar gnus-visual)
;; Find out whether the gnus-visual TYPE is wanted.
(defun gnus-visual-p (&optional type class)
(and gnus-visual ; Has to be non-nil, at least.
(setq valids (cdr valids)))
outs))
+(defun gnus-read-method (prompt)
+ "Prompt the user for a method.
+Allow completion over sensible values."
+ (let ((method
+ (completing-read
+ prompt (append gnus-valid-select-methods gnus-server-alist)
+ nil t nil 'gnus-method-history)))
+ (cond
+ ((equal method "")
+ (setq method gnus-select-method))
+ ((assoc method gnus-valid-select-methods)
+ (list method
+ (if (memq 'prompt-address
+ (assoc method gnus-valid-select-methods))
+ (read-string "Address: ")
+ "")))
+ ((assoc method gnus-server-alist)
+ (list method))
+ (t
+ (list method "")))))
+
;;; User-level commands.
;;;###autoload
(defvar message-buffer-list nil)
+;; Byte-compiler warning
+(defvar gnus-active-hashtb)
+
;;; Regexp matching the delimiter of messages in UNIX mail format
;;; (UNIX From lines), minus the initial ^.
(defvar message-unix-mail-delimiter
;;; Code:
(require 'mail-utils)
-(eval-when-compile (require 'cl))
(defvar nnheader-max-head-length 4096
"*Max length of the head of articles.")
\(setq nnheader-file-name-translation-alist '((?: . ?_)))")
+(eval-and-compile
+ (autoload 'nnmail-message-id "nnmail")
+ (autoload 'mail-position-on-field "sendmail")
+ (autoload 'message-remove-header "message"))
+
;;; Header access macros.
(defmacro mail-header-number (header)
(point-max)))
(goto-char (point-min)))
-(defun nnheader-set-temp-buffer (name)
+(defun nnheader-set-temp-buffer (name &optional noerase)
"Set-buffer to an empty (possibly new) buffer called NAME with undo disabled."
(set-buffer (get-buffer-create name))
(buffer-disable-undo (current-buffer))
- (erase-buffer)
+ (unless noerase
+ (erase-buffer))
(current-buffer))
(defmacro nnheader-temp-write (file &rest forms)
;;; Code:
+(require 'nnheader)
(eval-when-compile (require 'cl))
(defvar nnoo-definition-alist nil)
(defvoo nntp-server-xover 'try)
(defvoo nntp-server-list-active-group 'try)
+(eval-and-compile
+ (autoload 'nnmail-read-passwd "nnmail"))
+
\f
;;; Interface functions.
(deffoo nntp-request-list (&optional server)
(nntp-possibly-change-group nil server)
- (prog1 (nntp-send-command "\r\n\\.\r\n" "LIST")
- (nntp-decode-text t)))
+ (nntp-send-command-and-decode "\r\n\\.\r\n" "LIST"))
(deffoo nntp-request-list-newsgroups (&optional server)
(nntp-possibly-change-group nil server)
- (prog1 (nntp-send-command "\r\n\\.\r\n" "LIST NEWSGROUPS")
- (nntp-decode-text t)))
+ (nntp-send-command "\r\n\\.\r\n" "LIST NEWSGROUPS"))
(deffoo nntp-request-newgroups (date &optional server)
(nntp-possibly-change-group nil server)
(nntp-process-filter proc string))))
(defun nntp-process-filter (proc string)
+ "Process filter used for waiting a calling back."
(let ((old-buffer (current-buffer)))
(unwind-protect
(let (point)
(if (buffer-name (get-buffer nntp-tmp-buffer))
(save-excursion
(set-buffer (get-buffer nntp-tmp-buffer))
+ (goto-char (point-max))
(insert-buffer-substring (process-buffer proc))))
(set-process-filter proc nil)
(erase-buffer)
(defun nntp-send-xover-command (beg end &optional wait-for-reply)
"Send the XOVER command to the server."
(let ((range (format "%d-%d" beg end))
- (curbuf (current-buffer))
(nntp-inhibit-erase t))
(if (stringp nntp-server-xover)
;; If `nntp-server-xover' is a string, then we just send this
(require 'nnheader)
(require 'gnus)
(require 'nnoo)
+(require 'gnus-util)
+(require 'gnus-start)
+(require 'gnus-sum)
(eval-when-compile (require 'cl))
(nnoo-declare nnvirtual)
--- /dev/null
+;;; pop3.el --- Post Office Protocol (RFC 1460) interface
+
+;; Copyright (C) 1996, Free Software Foundation, Inc.
+
+;; Author: Richard L. Pieri <ratinox@peorth.gweep.net>
+;; Keywords: mail, pop3
+;; Version: 1.2
+
+;; 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, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; Most of the standard Post Office Protocol version 3 (RFC 1460) commands
+;; are implemented. The LIST command has not been implemented due to lack
+;; of actual usefulness.
+;; The optional POP3 command TOP has not been implemented.
+
+;; This program was inspired by Kyle E. Jones's vm-pop program.
+
+;;; Code:
+
+(require 'mail-utils)
+(provide 'pop3)
+
+(defvar pop3-maildrop (or user-login-name (getenv "LOGNAME") (getenv "USER") nil)
+ "*POP3 maildrop.")
+(defvar pop3-mailhost (or (getenv "MAILHOST") nil)
+ "*POP3 mailhost.")
+(defvar pop3-port 110
+ "*POP3 port.")
+
+(defvar pop3-password-required t
+ "*Non-nil if a password is required when connecting to POP server.")
+(defvar pop3-password nil
+ "*Password to use when connecting to POP server.")
+
+(defvar pop3-authentication-scheme 'pass
+ "*POP3 authentication scheme. Defaults to 'pass, for the standard
+USER/PASS authentication. Other valid values are 'apop.")
+
+(defvar pop3-timestamp nil
+ "Timestamp returned when initially connected to the POP server.
+Used for APOP authentication.")
+
+(defvar pop3-read-point nil)
+(defvar pop3-debug nil)
+
+(defun pop3-movemail (&optional crashbox)
+ "Transfer contents of a maildrop to the specified CRASHBOX."
+ (or crashbox (setq crashbox (expand-file-name "~/.crashbox")))
+ (let* ((process (pop3-open-server pop3-mailhost pop3-port))
+ (crashbuf (get-buffer-create " *pop3-retr*"))
+ (n 1)
+ message-count)
+ ;; for debugging only
+ (if pop3-debug (switch-to-buffer (process-buffer process)))
+ (cond ((equal 'apop pop3-authentication-scheme)
+ (pop3-apop process pop3-maildrop))
+ ((equal 'pass pop3-authentication-scheme)
+ (pop3-user process pop3-maildrop)
+ (pop3-pass process))
+ (t (error "Invalid POP3 authentication scheme.")))
+ (setq message-count (car (pop3-stat process)))
+ (while (<= n message-count)
+ (message (format "Retrieving message %d of %d from %s..."
+ n message-count pop3-mailhost))
+ (sit-for 0)
+ (pop3-retr process n crashbuf)
+ (save-excursion
+ (set-buffer crashbuf)
+ (append-to-file (point-min) (point-max) crashbox))
+ (pop3-dele process n)
+ (setq n (+ 1 n)))
+ (pop3-quit process)
+ (kill-buffer crashbuf)
+ )
+ (sit-for 0)
+ )
+
+(defun pop3-open-server (mailhost port)
+ "Open TCP connection to MAILHOST.
+Returns the process associated with the connection."
+ (let ((process-buffer
+ (get-buffer-create (format "trace of POP session to %s" mailhost)))
+ (process))
+ (save-excursion
+ (set-buffer process-buffer)
+ (erase-buffer))
+ (setq process
+ (open-network-stream "POP" process-buffer mailhost port))
+ (setq pop3-read-point (point-min))
+ (let ((response (pop3-read-response process t)))
+ (setq pop3-timestamp
+ (substring response (or (string-match "<" response) 0)
+ (+ 1 (or (string-match ">" response) -1)))))
+ process
+ ))
+
+;; Support functions
+
+(defun pop3-process-filter (process output)
+ (save-excursion
+ (set-buffer (process-buffer process))
+ (goto-char (point-max))
+ (insert output)))
+
+(defun pop3-send-command (process command)
+ (set-buffer (process-buffer process))
+ (goto-char (point-max))
+;; (if (= (aref command 0) ?P)
+;; (insert "PASS <omitted>\r\n")
+;; (insert command "\r\n"))
+ (setq pop3-read-point (point))
+ (goto-char (point-max))
+ (process-send-string process command)
+ (process-send-string process "\r\n")
+ )
+
+(defun pop3-read-response (process &optional return)
+ "Read the response from the server.
+Return the response string if optional second argument is non-nil."
+ (let ((case-fold-search nil)
+ match-end)
+ (save-excursion
+ (set-buffer (process-buffer process))
+ (goto-char pop3-read-point)
+ (while (not (search-forward "\r\n" nil t))
+ (accept-process-output process)
+ (goto-char pop3-read-point))
+ (setq match-end (point))
+ (goto-char pop3-read-point)
+ (if (looking-at "-ERR")
+ (error (buffer-substring (point) (- match-end 2)))
+ (if (not (looking-at "+OK"))
+ (progn (setq pop3-read-point match-end) nil)
+ (setq pop3-read-point match-end)
+ (if return
+ (buffer-substring (point) match-end)
+ t)
+ )))))
+
+(defun pop3-string-to-list (string &optional regexp)
+ "Chop up a string into a list."
+ (let ((list)
+ (regexp (or regexp " "))
+ (string (if (string-match "\r" string)
+ (substring string 0 (match-beginning 0))
+ string)))
+ (store-match-data nil)
+ (while string
+ (if (string-match regexp string)
+ (setq list (cons (substring string 0 (- (match-end 0) 1)) list)
+ string (substring string (match-end 0)))
+ (setq list (cons string list)
+ string nil)))
+ (nreverse list)))
+
+(defvar pop3-read-passwd nil)
+(defun pop3-read-passwd (prompt)
+ (if (not pop3-read-passwd)
+ (if (load "passwd" t)
+ (setq pop3-read-passwd 'read-passwd)
+ (autoload 'ange-ftp-read-passwd "ange-ftp")
+ (setq pop3-read-passwd 'ange-ftp-read-passwd)))
+ (funcall pop3-read-passwd prompt))
+
+(defun pop3-clean-region (start end)
+ (setq end (set-marker (make-marker) end))
+ (save-excursion
+ (goto-char start)
+ (while (and (< (point) end) (search-forward "\r\n" end t))
+ (replace-match "\n" t t))
+ (goto-char start)
+ (while (and (< (point) end) (re-search-forward "^\\." end t))
+ (replace-match "" t t)
+ (forward-char)))
+ (set-marker end nil))
+
+(defun pop3-munge-message-separator (start end)
+ "Check to see if a message separator exists. If not, generate one."
+ (save-excursion
+ (save-restriction
+ (narrow-to-region start end)
+ (goto-char (point-min))
+ (if (not (or (looking-at "From .?") ; Unix mail
+ (looking-at "\001\001\001\001\n") ; MMDF
+ (looking-at "BABYL OPTIONS:") ; Babyl
+ ))
+ (let ((from (mail-strip-quoted-names (mail-fetch-field "From")))
+ (date (pop3-string-to-list (mail-fetch-field "Date")))
+ (From_))
+ ;; sample date formats I have seen
+ ;; Date: Tue, 9 Jul 1996 09:04:21 -0400 (EDT)
+ ;; Date: 08 Jul 1996 23:22:24 -0400
+ ;; should be
+ ;; Tue Jul 9 09:04:21 1996
+ (setq date
+ (cond ((string-match "[A-Z]" (nth 0 date))
+ (format "%s %s %s %s %s"
+ (nth 0 date) (nth 2 date) (nth 1 date)
+ (nth 4 date) (nth 3 date)))
+ (t
+ ;; this really needs to be better but I don't feel
+ ;; like writing a date to day converter.
+ (format "Sun %s %s %s %s"
+ (nth 1 date) (nth 0 date)
+ (nth 3 date) (nth 2 date)))
+ ))
+ (setq From_ (format "From %s %s\n" from date))
+ (while (string-match "," From_)
+ (setq From_ (concat (substring From_ 0 (match-beginning 0))
+ (substring From_ (match-end 0)))))
+ (goto-char (point-min))
+ (insert From_))))))
+
+;; The Command Set
+
+;; AUTHORIZATION STATE
+
+(defun pop3-user (process user)
+ "Send USER information to POP3 server."
+ (pop3-send-command process (format "USER %s" user))
+ (let ((response (pop3-read-response process t)))
+ (if (not (and response (string-match "+OK" response)))
+ (error (format "USER %s not valid." user)))))
+
+(defun pop3-pass (process)
+ "Send authentication information to the server."
+ (let ((pass pop3-password))
+ (if (and pop3-password-required (not pass))
+ (setq pass
+ (pop3-read-passwd (format "Password for %s: " pop3-maildrop))))
+ (if pass
+ (progn
+ (pop3-send-command process (format "PASS %s" pass))
+ (let ((response (pop3-read-response process t)))
+ (if (not (and response (string-match "+OK" response)))
+ (pop3-quit process)))))
+ ))
+
+(defun pop3-apop (process user)
+ "Send alternate authentication information to the server."
+ (if (not (fboundp 'md5)) (autoload 'md5 "md5"))
+ (let ((pass pop3-password))
+ (if (and pop3-password-required (not pass))
+ (setq pass
+ (pop3-read-passwd (format "Password for %s: " pop3-maildrop))))
+ (if pass
+ (let ((hash (md5 (concat pop3-timestamp pass))))
+ (pop3-send-command process (format "APOP %s %s" user hash))
+ (let ((response (pop3-read-response process t)))
+ (if (not (and response (string-match "+OK" response)))
+ (pop3-quit process)))))
+ ))
+
+;; TRANSACTION STATE
+
+(defun pop3-stat (process)
+ "Return a list of the number of messages in the maildrop and the size
+of the maildrop."
+ (pop3-send-command process "STAT")
+ (let ((response (pop3-read-response process t)))
+ (list (string-to-int (nth 1 (pop3-string-to-list response)))
+ (string-to-int (nth 2 (pop3-string-to-list response))))
+ ))
+
+(defun pop3-list (process &optional msg)
+ "Scan listing of available messages.
+This function currently does nothing.")
+
+(defun pop3-retr (process msg crashbuf)
+ "Retrieve message-id MSG from the server and place the contents in
+buffer CRASHBUF."
+ (pop3-send-command process (format "RETR %s" msg))
+ (pop3-read-response process)
+ (let ((start pop3-read-point) end)
+ (save-excursion
+ (set-buffer (process-buffer process))
+ (while (not (re-search-forward "^\\.\r\n" nil t))
+ (accept-process-output process)
+ (goto-char start))
+ (setq pop3-read-point (point-marker))
+ (goto-char (match-beginning 0))
+ (setq end (point-marker))
+ (pop3-clean-region start end)
+ (pop3-munge-message-separator start end)
+ (save-excursion
+ (set-buffer crashbuf)
+ (erase-buffer))
+ (copy-to-buffer crashbuf start end)
+ (delete-region start end)
+ )))
+
+(defun pop3-dele (process msg)
+ "Mark message-id MSG as deleted."
+ (pop3-send-command process (format "DELE %s" msg))
+ (pop3-read-response process))
+
+(defun pop3-noop (process msg)
+ "No-operation."
+ (pop3-send-command process "NOOP")
+ (pop3-read-response process))
+
+(defun pop3-last (process)
+ "Return highest accessed message-id number for the session."
+ (pop3-send-command process "LAST")
+ (let ((response (pop3-read-response process t)))
+ (string-to-int (nth 1 (pop3-string-to-list response)))
+ ))
+
+(defun pop3-rset (process)
+ "Remove all delete marks from current maildrop."
+ (pop3-send-command process "RSET")
+ (pop3-read-response process))
+
+;; UPDATE
+
+(defun pop3-quit (process)
+ "Tell server to remove all messages marked as deleted, unlock the
+maildrop, and close the connection."
+ (pop3-send-command process "QUIT")
+ (pop3-read-response process t)
+ (if process
+ (save-excursion
+ (set-buffer (process-buffer process))
+ (goto-char (point-max))
+ (delete-process process))))
+\f
+;; Summary of POP3 (Post Office Protocol version 3) commands and responses
+
+;;; AUTHORIZATION STATE
+
+;; Initial TCP connection
+;; Arguments: none
+;; Restrictions: none
+;; Possible responses:
+;; +OK [POP3 server ready]
+
+;; USER name
+;; Arguments: a server specific user-id (required)
+;; Restrictions: authorization state [after unsuccessful USER or PASS
+;; Possible responses:
+;; +OK [valid user-id]
+;; -ERR [invalid user-id]
+
+;; PASS string
+;; Arguments: a server/user-id specific password (required)
+;; Restrictions: authorization state, after successful USER
+;; Possible responses:
+;; +OK [maildrop locked and ready]
+;; -ERR [invalid password]
+;; -ERR [unable to lock maildrop]
+
+;;; TRANSACTION STATE
+
+;; STAT
+;; Arguments: none
+;; Restrictions: transaction state
+;; Possible responses:
+;; +OK nn mm [# of messages, size of maildrop]
+
+;; LIST [msg]
+;; Arguments: a message-id (optional)
+;; Restrictions: transaction state; msg must not be deleted
+;; Possible responses:
+;; +OK [scan listing follows]
+;; -ERR [no such message]
+
+;; RETR msg
+;; Arguments: a message-id (required)
+;; Restrictions: transaction state; msg must not be deleted
+;; Possible responses:
+;; +OK [message contents follow]
+;; -ERR [no such message]
+
+;; DELE msg
+;; Arguments: a message-id (required)
+;; Restrictions: transaction state; msg must not be deleted
+;; Possible responses:
+;; +OK [message deleted]
+;; -ERR [no such message]
+
+;; NOOP
+;; Arguments: none
+;; Restrictions: transaction state
+;; Possible responses:
+;; +OK
+
+;; LAST
+;; Arguments: none
+;; Restrictions: transaction state
+;; Possible responses:
+;; +OK nn [highest numbered message accessed]
+
+;; RSET
+;; Arguments: none
+;; Restrictions: transaction state
+;; Possible responses:
+;; +OK [all delete marks removed]
+
+;;; UPDATE STATE
+
+;; QUIT
+;; Arguments: none
+;; Restrictions: none
+;; Possible responses:
+;; +OK [TCP connection closed]
+Wed Jul 31 15:34:12 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
+
+ * gnus.texi (are): Fix.
+
+Wed Jul 31 15:32:57 1996 David S. Goldberg <dsg@linus.mitre.org>
+
+ * gnus.texi (buffer-name): Addition.
+
+Fri Aug 2 00:32:39 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
+
+ * gnus.texi (Pick and Read): Addition.
+ (Article Hiding): Addition.
+ (Article Signature): Made into own node.
+
+Thu Aug 1 00:25:41 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
+
+ * message.texi (Wide Reply): Addition.
+ (Bouncing): Addition.
+
+ * gnus.texi (Crosspost Handling): Made into own node.
+ (Duplicate Suppression): New.
+ (Document Server Internals): New.
+ (Changing Servers): New.
+
Wed Jul 31 15:37:44 1996 Lars Magne Ingebrigtsen <lars@eyesore.no>
* gnus.texi: Fix
* Startup Files:: Those pesky startup files---@file{.newsrc}.
* Auto Save:: Recovering from a crash.
* The Active File:: Reading the active file over a slow line Takes Time.
+* Changing Servers:: You may want to move from one server to another.
* Startup Variables:: Other variables you might change.
@end menu
Use the mantra ``dingnusdingnusdingnus'' to achieve permanent bliss.
+@node Changing Servers
+@section Changing Servers
+
+Sometimes it is necessary to move from one @sc{nntp} server to another.
+This happens very rarely, but perhaps you change jobs, or one server is
+very flake and you want to use another.
+
+Changing the server is pretty easy, right? You just change
+@code{gnus-select-method} to point to the new server?
+
+@emph{Wrong!}
+
+Article numbers are not (in any way) kept synchronized between different
+@sc{nntp} servers, and the only way Gnus keeps track of what articles
+you have read is by keeping track of article numbers. So when you
+change @code{gnus-select-method}, your @file{.newsrc} file becomes
+worthless.
+
+Gnus provides a few functions to attempt to translate a @file{.newsrc}
+file from one server to another. They all have one thing in
+common---they take a looong time to run. You don't want to use these
+functions more than absolutely necessary.
+
+@kindex M-x gnus-change-server
+@findex gnus-change-server
+If you have access to both servers, Gnus can request the headers for all
+the articles you have read and compare @code{Message-ID}s and map
+reads and article marks. The @kbd{M-x gnus-change-server} command will
+do this for all your native groups. It will prompt for the method you
+want to move to.
+
+@kindex M-x gnus-group-move-group-to-server
+@findex gnus-group-move-group-to-server
+You can also move individual groups with the @kbd{M-x
+gnus-group-move-group-to-server} command. This is useful if you want to
+move a (foreign) group from one server to another.
+
+
@node Startup Files
@section Startup Files
@cindex startup files
@table @kbd
@item T n
-@kindex T n (Group)
+@kindex T n (Topic)
@findex gnus-topic-create-topic
Prompt for a new topic name and create it
(@code{gnus-topic-create-topic}).
@item T m
-@kindex T m (Group)
+@kindex T m (Topic)
@findex gnus-topic-move-group
Move the current group to some other topic
(@code{gnus-topic-move-group}). This command understands the
process/prefix convention (@pxref{Process/Prefix}).
@item T c
-@kindex T c (Group)
+@kindex T c (Topic)
@findex gnus-topic-copy-group
Copy the current group to some other topic
(@code{gnus-topic-copy-group}). This command understands the
process/prefix convention (@pxref{Process/Prefix}).
@item T D
-@kindex T D (Group)
+@kindex T D (Topic)
@findex gnus-topic-remove-group
Remove a group from the current topic (@code{gnus-topic-remove-group}).
This command understands the process/prefix convention
(@pxref{Process/Prefix}).
@item T M
-@kindex T M (Group)
+@kindex T M (Topic)
@findex gnus-topic-move-matching
Move all groups that match some regular expression to a topic
(@code{gnus-topic-move-matching}).
@item T C
-@kindex T C (Group)
+@kindex T C (Topic)
@findex gnus-topic-copy-matching
Copy all groups that match some regular expression to a topic
(@code{gnus-topic-copy-matching}).
@item T #
-@kindex T # (Group)
+@kindex T # (Topic)
@findex gnus-topic-mark-topic
Mark all groups in the current topic with the process mark
(@code{gnus-topic-mark-topic}).
@item T M-#
-@kindex T M-# (Group)
+@kindex T M-# (Topic)
@findex gnus-topic-unmark-topic
Remove the process mark from all groups in the current topic
(@code{gnus-topic-unmark-topic}).
@item RET
-@kindex RET (Group)
+@kindex RET (Topic)
@findex gnus-topic-select-group
@itemx SPACE
Either select a group or fold a topic (@code{gnus-topic-select-group}).
prefix, group on that level (and lower) will be displayed.
@item T TAB
-@kindex T TAB (Group)
+@kindex T TAB (Topic)
@findex gnus-topic-indent
``Indent'' the current topic so that it becomes a sub-topic of the
previous topic (@code{gnus-topic-indent}). If given a prefix,
``un-indent'' the topic instead.
@item C-k
-@kindex C-k (Group)
+@kindex C-k (Topic)
@findex gnus-topic-kill-group
Kill a group or topic (@code{gnus-topic-kill-group}).
@item C-y
-@kindex C-y (Group)
+@kindex C-y (Topic)
@findex gnus-topic-yank-group
Yank the previously killed group or topic (@code{gnus-topic-yank-group}).
Note that all topics will be yanked before all groups.
@item T r
-@kindex T r (Group)
+@kindex T r (Topic)
@findex gnus-topic-rename
Rename a topic (@code{gnus-topic-rename}).
@item T DEL
-@kindex T DEL (Group)
+@kindex T DEL (Topic)
@findex gnus-topic-delete
Delete an empty topic (@code{gnus-topic-delete}).
@item A T
-@kindex A T (Group)
+@kindex A T (Topic)
@findex gnus-topic-list-active
List all groups that Gnus knows about in a topics-ified way
(@code{gnus-topic-list-active}).
+@item G p
+@kindex G p (Topic)
+@findex gnus-topic-edit-parameters
+@cindex group parameters
+@cindex topic parameters
+@cindex parameters
+Edit the topic parameters (@code{gnus-topic-edit-parameters}). All
+groups in the topic will inherit group parameters from the parent (and
+ancestor) topic parameters. Group parameters (of course) override topic
+parameters, and topic parameters in sub-topics override topic parameters
+in super-topics. You know. Normal inheretance rules.
+
@end table
* Mail Group Commands:: Some commands can only be used in mail groups.
* Various Summary Stuff:: What didn't fit anywhere else.
* Exiting the Summary Buffer:: Returning to the Group buffer.
+* Crosspost Handling:: How crossposted articles are dealt with.
+* Duplicate Suppression:: An alternative when crosspost handling fails.
@end menu
down summary buffer generation somewhat.
@item e
A single character will be displayed if the article has any children.
+@item P
+The line number.
@item u
User defined specifier. The next character in the format string should
be a letter. @sc{gnus} will call the function
* Article Washing:: Lots of way-neat functions to make life better.
* Article Buttons:: Click on URLs, Message-IDs, addresses and the like.
* Article Date:: Grumble, UT!
+* Article Signature:: What is a signature?
@end menu
@vindex gnus-signature-face
@findex gnus-article-highlight-signature
Highlight the signature (@code{gnus-article-highlight-signature}).
-Everything after @code{gnus-signature-separator} in an article will be
-considered a signature and will be highlighted with
-@code{gnus-signature-face}, which is @code{italic} by default.
+Everything after @code{gnus-signature-separator} (@pxref{Article
+Signature}) in an article will be considered a signature and will be
+highlighted with @code{gnus-signature-face}, which is @code{italic} by
+default.
@end table
@item W W s
@kindex W W s (Summary)
@findex gnus-article-hide-signature
-Hide signature (@code{gnus-article-hide-signature}).
+Hide signature (@code{gnus-article-hide-signature}). @xref{Article
+Signature}.
@item W W p
@kindex W W p (Summary)
Also @pxref{Article Highlighting} for further variables for
citation customization.
-@vindex gnus-signature-limit
-@code{gnus-signature-limit} provides a limit to what is considered a
-signature. If it is a number, no signature may not be longer (in
-characters) than that number. If it is a function, the function will be
-called without any parameters, and if it returns @code{nil}, there is no
-signature in the buffer. If it is a string, it will be used as a
-regexp. If it matches, the text in question is not a signature.
-
@node Article Washing
@subsection Article Washing
@end table
+@node Article Signature
+@subsection Article Signature
+@cindex signatures
+@cindex article signature
+
+@vindex gnus-signature-separator
+Each article is divided into two parts---the head and the body. The
+body can be divided into a signature part and a text part. The variable
+that says what is to be considered a signature is
+@code{gnus-signature-separator}. This is normally the standard
+@samp{"^-- $"} as mandated by son-of-RFC 1036. However, many people use
+non-standard signature separators, so this variable can also be a list
+of regular expressions to be tested, one by one. (Searches are done
+from the end of the body towards the beginning.) One likely value is:
+
+@lisp
+(setq gnus-signature-separator
+ '("^-- $" ; The standard
+ "^-- *$" ; A common mangling
+ "^-------*$" ; Many people just use a looong
+ ; line of dashes. Shame!
+ "^ *--------*$" ; Double-shame!
+ "^________*$" ; Underscores are also popular
+ "^========*$")) ; Pervert!
+@end lisp
+
+The more permissive you are, the more likely it is that you'll get false
+positives.
+
+@vindex gnus-signature-limit
+@code{gnus-signature-limit} provides a limit to what is considered a
+signature.
+
+@enumerate
+@item
+If it is an integer, no signature may be longer (in characters) than
+that integer.
+@item
+If it is a floating point number, no signature may be longer (in lines)
+than that number.
+@item
+If it is a function, the function will be called without any parameters,
+and if it returns @code{nil}, there is no signature in the buffer.
+@item
+If it is a string, it will be used as a regexp. If it matches, the text
+in question is not a signature.
+@end enumerate
+
+This variable can also be a list where the elements may be of the types
+listed above.
+
+
@node Summary Sorting
@section Summary Sorting
@cindex summary sorting
Here are the available keystrokes when using pick mode:
@table @kbd
+@item .
+@kindex . (Pick)
+@findex gnus-summary-mark-as-processable
+Pick the article on the current line
+(@code{gnus-summary-mark-as-processable}). If given a numerical prefix,
+go to the article on that line and pick that article. (The line number
+is normally displayed on the beginning of the summary pick lines.)
+
@item SPACE
@kindex SPACE (Pick)
-@findex gnus-summary-mark-as-processable
-Pick the article (@code{gnus-summary-mark-as-processable}).
+@findex gnus-pick-next-page
+Scroll the summary buffer up one page (@code{gnus-pick-next-page}). If
+at the end of the buffer, start reading the picked articles.
@item u
@kindex u (Pick)
@vindex gnus-pick-mode-hook
@code{gnus-pick-mode-hook} is run in pick minor mode buffers.
+@vindex gnus-mark-unpicked-articles-as-read
+If @code{gnus-mark-unpicked-articles-as-read} is non-@code{nil}, mark
+all unpicked articles as read. The default is @code{nil}.
+
+@vindex gnus-summary-pick-line-format
+The summary line format in pick mode is slightly different than the
+standard format. At the beginning of each line the line number is
+displayed. The pick mode line format is controlled by the
+@code{gnus-summary-pick-line-format} variable (@pxref{Formatting
+Variables}). It accepts the same format specs that
+@code{gnus-summary-line-format} does (@pxref{Summary Buffer Lines}).
+
@node Binary Groups
@subsection Binary Groups
this group and are marked as read, will also be marked as read in the
other subscribed groups they were cross-posted to. If this variable is
neither @code{nil} nor @code{t}, the article will be marked as read in
-both subscribed and unsubscribed groups.
+both subscribed and unsubscribed groups (@pxref{Crosspost Handling}).
+
+
+@node Crosspost Handling
+@section Crosspost Handling
@cindex velveeta
@cindex spamming
posted it to several groups separately. Posting the same article to
several groups (not cross-posting) is called @dfn{spamming}, and you are
by law required to send nasty-grams to anyone who perpetrates such a
-heinous crime.
+heinous crime. You may want to try NoCeM handling to filter out spam
+(@pxref{NoCeM}).
Remember: Cross-posting is kinda ok, but posting the same article
separately to several groups is not. Massive cross-posting (aka.
-@dfn{velveeta}) is to be avoided.
+@dfn{velveeta}) is to be avoided at all costs.
@cindex cross-posting
@cindex Xref
C'est la vie.
+For an alternative approach, @xref{Duplicate Suppression}.
+
+
+@node Duplicate Suppression
+@section Duplicate Suppression
+
+By default, Gnus tries to make sure that you don't have to read the same
+article more than once by utilizing the crossposing mechanism
+(@pxref{Crosspost Handling}). However, that simple and efficient
+approach may not work satisfactorily for some users for various
+reasons.
+
+@enumerate
+@item
+The @sc{nntp} server may fail to generate the @code{Xref} header. This
+is evil and not very common.
+
+@item
+The @sc{nntp} server may fail to include the @code{Xref} header in the
+@file{.overview} data bases. This is evil and all too common, alas.
+
+@item
+You may be reading the same group (or several related groups) from
+different @sc{nntp} servers.
+
+@item
+You may be getting mail that duplicates articles posted to groups.
+@end enumerate
+
+I'm sure there are other situations that @code{Xref} handling fails as
+well, but these four are the most common situations.
+
+If, and only if, @code{Xref} handling fails for you, then you may
+consider switching on @dfn{duplicate suppression}. If you do so, Gnus
+will remember the @code{Message-ID}s of all articles you have read or
+otherwise marked as read, and then, as if by magic, mark them as read
+all subsequent times you see them---in @emph{all} groups. Using this
+mechanism is quite likely to be somewhat inefficient, but not overly
+so. It's certainly preferrable to reading the same articles more than
+once.
+
+@table @code
+@item gnus-suppress-duplicates
+@vindex gnus-suppress-duplicates
+If non-@code{nil}, suppress duplicates.
+
+@item gnus-save-duplicate-list
+@vindex gnus-save-duplicate-list
+If non-@code{nil}, save the list of duplicates to a file. This will
+make startup and shutdown take longer, so the default is @code{nil}.
+However, this means that only duplicate articles that is read in a
+single Gnus session are suppressed.
+
+@item gnus-duplicate-list-length
+@vindex gnus-duplicate-list-length
+This variables says how many @code{Message-ID}s to keep in the duplicate
+suppression list. The default is 10000.
+
+@item gnus-duplicate-file
+@vindex gnus-duplicate-file
+The name of the file to store the duplicate suppression list. The
+default is @file{~/News/suppression}.
+@end table
+
+If you have a tendency to stop and start Gnus often, setting
+@code{gnus-save-duplicate-list} to @code{t} is probably a good idea. If
+you leave Gnus running for weeks on end, you may have it @code{nil}. On
+the other hand, saving the list makes startup and shutdown much slower,
+so that means that if you stop and start Gnus often, you should set
+@code{gnus-save-duplicate-list} to @code{nil}. Uhm. I'll leave this up
+to you to figure out, I think.
+
@node The Article Buffer
@chapter The Article Buffer
@cindex incoming mail files
@cindex deleting incoming files
If non-@code{nil}, the mail backends will delete the temporary incoming
-file after splitting mail into the proper groups. This is @code{nil} by
+file after splitting mail into the proper groups. This is @code{t} by
default for reasons of security.
@item nnmail-use-long-file-names
@code{gnus-group-mode-line-format},
@code{gnus-summary-mode-line-format},
@code{gnus-article-mode-line-format},
-@code{gnus-server-mode-line-format}.
+@code{gnus-server-mode-line-format}, and
+@code{gnus-summary-pick-line-format}.
Note that the @samp{%(} specs (and friends) do not make any sense on the
mode-line variables.
@code{gnus-buffer-configuration}:
@code{group}, @code{summary}, @code{article}, @code{server},
-@code{browse}, @code{group-mail}, @code{summary-mail},
-@code{summary-reply}, @code{info}, @code{summary-faq},
-@code{edit-group}, @code{edit-server}, @code{reply}, @code{reply-yank},
-@code{followup}, @code{followup-yank}, @code{edit-score}.
+@code{browse}, @code{message}, @code{pick}, @code{info},
+@code{summary-faq}, @code{edit-group}, @code{edit-server},
+@code{edit-score}, @code{post}, @code{reply}, @code{forward},
+@code{reply-yank}, @code{mail-bounce}, @code{draft},
+@code{pipe}, @code{bug}, @code{compose-bounce}.
+
+Note that the @code{message} key is used for both
+@code{gnus-group-mail} and @code{gnus-summary-mail-other-window}. If
+it is desireable to distinguish between the two, something like this
+might be used:
+
+@lisp
+(message (horizontal 1.0
+ (vertical 1.0 (message 1.0 point))
+ (vertical 0.24
+ (if (buffer-live-p gnus-summary-buffer)
+ '(summary 0.5))
+ (group 1.0)))))
+@end lisp
@findex gnus-add-configuration
Since the @code{gnus-buffer-configuration} variable is so long and
@findex message-wide-reply
The @code{message-wide-reply} pops up a message buffer that's a wide
-reply to the message in the current buffer.
+reply to the message in the current buffer. A @dfn{wide reply} is a
+reply that goes out to all people listed in the @code{To}, @code{From}
+and @code{Cc} headers.
@vindex message-wide-reply-to-function
Message uses the normal methods to determine where wide replies are to go,
@findex message-bounce
The @code{message-bounce} command will, if the current buffer contains a
bounced mail message, pop up a message buffer stripped of the bounce
-information.
+information. A @dfn{bounced message} is typically a mail you've sent
+out that has been returned by some @code{mailer-daemon} as
+undeliverable.
@vindex message-ignored-bounced-headers
Headers that match the @code{message-ignored-bounced-headers} regexp
projects / gnus / commitdiff