From aa088210dd9c90f00466b59c58f60f14b4544e69 Mon Sep 17 00:00:00 2001 From: Lars Magne Ingebrigtsen Date: Tue, 4 Mar 1997 01:26:40 +0000 Subject: [PATCH 1/1] Initial revision --- Makefile | 9 + lisp/ChangeLog | 199 + lisp/dgnushack.el | 9 + lisp/gnus-mh.el | 164 + lisp/gnus-uu.el | 3192 +++++++++++++++ lisp/gnus.el | 9748 +++++++++++++++++++++++++++++++++++++++++++++ lisp/mhspool.el | 490 +++ lisp/nnheader.el | 140 + lisp/nnmail.el | 601 +++ lisp/nnml.el | 707 ++++ lisp/nnspool.el | 387 ++ lisp/nntp.el | 762 ++++ lisp/nnvirtual.el | 240 ++ readme | 67 + texi/gnus.texi | 2989 ++++++++++++++ 15 files changed, 19704 insertions(+) create mode 100644 Makefile create mode 100644 lisp/ChangeLog create mode 100644 lisp/dgnushack.el create mode 100644 lisp/gnus-mh.el create mode 100644 lisp/gnus-uu.el create mode 100644 lisp/gnus.el create mode 100644 lisp/mhspool.el create mode 100644 lisp/nnheader.el create mode 100644 lisp/nnmail.el create mode 100644 lisp/nnml.el create mode 100644 lisp/nnspool.el create mode 100644 lisp/nntp.el create mode 100644 lisp/nnvirtual.el create mode 100644 readme create mode 100644 texi/gnus.texi diff --git a/Makefile b/Makefile new file mode 100644 index 000000000..a65968ae9 --- /dev/null +++ b/Makefile @@ -0,0 +1,9 @@ +EMACS=emacs + +all: elc info + +elc: + cd lisp; $(emacs) -batch -l ./dgnushack.el -f dgnushack -f batch-byte-compile *.el + +info: + cd texi; makeinfo gnus.texi diff --git a/lisp/ChangeLog b/lisp/ChangeLog new file mode 100644 index 000000000..929176204 --- /dev/null +++ b/lisp/ChangeLog @@ -0,0 +1,199 @@ +Sat Dec 31 00:55:24 1994 + + * gnus.el (gnus-newsgroup-marked): This variable had been re-named + `gnus-newsgroup-ticked'. It has been re-named back again. + +Fri Dec 30 11:45:27 1994 + + * gnus.el (gnus-summary-set-bookmark, + gnus-summary-remove-bookmark): New commands and keystrokes to set + bookmarks. + (gnus-summary-mark-as-interesting): New command and keystroke to + mark articles as interesting. + (gnus-article-prepare): Automatic moving to bookmarks added. + (gnus-summary-delete-interesting): Interesting articles that have + no children are not shown in the Summary buffer by default. + (gnus-group-expire-articles, gnus-summary-expire-articles): Trying + to expire articles in groups that do not support expiring would + make Emacs barf. + (gnus-active-to-gnus-format): Modified to read information on + moderation, if wanted. + (gnus-summary-print-dummy-lines): Obsolete variable. + (gnus-summary-make-false-root): New variable that says what method + should be used when printing loose sub-threads. + (gnus-summary-prepare-threads): Let one article adopt the orphans + instead of printing dummy roots. + +Thu Dec 29 08:20:42 1994 + + * gnus.el (gnus-summary-save-article, gnus-summary-pipe-output, + gnus-summary-save-in-rmail, gnus-summary-save-in-mail, + gnus-summary-save-in-file, gnus-summary-save-in-pipe): Rewritten + to save series of articles. + (gnus-summary-set-process-mark): Bug fix. It was possible to mark + dummy roots. + (gnus-group-describe-all-groups): New command and keystroke to + list newsgroups descriptions for all newsgroups. + (gnus-group-prepare): Removed tallying of articles in killed + groups to speed things up to enough to be of any use. + (gnus-summary-local-variables): `gnus-current-kill-articles' is no + longer buffer-local to the Summary buffers. + + * nntp.el (nntp-request-article): Fix for multiple Summary buffers + using different nntp servers. + + * gnus.el (gnus-dribble-save): Would barf if Gnus were fed a + non-existant nntp server host name. + (gnus-summary-search-subject): Marking articles as read did not go + forward over ticked articles. + (gnus-post-method): New variable for specifying a method to use + for posting articles. + (gnus-request-post-buffer, gnus-request-post): Changed to use + `gnus-post-method'. + + * nntp.el (nntp-open-server-internal): The nntpd process will now + be killed without warning when Emacs shuts down. + + * gnus.el (gnus-get-unread-articles-in-group): Returned wrong + results in groups with no articles. + + * nntp.el (nntp-server-opened): This function gave totally + spurious results. + + * gnus.el (gnus-check-first-time-used, gnus-find-new-newsgroups): + Changed to really subscribe newsgroups that are mentioned by the + "options -n" line(s). The variable + `gnus-subscribe-options-newsgroup-method' holds the subscribe + method, which is `gnus-subscribe-alphabetically' by default. + +Wed Dec 28 17:36:49 1994 + + * gnus.el (gnus-get-newsgroup-headers-xover): Fixed + cross-references when using xover. + + * gnus.el (gnus-read-old-newsrc-el-file): Made it easier to switch + between .el and .eld files. + (gnus-group-mode-map): Removed bindings for `C-n' and + `C-p'. Changed `C-m' to `gnus-group-select-group'. + (gnus-summary-mode-map): Removed bindings for `C-n' and `C-p'. + + * nntp.el (nntp-request-group): Fix when selecing non-existant + groups. + + * gnus.el (gnus-group-prepare): Faster listing of killed groups. + + * nntp.el (nntp-retrieve-headers-with-xover): Try both "xover" and + "xoverview" on nntp servers. + + * gnus.el (gnus-activate-foreign-newsgroups): This variable has + changed from a toggle to a slide. Foreign newsgroups that have a + level equal or lower than this variable will be activated on + startup. + (gnus-nntp-service): This variable has been obsoleted, except for + one tiny backwards compatibility issue. + (gnus-select-method): This variable now lets you specify nntp port + number as well. + (gnus-find-new-newsgroups): A message is displayed that says how + many new newsgroups has arrived. + (gnus-summary-position-cursor, gnus-group-position-cursor): Two + new functions that are both fset to `gnus-goto-colon', but can be + set to anything the user wishes. + (gnus-init-file, gnus-read-init-file, gnus-group-read-init-file): + New variable, function, command and keystroke to read the Gnus + init file (default: "~/.gnus"). + + * nnml.el (nnml-retrieve-header-with-nov): nnml now generates nov + databases. + (nnml-choose-mail): Fix strange cutting and add Xref header. + (nnml-article-group): Mail articles can now be crossposted between + all groups that fit the regular expressions in + `nnmail-split-methods'. + (nnml-generate-nov-databases): New command to generate nov + databases for a tree. + + * nnheader.el (gnus-backends-are-talkative): New variable. + + * nnml.el (nnml-nov-is-evil): New variable. + +Wed Dec 21 01:20:53 1994 Lars Magne Ingebrigtsen + + * gnus.el (gnus-check-news-server): Buglet. + (gnus-mail-reply-using-mail): Use "none" as the subject if none + was used. + +Tue Dec 20 01:28:42 1994 Lars Ingebrigtsen + + * nnmail.el (nnmail-request-move-article, + nnmail-request-accept-article): Functions for moving articles. One + can move articles between mail groups that use different select + methods, which also makes these functions double as conversion + routines. + + * gnus.el (gnus-open-server): All the low-level backend functions + have been rewritten to make things cleaner and clearer. Most of + the function calls have also been changed throughout the program. + (gnus-set-global-variables): Set the global equivalents of the + summary-local variables whenever a new article is chosen. + +Mon Dec 19 00:51:03 1994 Lars Ingebrigtsen + + * nnml.el (nnml-request-move-article, + nnml-request-accept-article): Functions for moving articles. + + * gnus.el (gnus-summary-rescan-group): New command and keystroke + for exiting, getting new articles, and re-selecting a group. + (gnus-group-make-mail-groups): Created mail groups + without the foreign group prefix, which is a serious bug. + (gnus-dribble-file-name): Change the name of the dribble file to + ".newsrc-dribble". + (gnus-group-startup-message): Changed startup screen. (Trés + important.) + (gnus-summary-move-article): New command and keystroke for moving + articles between (mail) newsgroups. + + * nnmail.el (nnmail-split-region): + * nnml.el (nnml-choose-mail): Add a Lines header line to mails + that do not have them. + + * gnus.el: Moved most functions to make the source code a bit more + structured. Added a few autoloads to kill the last few compiler + warnings. + (gnus-group-clear-dribble): New command and keystroke to clear the + dribble buffer. + + * nntp.el (nntp-open-server-internal): Further multiple nntp + server fixes. + +Sun Dec 18 01:48:28 1994 Lars Ingebrigtsen + + * gnus-mh.el: All the mh-e functions have been moved to this new + file. + + * gnus.el (gnus-summary-prepare-threads, + gnus-summary-insert-line): If the subject changes in the middle of + the thread, print the subject. + (gnus-save-newsrc-file): Save the newsrc file(s) even when the + dribble file has been saved, and don't save them when no changes + have been made. + + * nntp.el (nntp-request-group): When using multiple nntp servers, + the backend often became a bit dizzy. + (nntp-open-server): Opening a server now correctly says whether a + connection was established. + + * gnus.el (gnus-version): Rewrite to add version numbers from all + backends in use. + (gnus-extend-newsgroup): Small fix. + (gnus-find-header-by-number): Obsolete function. + (gnus-clear-system): Kill all generated buffers when exiting. + (gnus-exit-group-hook): Kill the nntp connection(s) when exiting. + +Mon Dec 12 18:15:03 1994 Lars Ingebrigtsen + + * gnus.el: Version 0.2 released after some initial bugs were + fixed. + +Sun Dec 11 06:32:40 1994 Lars Ingebrigtsen + + * gnus.el: The very first (ding) Gnus pre-release. + diff --git a/lisp/dgnushack.el b/lisp/dgnushack.el new file mode 100644 index 000000000..57597cc84 --- /dev/null +++ b/lisp/dgnushack.el @@ -0,0 +1,9 @@ +;; Is this really the only way to set the load path? Seems awfully +;; kludgy to load this file and run this function just to do something +;; as simple as that... Anyways, it won't be in the production code, +;; so who cares? + +(defun dgnushack () + (setq load-path (cons "." load-path))) + + diff --git a/lisp/gnus-mh.el b/lisp/gnus-mh.el new file mode 100644 index 000000000..97165bdd6 --- /dev/null +++ b/lisp/gnus-mh.el @@ -0,0 +1,164 @@ +;;; gnus-mh: mh-e interface for Gnus +;; Copyright (C) 1994 Free Software Foundation, Inc. + +;; Author: Masanobu UMEDA +;; Lars Ingebrigtsen +;; Keywords: news + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to +;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +;;; Commentary: + +;;; Send mail using mh-e. + +;; The following mh-e interface is all cooperative works of +;; tanaka@flab.fujitsu.CO.JP (TANAKA Hiroshi), kawabe@sra.CO.JP +;; (Yoshikatsu Kawabe), and shingu@casund.cpr.canon.co.jp (Toshiaki +;; SHINGU). + +;;; Code: + +(require 'mh-e) +(require 'mh-comp) +(require 'gnus) + +(defun gnus-summary-save-in-folder (&optional folder) + "Save this article to MH folder (using `rcvstore' in MH library). +Optional argument FOLDER specifies folder name." + ;; Thanks to yuki@flab.Fujitsu.JUNET and ohm@kaba.junet. + (mh-find-path) + (let ((folder + (or folder + (mh-prompt-for-folder + "Save article in" + (funcall gnus-folder-save-name gnus-newsgroup-name + gnus-current-headers gnus-newsgroup-last-folder) + t))) + (errbuf (get-buffer-create " *Gnus rcvstore*"))) + (gnus-eval-in-buffer-window + gnus-article-buffer + (save-restriction + (widen) + (unwind-protect + (call-process-region (point-min) (point-max) + (expand-file-name "rcvstore" mh-lib) + nil errbuf nil folder) + (set-buffer errbuf) + (if (zerop (buffer-size)) + (message "Article saved in folder: %s" folder) + (message "%s" (buffer-string))) + (kill-buffer errbuf)))) + (setq gnus-newsgroup-last-folder folder))) + +(defun gnus-mail-reply-using-mhe (&optional yank) + "Compose reply mail using mh-e. +Optional argument YANK means yank original article. +The command \\[mh-yank-cur-msg] yank the original message into current buffer." + ;; First of all, prepare mhe mail buffer. + ;; Bug fix by Timo METZEMAKERS . + (pop-to-buffer gnus-article-buffer) + (let (from cc subject date to reply-to (buffer (current-buffer))) + (save-restriction + (gnus-article-show-all-headers) ;I don't think this is really needed. + (setq from (gnus-fetch-field "from") + subject (let ((subject (or (gnus-fetch-field "subject") + "(None)"))) + (if (and subject + (not (string-match "^[Rr][Ee]:.+$" subject))) + (concat "Re: " subject) subject)) + reply-to (gnus-fetch-field "reply-to") + cc (gnus-fetch-field "cc") + date (gnus-fetch-field "date")) + (setq mh-show-buffer buffer) + (setq to (or reply-to from)) + (mh-find-path) + (mh-send to (or cc "") subject) + (save-excursion + (mh-insert-fields + "In-reply-to:" + (concat + (substring from 0 (string-match " *at \\| *@ \\| *(\\| *<" from)) + "'s message of " date))) + (setq mh-sent-from-folder buffer) + (setq mh-sent-from-msg 1) + )) + ;; Then, yank original article if requested. + (if yank + (let ((last (point))) + (mh-yank-cur-msg) + (goto-char last) + ))) + +;; gnus-mail-forward-using-mhe is contributed by Jun-ichiro Itoh +;; + +(defun gnus-mail-forward-using-mhe () + "Forward the current message to another user using mh-e." + ;; First of all, prepare mhe mail buffer. + (let ((to (read-string "To: ")) + (cc (read-string "Cc: ")) + (buffer (current-buffer)) + subject) + ;;(gnus-article-show-all-headers) + (setq subject + (concat "[" gnus-newsgroup-name "] " + ;;(mail-strip-quoted-names (gnus-fetch-field "From")) ": " + (or (gnus-fetch-field "subject") ""))) + (setq mh-show-buffer buffer) + (mh-find-path) + (mh-send to (or cc "") subject) + (save-excursion + (goto-char (point-max)) + (insert "\n------- Forwarded Message\n\n") + (insert-buffer buffer) + (goto-char (point-max)) + (insert "\n------- End of Forwarded Message\n") + (setq mh-sent-from-folder buffer) + (setq mh-sent-from-msg 1)))) + +(defun gnus-mail-other-window-using-mhe () + "Compose mail other window using mh-e." + (let ((to (read-string "To: ")) + (cc (read-string "Cc: ")) + (subject (read-string "Subject: " (gnus-fetch-field "subject")))) + (gnus-article-show-all-headers) ;I don't think this is really needed. + (setq mh-show-buffer (current-buffer)) + (mh-find-path) + (mh-send-other-window to cc subject) + (setq mh-sent-from-folder (current-buffer)) + (setq mh-sent-from-msg 1))) + +(defun gnus-Folder-save-name (newsgroup headers &optional last-folder) + "Generate folder name from NEWSGROUP, HEADERS, and optional LAST-FOLDER. +If variable `gnus-use-long-file-name' is nil, it is +News.group. +Otherwise, it is like +news/group." + (or last-folder + (concat "+" + (if gnus-use-long-file-name + (gnus-capitalize-newsgroup newsgroup) + (gnus-newsgroup-directory-form newsgroup))))) + +(defun gnus-folder-save-name (newsgroup headers &optional last-folder) + "Generate folder name from NEWSGROUP, HEADERS, and optional LAST-FOLDER. +If variable `gnus-use-long-file-name' is nil, it is +news.group. +Otherwise, it is like +news/group." + (or last-folder + (concat "+" + (if gnus-use-long-file-name + newsgroup + (gnus-newsgroup-directory-form newsgroup))))) + diff --git a/lisp/gnus-uu.el b/lisp/gnus-uu.el new file mode 100644 index 000000000..41b7d4d7a --- /dev/null +++ b/lisp/gnus-uu.el @@ -0,0 +1,3192 @@ +;;; gnus-uu.el --- extract, view or save (uu)encoded files from gnus + +;; Copyright (C) 1985, 1986, 1987, 1993, 1994 Free Software Foundation, Inc. + +;; Author: Lars Ingebrigtsen +;; Created: 2 Oct 1993 +;; Version: v2.9.4 +;; Last Modified: 1994/10/03 +;; Keyword: news + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to +;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +;;; Commentary: + +;; All gnus-uu commands start with `C-c C-v'. +;; +;; Short user manual for this package: +;; +;; Type `C-c C-v C-v' to decode and view all articles of the current +;; series. The defaults should be reasonable for most systems. +;; +;; Type `C-c C-v C-i' to toggle interactive mode. When using +;; interactive mode, gnus-uu will which display a buffer that will let +;; you see the suggested commands to be executed. +;; +;; To post an uuencoded file, type `C-c C-v p', which will enter you +;; into a buffer analogous to the one you will get when typing `a'. Do +;; an `M-x describe-mode' in this buffer to get a description of what +;; this buffer lets you do. +;; +;; Read the documentation of the `gnus-uu' dummy function for a more +;; complete description of what this package does and how you can +;; customize it to fit your needs. +;; +;; +;; +;; History +;; +;; v1.0: First version released Oct 2 1992. +;; +;; v1.1: Changed `C-c C-r' to `C-c C-e' and `C-c C-p' to `C-c C-k'. +;; Changed (setq gnus-exit-group-hook) to (add-hook). Removed +;; checking for "Re:" for finding parts. +;; +;; v2.2: Fixed handling of currupted archives. Changed uudecoding to +;; an asynchronous process to avoid loading tons of data into emacs +;; buffers. No longer reads articles emacs already have aboard. Fixed +;; a firmer support for shar files. Made regexp searches for files +;; more convenient. Added `C-c C-l' for editing uucode begin +;; lines. Added multi-system decoder entry point. Added interactive +;; view mode. Added function for decoding and saving all uuencoded +;; articles in the current newsgroup. +;; +;; v2.3: After suggestions I have changed all the gnus-uu key bindings +;; to avoid hogging all the user keys (C-c LETTER). Also added +;; (provide) and fixed some saving stuff. First posted version to +;; gnu.emacs.sources. +;; +;; v2.4: Fixed some more in the save-all category. Automatic fixing of +;; uucode "begin" lines: names on the form of "dir/file" are +;; translated into "dir-file". Added a function for fixing stripped +;; uucode articles. Added binhex save. +;; +;; v2.5: First version copyrighted by FSF. Changed lots of +;; documentation strings. +;; +;; v2.5.1: Added uuencode/posting code to post binary files. +;; +;; v2.6: Thread support. gnus-uu is now able to decode uuencoded files +;; posted in threads. gnus-uu can also post in threads. I don't know +;; if this ability is of much use - I've never seen anyone post +;; uuencoded files in threads. +;; +;; v2.7: gnus-uu is now able to decode (and view/save) multiple +;; encoded files in one big gulp. Also added pseudo-mime support +;; (users can use metamail to view files), posting uuencoded/mime +;; files and various other bits and pieces. +;; +;; v2.7.1: New functions for decoding/saving threads bound to `C-c +;; C-v C-j'. Handy to save entire threads, not very useful for +;; decoding, as nobody posts encoded files in threads... +;; +;; v2.7.2: New functions for digesting and forwarding articles added +;; on the suggestion of Per Abrahamsen. Also added a function for +;; marking threads. +;; +;; v2.8: Fixed saving original files in interactive mode. Fixed ask +;; before/save after view. Fixed setting up interactive buffers. Added +;; scanning and rescanning from interactive mode. Added the +;; `gnus-uu-ignore-file-by-name' and `...-by-type' variables to allow +;; users to sift files they don't want to view. At the suggestion of +;; boris@cs.rochester.edu, `C-c C-v C-h' has been undefined to allow +;; users to view list of binding beginning with `C-c C-v'. Fixed +;; viewing with `gnus-uu-asynchronous' set. The +;; "decode-and-save/view-all-articles" functions now accepts the +;; numeric prefix to delimit the maximum number of files to be +;; decoded. +;; +;; v2.9: Speeded up fetching of articles by bypassing the gnus +;; function and going directly to `gnus-request-article' +;; instead. Significant speed increase, especially when using a local +;; spool. Added the `gnus-uu-universal-prefix' command (`C-c C-v C-u') +;; to allow users to perform any job on all marked articles. +;; +;; v2.9.1: Disabled buffer-undo, which stopped gnus-uu from making +;; emacs *very* large in big newsgroups. +;; +;; v2.9.2: A few minor bug-fixes. +;; +;; v2.9.3: Finally managed to fix the bug that made gnus-uu core dump +;; emacs in huge newsgroups. The error was a result of not deleting a +;; process that had terminated with an error, which led to +;; select() failing miserably later. Added the `C-c C-v M-C-w' and +;; `C-c C-v M-w' keystrokes and the `...-marked-files' functions to +;; allow users to walk around the newsgroup and mark some articles +;; here and there, without having to worry about marking exactly +;; right, and then decoding all files that had had some articles +;; marked. + +;;; Code: + +(require 'gnus) + +;; Binding of keys to the gnus-uu functions. + +(defvar gnus-uu-ctl-map nil) +(define-prefix-command 'gnus-uu-ctl-map) +(define-key gnus-summary-mode-map "\C-c\C-v" gnus-uu-ctl-map) + +(define-key gnus-uu-ctl-map "\C-v" 'gnus-uu-decode-and-view) +(define-key gnus-uu-ctl-map "v" 'gnus-uu-decode-and-save) +(define-key gnus-uu-ctl-map "\C-s" 'gnus-uu-shar-and-view) +(define-key gnus-uu-ctl-map "s" 'gnus-uu-shar-and-save) +(define-key gnus-uu-ctl-map "\C-m" 'gnus-uu-multi-decode-and-view) +(define-key gnus-uu-ctl-map "m" 'gnus-uu-multi-decode-and-save) + +(define-key gnus-uu-ctl-map "\C-b" 'gnus-uu-decode-and-show-in-buffer) + +(define-key gnus-uu-ctl-map "u" 'gnus-summary-unmark-all-processable) +(define-key gnus-uu-ctl-map "\C-r" 'gnus-uu-mark-by-regexp) +(define-key gnus-uu-ctl-map "r" 'gnus-uu-mark-region) +(define-key gnus-uu-ctl-map "t" 'gnus-uu-mark-thread) + +(define-key gnus-uu-ctl-map "\C-u" 'gnus-uu-marked-universal-argument) + +(define-key gnus-uu-ctl-map "\M-\C-v" 'gnus-uu-marked-decode-and-view) +(define-key gnus-uu-ctl-map "\M-v" 'gnus-uu-marked-decode-and-save) +(define-key gnus-uu-ctl-map "\M-\C-s" 'gnus-uu-marked-shar-and-view) +(define-key gnus-uu-ctl-map "\M-s" 'gnus-uu-marked-shar-and-save) +(define-key gnus-uu-ctl-map "\M-\C-m" 'gnus-uu-marked-multi-decode-and-view) +(define-key gnus-uu-ctl-map "\M-m" 'gnus-uu-marked-multi-decode-and-save) + +(define-key gnus-uu-ctl-map "f" 'gnus-uu-digest-and-forward) +(define-key gnus-uu-ctl-map "\M-f" 'gnus-uu-marked-digest-and-forward) + +(define-key gnus-uu-ctl-map "\C-i" 'gnus-uu-toggle-interactive-view) +(define-key gnus-uu-ctl-map "\C-t" 'gnus-uu-toggle-any-variable) + +(define-key gnus-uu-ctl-map "\C-l" 'gnus-uu-edit-begin-line) + +(define-key gnus-uu-ctl-map "a" 'gnus-uu-decode-and-save-all-unread-articles) +(define-key gnus-uu-ctl-map "w" 'gnus-uu-decode-and-save-all-articles) +(define-key gnus-uu-ctl-map "\C-a" 'gnus-uu-decode-and-view-all-unread-articles) +(define-key gnus-uu-ctl-map "\C-w" 'gnus-uu-decode-and-view-all-articles) +(define-key gnus-uu-ctl-map "\M-\C-w" 'gnus-uu-decode-and-view-all-marked-files) +(define-key gnus-uu-ctl-map "\M-w" 'gnus-uu-decode-and-save-all-marked-files) + +(define-key gnus-uu-ctl-map "\C-j" 'gnus-uu-threaded-multi-decode-and-view) +(define-key gnus-uu-ctl-map "j" 'gnus-uu-threaded-multi-decode-and-save) + +(define-key gnus-uu-ctl-map "p" 'gnus-uu-post-news) + +;; Dummy function gnus-uu + +(defun gnus-uu () + "gnus-uu is a package for uudecoding and viewing articles. + + +Keymap overview: + +By default, all gnus-uu keystrokes begin with `C-c C-v'. + +There four decoding commands categories: +All commands for viewing are `C-c C-v C-LETTER'. +All commands for saving are `C-c C-v LETTER'. +All commands for marked viewing are `C-c C-v C-M-LETTER'. +All commands for marked saving are `C-c C-v M-LETTER'. + +\\\\[gnus-uu-decode-and-view]\tDecode and view articles +\\[gnus-uu-decode-and-save]\tDecode and save articles +\\[gnus-uu-shar-and-view]\tUnshar and view articles +\\[gnus-uu-shar-and-save]\tUnshar and save articles +\\[gnus-uu-multi-decode-and-view]\tChoose a decoding method, decode and view articles +\\[gnus-uu-multi-decode-and-save]\tChoose a decoding method, decode and save articles + +\\[gnus-uu-threaded-multi-decode-and-view]\tDecode a thread and view +\\[gnus-uu-threaded-multi-decode-and-save]\tDecode a thread and save + +\\[gnus-uu-decode-and-show-in-buffer]\tDecode the current article and view the result in a buffer +\\[gnus-uu-edit-begin-line]\tEdit the 'begin' line of an uuencoded article + +\\[gnus-uu-decode-and-save-all-unread-articles]\tDecode and save all unread articles +\\[gnus-uu-decode-and-save-all-articles]\tDecode and save all articles +\\[gnus-uu-decode-and-view-all-unread-articles]\tDecode and view all unread articles +\\[gnus-uu-decode-and-view-all-articles]\tDecode and view all articles +\\[gnus-uu-decode-and-view-all-marked-files]\tDecode and view all files that have had some articles marked +\\[gnus-uu-decode-and-save-all-marked-files]\tDecode and save all files that have had some articles marked + +\\[gnus-uu-digest-and-forward]\tDigest and forward a series of articles +\\[gnus-uu-marked-digest-and-forward]\tDigest and forward all marked articles + +\\[gnus-uu-mark-by-regexp]\tMark articles for decoding by regexp +\\[gnus-uu-mark-thread]\tMark articles in this thread +\\[gnus-uu-mark-region]\tMark articles all articles between point and mark +\\[gnus-uu-marked-decode-and-view]\tDecode and view marked articles +\\[gnus-uu-marked-decode-and-save]\tDecode and save marked articles +\\[gnus-uu-marked-shar-and-view]\tUnshar and view marked articles +\\[gnus-uu-marked-shar-and-save]\tUnshar and save marked articles +\\[gnus-uu-marked-multi-decode-and-view]\tChoose decoding method, decode and view marked articles +\\[gnus-uu-marked-multi-decode-and-save]\tChoose decoding method, decode and save marked articles + +\\[gnus-uu-marked-universal-argument]\tPerform any opration on all marked articles + +\\[gnus-uu-toggle-asynchronous]\tToggle asynchronous viewing mode +\\[gnus-uu-toggle-query]\tToggle whether to ask before viewing a file +\\[gnus-uu-toggle-always-ask]\tToggle whether to ask to save a file after viewing +\\[gnus-uu-toggle-kill-carriage-return]\tToggle whether to strip trailing carriage returns +\\[gnus-uu-toggle-interactive-view]\tToggle whether to use interactive viewing mode +\\[gnus-uu-toggle-correct-stripped-articles]\tToggle whether to 'correct' articles +\\[gnus-uu-toggle-view-with-metamail]\tToggle whether to use metamail for viewing +\\[gnus-uu-toggle-any-variable]\tToggle any of the things above + +\\[gnus-uu-post-news]\tPost an uuencoded article + +Function description: + +`gnus-uu-decode-and-view' will try to find all articles in the same +series, uudecode them and view the resulting file(s). + +gnus-uu guesses what articles are in the series according to the +following simplish rule: The subjects must be (nearly) identical, +except for the last two numbers of the line. (Spaces are largely +ignored, however.) + +For example: If you choose a subject called + \"cat.gif (2/3)\" +gnus-uu will find all the articles that matches + \"^cat.gif ([0-9]+/[0-9]+).*$\". + +Subjects that are nonstandard, like + \"cat.gif (2/3) Part 6 of a series\", +will not be properly recognized by any of the automatic viewing +commands, and you have to mark the articles manually with '#'. + +`gnus-uu-decode-and-save' will do the same as +`gnus-uu-decode-and-view', except that it will not display the +resulting file, but save it instead. + +`gnus-uu-shar-and-view' and `gnus-uu-shar-and-save' are the \"shar\" +equivalents to the uudecode functions. Instead of feeding the articles +to uudecode, they are run through /bin/sh. Most shar files can be +viewed and/or saved with the normal uudecode commands, which is much +safer, as no foreign code is run. + +Instead of having windows popping up automatically, it can be handy to +view files interactivly, especially when viewing archives. Use +`gnus-uu-toggle-interactive-mode' to toggle interactive mode. + +`gnus-uu-mark-article' marks an article for later +decoding/unsharing/saving/viewing. The files will be decoded in the +sequence they were marked. To decode the files after you've marked the +articles you are interested in, type the corresponding key strokes as +the normal decoding commands, but put a `M-' in the last +keystroke. For instance, to perform a standard uudecode and view, you +would type `C-c C-v C-v'. To perform a marked uudecode and view, say +`C-v C-v M-C-v'. All the other view and save commands are handled the +same way; marked uudecode and save is then `C-c C-v M-v'. + +`gnus-uu-unmark-article' will remove the mark from a previosly marked +article. + +`gnus-uu-unmark-all-articles' will remove the mark from all marked +articles. + +`gnus-uu-mark-by-regexp' will prompt for a regular expression and mark +all articles matching that regular expression. + +`gnus-uu-mark-thread' will mark all articles downward in the current +thread. + +`gnus-uu-marked-universal-argument' will perform any operation on all +marked articles. + +There's an additional way to reach the decoding functions to make +future expansions easier: `gnus-uu-multi-decode-and-view' and the +corresponding save, marked view and marked save functions. You will be +prompted for a decoding method, like uudecode, shar, binhex or plain +save. Note that methods like binhex and save doesn't have view modes; +even if you issue a view command (`C-c C-v C-m' and \"binhex\"), +gnus-uu will just save the resulting binhex file. + +`gnus-uu-decode-and-show-in-buffer' will decode the current article +and display the results in an emacs buffer. This might be useful if +there's jsut some text in the current article that has been uuencoded +by some perverse poster. + +`gnus-uu-decode-and-save-all-articles' looks at all the articles in +the current newsgroup and tries to uudecode everything it can +find. The user will be prompted for a directory where the resulting +files (if any) will be +saved. `gnus-uu-decode-and-save-unread-articles' does only checks +unread articles. + +`gnus-uu-decode-and-view-all-articles' does the same as the function +above, only viewing files instead of saving them. + +`gnus-uu-edit-begin-line' lets you edit the begin line of an uuencoded +file in the current article. Useful to change a corrupted begin line. + + +When using the view commands, `gnus-uu-decode-and-view' for instance, +gnus-uu will (normally, see below) try to view the file according to +the rules given in `gnus-uu-default-view-rules' and +`gnus-uu-user-view-rules'. If it recognizes the file, it will display +it immediately. If the file is some sort of archive, gnus-uu will +attempt to unpack the archive and see if any of the files in the +archive can be viewed. For instance, if you have a gzipped tar file +\"pics.tar.gz\" containing the files \"pic1.jpg\" and \"pic2.gif\", +gnus-uu will uncompress and detar the main file, and then view the two +pictures. This unpacking process is recursive, so if the archive +contains archives of archives, it'll all be unpacked. + +If the view command doesn't recognise the file type, or can't view it +because you don't have the viewer, or can't view *any* of the files in +the archive, the user will be asked if she wishes to have the file +saved somewhere. Note that if the decoded file is an archive, and +gnus-uu manages to view some of the files in the archive, it won't +tell the user that there were some files that were unviewable. Try +interactive view for a different approach. + + +Note that gnus-uu adds a function to `gnus-exit-group-hook' to clear +the list of marked articles and check for any generated files that +might have escaped deletion if the user typed `C-g' during viewing. + + +`gnus-uu-toggle-asynchronous' toggles the `gnus-uu-asynchronous' +variable. + +`gnus-uu-toggle-query' toggles the `gnus-uu-ask-before-view' +variable. + +`gnus-uu-toggle-always-ask' toggles the `gnus-uu-view-and-save' +variable. + +`gnus-uu-toggle-kill-carriage-return' toggles the +`gnus-uu-kill-carriage-return' variable. + +`gnus-uu-toggle-interactive-view' toggles interactive mode. If it is +turned on, gnus-uu won't view files immediately, but will give you a +buffer with the default commands and files and let you edit the +commands and execute them at leisure. + +`gnus-uu-toggle-correct-stripped-articles' toggles whether to check +and correct uuencoded articles that may have had trailing spaces +stripped by mailers. + +`gnus-uu-toggle-view-with-metamail' toggles whether to skip the +gnus-uu viewing methods and just guess at an content-type based on the +file name suffix and feed it to metamail. + +`gnus-uu-toggle-any-variable' is an interface to the toggle commands +listed above. + + +Customization + + Rule Variables + + gnus-uu uses \"rule\" variables to decide how to view a file. All + these variables are of the form + + (list '(regexp1 command2) + '(regexp2 command2) + ...) + + `gnus-uu-user-view-rules' + This variable is consulted first when viewing files. If you wish + to use, for instance, sox to convert an .au sound file, you could + say something like: + + (setq gnus-uu-user-view-rules + (list '(\"\\\\.au$\" \"sox %s -t .aiff > /dev/audio\"))) + + `gnus-uu-user-view-rules-end' + This variable is consulted if gnus-uu couldn't make any matches + from the user and default view rules. + + `gnus-uu-user-interactive-view-rules' + This is the variable used instead of `gnus-uu-user-view-rules' + when in interactive mode. + + `gnus-uu-user-interactive-view-rules-end' + This variable is used instead of `gnus-uu-user-view-rules-end' + when in interactive mode. + + `gnus-uu-user-archive-rules` + This variable can be used to say what comamnds should be used to + unpack archives. + + + Other Variables + + `gnus-uu-ignore-files-by-name' + Files with name matching this regular expression won't be viewed. + + `gnus-uu-ignore-files-by-type' + Files with a MIME type matching this variable won't be viewed. + Note that gnus-uu tries to guess what type the file is based on + the name. gnus-uu is not a MIME package, so this is slightly + kludgy. + + `gnus-uu-tmp-dir' + Where gnus-uu does its work. + + `gnus-uu-do-not-unpack-archives' + Non-nil means that gnus-uu won't peek inside archives looking for + files to dispay. + + `gnus-uu-view-and-save' + Non-nil means that the user will always be asked to save a file + after viewing it. + + `gnus-uu-asynchronous' + Non-nil means that files will be viewed asynchronously. This can + be useful if you're viewing long .mod files, for instance, which + often takes several minutes. Note, however, that since gnus-uu + doesn't ask, and if you are viewing an archive with lots of + viewable files, you'll get them all up more or less at once, + which can be confusing, to say the least. To get gnus-uu to ask + you before viewing a file, set the `gnus-uu-ask-before-view' + variable. + + `gnus-uu-ask-before-view' + Non-nil means that gnus-uu will ask you before viewing each file + + `gnus-uu-ignore-default-view-rules' + Non-nil means that gnus-uu will ignore the default viewing rules. + + `gnus-uu-ignore-default-archive-rules' + Non-nil means that gnus-uu will ignore the default archive + unpacking commands. + + `gnus-uu-kill-carriage-return' + Non-nil means that gnus-uu will strip all carriage returns from + articles. + + `gnus-uu-unmark-articles-not-decoded' + Non-nil means that gnus-uu will mark articles that were + unsuccessfully decoded as unread. + + `gnus-uu-output-window-height' + This variable says how tall the output buffer window is to be + when using interactive view mode. + + `gnus-uu-correct-stripped-uucode' + Non-nil means that gnus-uu will *try* to fix uuencoded files that + have had traling spaces deleted. + + `gnus-uu-use-interactive-view' + Non-nil means that gnus-uu will use interactive viewing mode. + + `gnus-uu-view-with-metamail' + Non-nil means that gnus-uu will ignore the viewing commands + defined by the rule variables and just fudge a MIME content type + based on the file name. The result will be fed to metamail for + viewing. + + `gnus-uu-save-in-digest' + Non-nil means that gnus-uu, when asked to save without decoding, + will save in digests. If this variable is nil, gnus-uu will just + save everything in a file without any embellishments. The + digesting almost conforms to RFC1153 - no easy way to specify any + meaningful volume and issue numbers were found, so I simply + dropped them. + + `gnus-uu-post-include-before-composing' + Non-nil means that gnus-uu will ask for a file to encode before + you compose the article. If this variable is t, you can either + include an encoded file with \\\\[gnus-uu-post-insert-binary-in-article] or have one included for you when you + post the article. + + `gnus-uu-post-length' + Maximum length of an article. The encoded file will be split + into how many articles it takes to post the entire file. + + `gnus-uu-post-threaded' + Non-nil means that gnus-uu will post the encoded file in a + thread. This may not be smart, as no other decoder I have seen + are able to follow threads when collecting uuencoded + articles. (Well, I have seen one package that does that - + gnus-uu, but somehow, I don't think that counts...) Default is + nil. + + `gnus-uu-post-separate-description' + Non-nil means that the description will be posted in a separate + article. The first article will typically be numbered (0/x). If + this variable is nil, the description the user enters will be + included at the beginning of the first article, which will be + numbered (1/x). Default is t. +" + (interactive) + ) + +;; Default viewing action rules + +(defvar gnus-uu-default-view-rules + (list + '("\\.\\(jpe?g\\|gif\\|tiff?\\|p[pgb]m\\|xwd\\|xbm\\|pcx\\)$" "xv") + '("\\.tga$" "tgatoppm %s | xv -") + '("\\.te?xt$\\|\\.doc$\\|read.*me" "xterm -e less") + '("\\.\\(wav\\|aiff\\|hcom\\|u[blw]\\|s[bfw]\\|voc\\|smp\\)$" + "sox -v .5 %s -t .au -u - > /dev/audio") + '("\\.au$" "cat %s > /dev/audio") + '("\\.mod$" "str32") + '("\\.ps$" "ghostview") + '("\\.dvi$" "xdvi") + '("\\.[1-6]$" "xterm -e groff -mandoc -Tascii") + '("\\.html$" "xmosaic") + '("\\.mpe?g$" "mpeg_play") + '("\\.\\(flc\\|fli\\|rle\\|iff\\|pfx\\|avi\\|sme\\|rpza\\|dl\\|qt\\|rsrc\\|mov\\)$" "xanim") + '("\\.\\(tar\\|arj\\|zip\\|zoo\\|arc\\|gz\\|Z\\|lzh\\|ar\\|lha\\)$" + "gnus-uu-archive")) + + "Default actions to be taken when the user asks to view a file. +To change the behaviour, you can either edit this variable or set +`gnus-uu-user-view-rules' to something useful. + +For example: + +To make gnus-uu use 'xli' to display JPEG and GIF files, put the +following in your .emacs file + + (setq gnus-uu-user-view-rules (list '(\"jpg$\\\\|gif$\" \"xli\"))) + +Both these variables are lists of lists with two string elements. The +first string is a regular expression. If the file name matches this +regular expression, the command in the second string is executed with +the file as an argument. + +If the command string contains \"%s\", the file name will be inserted +at that point in the command string. If there's no \"%s\" in the +command string, the file name will be appended to the command string +before executing. + +There are several user variables to tailor the behaviour of gnus-uu to +your needs. First we have `gnus-uu-user-view-rules', which is the +variable gnus-uu first consults when trying to decide how to view a +file. If this variable contains no matches, gnus-uu examines the +default rule vaiable provided in this package. If gnus-uu finds no +match here, it uses `gnus-uu-user-view-rules-end' to try to make a +match. + +Unless, of course, you are using the interactive view mode. Then +`gnus-uu-user-interactive-view-rules' and +`gnus-uu-user-interactive-view-rules-end' will be used instead.") + +(defvar gnus-uu-user-view-rules nil + "Variable detailing what actions are to be taken to view a file. +See the documentation on the `gnus-uu-default-view-rules' variable for +details.") + +(defvar gnus-uu-user-view-rules-end nil + "Variable saying what actions are to be taken if no rule matched the file name. +See the documentation on the `gnus-uu-default-view-rules' variable for +details.") + +(defvar gnus-uu-user-interactive-view-rules nil + "Variable detailing what actions are to be taken to view a file when using interactive mode. +See the documentation on the `gnus-uu-default-view-rules' variable for +details.") + +(defvar gnus-uu-user-interactive-view-rules-end nil + "Variable saying what actions are to be taken if no rule matched the file name when using interactive mode. +See the documentation on the `gnus-uu-default-view-rules' variable for +details.") + +(defvar gnus-uu-default-interactive-view-rules-begin + (list + '("\\.te?xt$\\|\\.doc$\\|read.*me\\|\\.c?$\\|\\.h$\\|\\.bat$\\|\\.asm$\\|makefile" "cat %s | sed s/\r//g") + '("\\.pas$" "cat %s | sed s/\r//g") + '("\\.[1-9]$" "groff -mandoc -Tascii %s | sed s/\b.//g") + )) + +(defvar gnus-uu-default-interactive-view-rules-end + (list + '(".*" "file"))) + +;; Default unpacking commands + +(defvar gnus-uu-default-archive-rules + (list '("\\.tar$" "tar xf") + '("\\.zip$" "unzip -o") + '("\\.ar$" "ar x") + '("\\.arj$" "unarj x") + '("\\.zoo$" "zoo -e") + '("\\.\\(lzh\\|lha\\)$" "lha x") + '("\\.Z$" "uncompress") + '("\\.gz$" "gunzip") + '("\\.arc$" "arc -x")) + ) + +(defvar gnus-uu-destructive-archivers + (list "uncompress" "gunzip")) + +(defvar gnus-uu-user-archive-rules nil + "A list that can be set to override the default archive unpacking commands. +To use, for instance, 'untar' to unpack tar files and 'zip -x' to +unpack zip files, say the following: + (setq gnus-uu-user-archive-rules + (list '(\"\\\\.tar$\" \"untar\") + '(\"\\\\.zip$\" \"zip -x\")))") + +(defvar gnus-uu-ignore-files-by-name nil + "A regular expression saying what files should not be viewed based on name. +If, for instance, you want gnus-uu to ignore all .au and .wav files, +you could say something like + + (setq gnus-uu-ignore-files-by-name \"\\\\.au$\\\\|\\\\.wav$\") + +Note that this variable can be used in conjunction with the +`gnus-uu-ignore-files-by-type' variable.") + +(defvar gnus-uu-ignore-files-by-type nil + "A regular expression saying what files that shouldn't be viewed, based on MIME file type. +If, for instance, you want gnus-uu to ignore all audio files and all mpegs, +you could say something like + + (setq gnus-uu-ignore-files-by-type \"audio/\\\\|video/mpeg\") + +Note that this variable can be used in conjunction with the +`gnus-uu-ignore-files-by-name' variable.") + +;; Pseudo-MIME support + +(defconst gnus-uu-ext-to-mime-list + (list '("\\.gif$" "image/gif") + '("\\.jpe?g$" "image/jpeg") + '("\\.tiff?$" "image/tiff") + '("\\.xwd$" "image/xwd") + '("\\.pbm$" "image/pbm") + '("\\.pgm$" "image/pgm") + '("\\.ppm$" "image/ppm") + '("\\.xbm$" "image/xbm") + '("\\.pcx$" "image/pcx") + '("\\.tga$" "image/tga") + '("\\.ps$" "image/postscript") + '("\\.fli$" "video/fli") + '("\\.wav$" "audio/wav") + '("\\.aiff$" "audio/aiff") + '("\\.hcom$" "audio/hcom") + '("\\.voc$" "audio/voc") + '("\\.smp$" "audio/smp") + '("\\.mod$" "audio/mod") + '("\\.dvi$" "image/dvi") + '("\\.mpe?g$" "video/mpeg") + '("\\.au$" "audio/basic") + '("\\.\\(te?xt\\|doc\\|c\\|h\\)$" "text/plain") + '("\\.\\(c\\|h\\)$" "text/source") + '("read.*me" "text/plain") + '("\\.html$" "text/html") + '("\\.bat$" "text/bat") + '("\\.[1-6]$" "text/man") + '("\\.flc$" "video/flc") + '("\\.rle$" "video/rle") + '("\\.pfx$" "video/pfx") + '("\\.avi$" "video/avi") + '("\\.sme$" "video/sme") + '("\\.rpza$" "video/prza") + '("\\.dl$" "video/dl") + '("\\.qt$" "video/qt") + '("\\.rsrc$" "video/rsrc") + '("\\..*$" "unknown/unknown"))) + +;; Various variables users may set + +(defvar gnus-uu-tmp-dir "/tmp/" + "Variable saying where gnus-uu is to do its work. +Default is \"/tmp/\".") + +(defvar gnus-uu-do-not-unpack-archives nil + "Non-nil means that gnus-uu won't peek inside archives looking for files to dispay. +Default is nil.") + +(defvar gnus-uu-view-and-save nil + "Non-nil means that the user will always be asked to save a file after viewing it. +If the variable is nil, the suer will only be asked to save if the +viewing is unsuccessful. Default is nil.") + +(defvar gnus-uu-asynchronous nil + "Non-nil means that files will be viewed asynchronously. +Default is nil.") + +(defvar gnus-uu-ask-before-view nil + "Non-nil means that gnus-uu will ask you before viewing each file. +Especially useful when `gnus-uu-asynchronous' is set. Default is +nil.") + +(defvar gnus-uu-ignore-default-view-rules nil + "Non-nil means that gnus-uu will ignore the default viewing rules. +Only the user viewing rules will be consulted. Default is nil.") + +(defvar gnus-uu-ignore-default-archive-rules nil + "Non-nil means that gnus-uu will ignore the default archive unpacking commands. +Only the user unpacking commands will be consulted. Default is nil.") + +(defvar gnus-uu-kill-carriage-return t + "Non-nil means that gnus-uu will strip all carriage returns from articles. +Default is t.") + +(defvar gnus-uu-view-with-metamail nil + "Non-nil means that files will be viewed with metamail. +The gnus-uu viewing functions will be ignored and gnus-uu will try +to guess at a content-type based on file name suffixes. Default +it nil.") + +(defvar gnus-uu-unmark-articles-not-decoded nil + "Non-nil means that gnus-uu will mark articles that were unsuccessfully decoded as unread. +Default is nil.") + +(defvar gnus-uu-output-window-height 20 + "This variable says how tall the output buffer window is to be when using interactive view mode. +Change it at your convenience. Default is 20.") + +(defvar gnus-uu-correct-stripped-uucode nil + "Non-nil means that gnus-uu will *try* to fix uuencoded files that have had traling spaces deleted. +Default is nil.") + +(defvar gnus-uu-use-interactive-view nil + "Non-nil means that gnus-uu will use interactive viewing mode. +Gnus-uu will create a special buffer where the user may choose +interactively which files to view and how. Default is nil.") + +(defvar gnus-uu-save-in-digest nil + "Non-nil means that gnus-uu, when asked to save without decoding, will save in digests. +If this variable is nil, gnus-uu will just save everything in a +file without any embellishments. The digesting almost conforms to RFC1153 - +no easy way to specify any meaningful volume and issue numbers were found, +so I simply dropped them.") + +(defvar gnus-uu-save-separate-articles nil + "Non-nil means that gnus-uu will save artilces in separate files.") + + +;; Internal variables + +(defconst gnus-uu-begin-string "^begin[ \t]+[0-7][0-7][0-7][ \t]+\\(.*\\)$") +(defconst gnus-uu-end-string "^end[ \t]*$") + +(defconst gnus-uu-body-line "^M") +(let ((i 61)) + (while (> (setq i (1- i)) 0) + (setq gnus-uu-body-line (concat gnus-uu-body-line "[^a-z]"))) + (setq gnus-uu-body-line (concat gnus-uu-body-line ".?$"))) + +;"^M.............................................................?$" + +(defconst gnus-uu-shar-begin-string "^#! */bin/sh") + +(defvar gnus-uu-shar-file-name nil) +(defconst gnus-uu-shar-name-marker "begin [0-7][0-7][0-7][ \t]+\\(\\(\\w\\|\\.\\)*\\b\\)") + +(defvar gnus-uu-file-name nil) +(defvar gnus-uu-list-of-files-decoded nil) +(defconst gnus-uu-uudecode-process nil) + +(defvar gnus-uu-interactive-file-list nil) +(defvar gnus-uu-generated-file-list nil) +(defvar gnus-uu-work-dir nil) + +(defconst gnus-uu-interactive-buffer-name "*gnus-uu interactive*") +(defconst gnus-uu-output-buffer-name "*Gnus UU Output*") + +(defconst gnus-uu-highest-article-number 1) + +;; Interactive functions + +;; UUdecode and view + +(defun gnus-uu-decode-and-view () + "UUdecodes and 'views' (if possible) the resulting file. +'Viewing' can be any action at all, as defined in the +`gnus-uu-file-action-list' variable. Running 'xv' on gifs and 'cat +>/dev/audio' on au files are popular actions. If the file can't be +viewed, the user is asked if she would like to save the file instead." + (interactive) + (gnus-uu-decode-and-view-or-save t nil)) + +(defun gnus-uu-decode-and-save () + "Decodes and saves the resulting file." + (interactive) + (gnus-uu-decode-and-view-or-save nil nil)) + +(defun gnus-uu-marked-decode-and-view () + "Decodes and views articles marked. +The marked equivalent to `gnus-uu-decode-and-view'." + (interactive) + (gnus-uu-decode-and-view-or-save t t)) + +(defun gnus-uu-marked-decode-and-save () + "Decodes and saves articles marked. +The marked equivalent to `gnus-uu-decode-and-save'." + (interactive) + (gnus-uu-decode-and-view-or-save nil t)) + + +;; Unshar and view + +(defun gnus-uu-shar-and-view () + "Unshars and views articles. +The shar equivalent of `gnus-uu-decode-and-view'." + (interactive) + (gnus-uu-unshar-and-view-or-save t nil)) + +(defun gnus-uu-shar-and-save () + "Unshars and saves files. +The shar equivalent to `gnus-uu-decode-and-save'." + (interactive) + (gnus-uu-unshar-and-view-or-save nil nil)) + +(defun gnus-uu-marked-shar-and-view () + "Unshars and views articles marked. +The marked equivalent to `gnus-uu-shar-and-view'." + (interactive) + (gnus-uu-unshar-and-view-or-save t t)) + +(defun gnus-uu-marked-shar-and-save () + "Unshars and saves articles marked. +The marked equivalent to `gnus-uu-shar-and-save'." + (interactive) + (gnus-uu-unshar-and-view-or-save nil t)) + +;; Threaded decode + +(defun gnus-uu-threaded-decode-and-view () + "Decodes and saves the resulting file." + (interactive) + (gnus-uu-threaded-decode-and-view-or-save t)) + +(defun gnus-uu-threaded-decode-and-save () + "Decodes and saves the resulting file." + (interactive) + (gnus-uu-threaded-decode-and-view-or-save nil)) + +(defun gnus-uu-threaded-multi-decode-and-view () + "Decodes and saves the resulting file." + (interactive) + (gnus-uu-threaded-multi-decode-and-view-or-save t)) + +(defun gnus-uu-threaded-multi-decode-and-save () + "Decodes and saves the resulting file." + (interactive) + (gnus-uu-threaded-multi-decode-and-view-or-save nil)) + +(defun gnus-uu-threaded-decode-and-view-or-save (&optional view) + (gnus-summary-unmark-all-processable) + (gnus-uu-mark-thread) + (gnus-uu-decode-and-view-or-save view t)) + +(defun gnus-uu-threaded-multi-decode-and-view-or-save (view) + (let (type) + (message "Decode type: [u]udecode, (s)har, s(a)ve, (b)inhex: ") + (setq type (read-char)) + (if (not (or (= type ?u) (= type ?s) (= type ?b) (= type ?a))) + (error "No such decoding method '%c'" type)) + + (gnus-summary-unmark-all-processable) + (gnus-uu-mark-thread) + + (if (= type ?\r) (setq type ?u)) + (cond ((= type ?u) (gnus-uu-decode-and-view-or-save view t)) + ((= type ?s) (gnus-uu-unshar-and-view-or-save view t)) + ((= type ?b) (gnus-uu-binhex-and-save view t)) + ((= type ?a) (gnus-uu-save-articles view t)) + (t (error "No such decoding method: %s" type))))) + + +;; Toggle commands + +(defun gnus-uu-toggle-asynchronous () + "This function toggles asynchronous viewing." + (interactive) + (if (setq gnus-uu-asynchronous (not gnus-uu-asynchronous)) + (message "gnus-uu will now view files asynchronously") + (message "gnus-uu will now view files synchronously"))) + +(defun gnus-uu-toggle-query () + "This function toggles whether to ask before viewing or not." + (interactive) + (if (setq gnus-uu-ask-before-view (not gnus-uu-ask-before-view)) + (message "gnus-uu will now ask before viewing") + (message "gnus-uu will now view without asking first"))) + +(defun gnus-uu-toggle-always-ask () + "This function toggles whether to always ask to save a file after viewing." + (interactive) + (if (setq gnus-uu-view-and-save (not gnus-uu-view-and-save)) + (message "gnus-uu will now ask to save the file after viewing") + (message "gnus-uu will now not ask to save after successful viewing"))) + +(defun gnus-uu-toggle-interactive-view () + "This function toggles whether to use interactive view." + (interactive) + (if (setq gnus-uu-use-interactive-view (not gnus-uu-use-interactive-view)) + (message "gnus-uu will now use interactive view") + (message "gnus-uu will now use non-interactive view"))) + +(defun gnus-uu-toggle-unmark-undecoded () + "This function toggles whether to unmark articles not decoded." + (interactive) + (if (setq gnus-uu-unmark-articles-not-decoded + (not gnus-uu-unmark-articles-not-decoded)) + (message "gnus-uu will now unmark articles not decoded") + (message "gnus-uu will now not unmark articles not decoded"))) + +(defun gnus-uu-toggle-kill-carriage-return () + "This function toggles the stripping of carriage returns from the articles." + (interactive) + (if (setq gnus-uu-kill-carriage-return (not gnus-uu-kill-carriage-return)) + (message "gnus-uu will now strip carriage returns") + (message "gnus-uu won't strip carriage returns"))) + +(defun gnus-uu-toggle-view-with-metamail () + "This function toggles whether to view files with metamail." + (interactive) + (if (setq gnus-uu-view-with-metamail (not gnus-uu-view-with-metamail)) + (message "gnus-uu will now view with metamail") + (message "gnus-uu will now view with the gnus-uu viewing functions"))) + +(defun gnus-uu-toggle-correct-stripped-uucode () + "This function toggles whether to correct stripped uucode." + (interactive) + (if (setq gnus-uu-correct-stripped-uucode + (not gnus-uu-correct-stripped-uucode)) + (message "gnus-uu will now correct stripped uucode") + (message "gnus-uu won't check and correct stripped uucode"))) + +(defun gnus-uu-toggle-any-variable () + "This function ask what variable the user wants to toggle." + (interactive) + (let (rep) + (message "(a)sync, (q)uery, (p)ask, (k)ill CR, (i)nteract, (u)nmark, (c)orrect, (m)eta") + (setq rep (read-char)) + (if (= rep ?a) + (gnus-uu-toggle-asynchronous)) + (if (= rep ?q) + (gnus-uu-toggle-query)) + (if (= rep ?p) + (gnus-uu-toggle-always-ask)) + (if (= rep ?k) + (gnus-uu-toggle-kill-carriage-return)) + (if (= rep ?u) + (gnus-uu-toggle-unmark-undecoded)) + (if (= rep ?c) + (gnus-uu-toggle-correct-stripped-uucode)) + (if (= rep ?m) + (gnus-uu-toggle-view-with-metamail)) + (if (= rep ?i) + (gnus-uu-toggle-interactive-view)))) + + +;; Misc interactive functions + +(defun gnus-uu-decode-and-show-in-buffer () + "Uudecodes the current article and displays the result in a buffer. +Might be useful if someone has, for instance, some text uuencoded in +their sigs. (Stranger things have happened.)" + (interactive) + (gnus-uu-initialize) + (let ((uu-buffer (get-buffer-create gnus-uu-output-buffer-name)) + file-name) + (save-excursion + (and + (gnus-summary-select-article) + (gnus-uu-grab-articles (list gnus-current-article) + 'gnus-uu-uustrip-article-as) + (setq file-name (concat gnus-uu-work-dir gnus-uu-file-name)) + (progn + (save-excursion + (set-buffer uu-buffer) + (erase-buffer) + (insert-file-contents file-name)) + (set-window-buffer (get-buffer-window gnus-article-buffer) + uu-buffer) + (message "Showing file %s in buffer" file-name) + (delete-file file-name)))))) + +(defun gnus-uu-edit-begin-line () + "Edit the begin line of the current article." + (interactive) + (let ((buffer-read-only nil) + begin b) + (save-excursion + (gnus-summary-select-article) + (set-buffer gnus-article-buffer) + (goto-line 1) + (if (not (re-search-forward "begin " nil t)) + (error "No begin line in the current article") + (beginning-of-line) + (setq b (point)) + (end-of-line) + (setq begin (buffer-substring b (point))) + (setq begin (read-string "" begin)) + (setq buffer-read-only nil) + (delete-region b (point)) + (insert-string begin))))) + + +;; Multi functions + +(defun gnus-uu-multi-decode-and-view () + "Choose a method of decoding and then decode and view. +This function lets the user decide what method to use for decoding. +Other than that, it's equivalent to the other decode-and-view +functions." + (interactive) + (gnus-uu-multi-decode-and-view-or-save t nil)) + +(defun gnus-uu-multi-decode-and-save () + "Choose a method of decoding and then decode and save. +This function lets the user decide what method to use for decoding. +Other than that, it's equivalent to the other decode-and-save +functions." + (interactive) + (gnus-uu-multi-decode-and-view-or-save nil nil)) + +(defun gnus-uu-marked-multi-decode-and-view () + "Choose a method of decoding and then decode and view the marked articles. +This function lets the user decide what method to use for decoding. +Other than that, it's equivalent to the other marked decode-and-view +functions." + (interactive) + (gnus-uu-multi-decode-and-view-or-save t t)) + +(defun gnus-uu-marked-multi-decode-and-save () + "Choose a method of decoding and then decode and save the marked articles. +This function lets the user decide what method to use for decoding. +Other than that, it's equivalent to the other marked decode-and-save +functions." + (interactive) + (gnus-uu-multi-decode-and-view-or-save nil t)) + +(defun gnus-uu-multi-decode-and-view-or-save (view marked) + (let (type) + (message "[u]udecode, (s)har, s(a)ve, (b)inhex: ") + (setq type (read-char)) + (if (= type ?\r) (setq type ?u)) + (cond ((= type ?u) (gnus-uu-decode-and-view-or-save view marked)) + ((= type ?s) (gnus-uu-unshar-and-view-or-save view marked)) + ((= type ?b) (gnus-uu-binhex-and-save view marked)) + ((= type ?a) (gnus-uu-save-articles view marked)) + (t (error "Unknown decode method '%c'." type))))) + + +;; "All articles" commands + +(defconst gnus-uu-rest-of-articles nil) +(defvar gnus-uu-current-save-dir nil) + +(defun gnus-uu-decode-and-view-all-articles (arg) + "Try to decode all articles and view the result. +ARG delimits the number of files to be decoded." + (interactive "p") + (gnus-uu-decode-and-view-or-save-all-articles arg nil t)) + +(defun gnus-uu-decode-and-view-all-unread-articles (arg) + "Try to decode all unread articles and view the result. +ARG delimits the number of files to be decoded." + (interactive "p") + (gnus-uu-decode-and-view-or-save-all-articles arg t t)) + +(defun gnus-uu-decode-and-save-all-unread-articles (arg) + "Try to decode all unread articles and saves the result. +This function reads all unread articles in the current group and sees +whether it can uudecode the articles. The user will be prompted for an +directory to put the resulting (if any) files. +ARG delimits the number of files to be decoded." + (interactive "p") + (gnus-uu-decode-and-view-or-save-all-articles arg t nil)) + +(defun gnus-uu-decode-and-save-all-articles (arg) + "Try to decode all articles and saves the result. +Does the same as `gnus-uu-decode-and-save-all-unread-articles', except +that it grabs all articles visible, unread or not. +ARG delimits the number of files to be decoded." + (interactive "p") + (gnus-uu-decode-and-view-or-save-all-articles arg nil nil)) + +(defun gnus-uu-decode-and-view-or-save-all-articles + (limit &optional unread view article-list) + (gnus-uu-initialize) + (let ((artreg (if unread "^[ -]" "^.")) + dir list-for-file result-files) + + (if article-list + () + (gnus-summary-mark-as-read gnus-current-article ? ) + (goto-char 1) + (while (re-search-forward artreg nil t) + (setq article-list + (cons (gnus-summary-article-number) article-list))) + (setq article-list (nreverse article-list)) + (gnus-summary-mark-as-read gnus-current-article ?D)) + + (if (not article-list) + (error "No %sarticles in this newsgroup" (if unread "unread " ""))) + (if (not view) + (setq dir (gnus-uu-read-directory "Where do you want the files? "))) + + (if (= 1 limit) (setq limit (1+ (length article-list)))) + + (while (and article-list (> limit 0)) + (setq limit (1- limit)) + (gnus-summary-goto-article (car article-list)) + (setq list-for-file (gnus-uu-get-list-of-articles)) + (let ((lft list-for-file)) + (while lft + (setq article-list (delq (car lft) article-list)) + (setq gnus-newsgroup-processable (delq (car lft) + gnus-newsgroup-processable)) + (setq lft (cdr lft)))) + (setq result-files + (append + (gnus-uu-grab-articles list-for-file + 'gnus-uu-uustrip-article-as t nil t) + result-files))) + + (setq gnus-uu-list-of-files-decoded result-files) + + (if (not result-files) + (error "No files after decoding")) + + (if view + (gnus-uu-view-directory gnus-uu-work-dir gnus-uu-use-interactive-view) + (gnus-uu-save-directory gnus-uu-work-dir dir dir) + (message "Saved.") + (gnus-uu-check-for-generated-files)) + + (gnus-uu-summary-next-subject) + + (if (and gnus-uu-use-interactive-view view) + (gnus-uu-do-interactive)) + + (if (or (not view) (not gnus-uu-use-interactive-view)) + (gnus-uu-clean-up)))) + +(defun gnus-uu-decode-and-view-all-marked-files () + "This function will decode and view all files that have had one or more articles in its series marked. +For instance, if you have marked part 2 of one series, and part 9 of +another, this function will decode both series of articles. In other +words, you can walk around the summary buffer and mark what series you +want to see, and then using this function to decode all the files you +are interested in, without worrying exactly what articles belong to +what files." + (interactive) + (if (not gnus-newsgroup-processable) + (error "No articles marked for decoding")) + (gnus-uu-decode-and-view-or-save-all-articles + 1 nil t (setq gnus-newsgroup-processable + (nreverse gnus-newsgroup-processable)))) + +(defun gnus-uu-decode-and-save-all-marked-files () + "This function will decode and save all files that have had one or more articles in its series marked. +For instance, if you have marked part 2 of one series, and part 9 of +another, this function will decode both series of articles. In other +words, you can walk around the summary buffer and mark what series you +want to save, and then using this function to decode all the files you +are interested in, without worrying exactly what articles belong to +what files." + (interactive) + (if (not gnus-newsgroup-processable) + (error "No articles marked for decoding")) + (gnus-uu-decode-and-view-or-save-all-articles + 1 nil nil (setq gnus-newsgroup-processable + (nreverse gnus-newsgroup-processable)))) + + +;; Work functions + +; All the interactive uudecode/view/save/marked functions are interfaces +; to this function, which does the rest. +(defun gnus-uu-decode-and-view-or-save (view marked &optional save-dir limit) + (gnus-uu-initialize) + (save-excursion + (if (gnus-uu-decode-and-strip nil marked limit) + (progn + (if view + (gnus-uu-view-directory gnus-uu-work-dir + gnus-uu-use-interactive-view) + (gnus-uu-save-directory gnus-uu-work-dir save-dir save-dir) + (gnus-uu-check-for-generated-files))))) + + (gnus-uu-summary-next-subject) + + (if (and gnus-uu-use-interactive-view view) + (gnus-uu-do-interactive)) + + (if (or (not view) (not gnus-uu-use-interactive-view)) + (gnus-uu-clean-up))) + +; Unshars and views/saves marked/unmarked articles. +(defun gnus-uu-unshar-and-view-or-save (view marked &optional save-dir) + (gnus-uu-initialize) + (let (tar-file files) + (save-excursion + (gnus-uu-decode-and-strip t marked) + (if (setq gnus-uu-list-of-files-decoded + (gnus-uu-directory-files gnus-uu-work-dir t)) + (progn + (gnus-uu-add-file gnus-uu-list-of-files-decoded) + (if view + (gnus-uu-view-directory gnus-uu-work-dir + gnus-uu-use-interactive-view) + (gnus-uu-save-directory gnus-uu-work-dir save-dir save-dir) + (gnus-uu-check-for-generated-files))))) + + (gnus-uu-summary-next-subject) + + (if (and gnus-uu-use-interactive-view view) + (gnus-uu-do-interactive)) + + (if (or (not view) (not gnus-uu-use-interactive-view)) + (gnus-uu-clean-up)))) + + +;; Functions for saving and possibly digesting articles without +;; any decoding. + +(defconst gnus-uu-saved-article-name nil) + +; VIEW isn't used, but is here anyway, to provide similar interface to +; the other related functions. If MARKED is non-nil, the list of +; marked articles is used. If NO-SAVE is non-nil, the articles aren't +; actually saved in a permanent location, but the collecting is done +; and a temporary file with the result is returned. +(defun gnus-uu-save-articles (view marked &optional no-save) + (let (list-of-articles) + (save-excursion + (gnus-uu-initialize) + (if (not marked) + (setq list-of-articles (gnus-uu-get-list-of-articles)) + (setq list-of-articles (setq gnus-newsgroup-processable + (nreverse gnus-newsgroup-processable))) + (gnus-summary-unmark-all-processable)) + + (if (not list-of-articles) + (error "No list of articles")) + + (if gnus-uu-save-separate-articles + (progn + (setq gnus-uu-saved-article-name + (gnus-uu-read-directory + (concat "Where do you want the files? ")))) + + (setq gnus-uu-saved-article-name + (concat gnus-uu-work-dir + (if no-save + gnus-newsgroup-name + (read-file-name "Enter file name: " gnus-newsgroup-name + gnus-newsgroup-name)))) + (gnus-uu-add-file gnus-uu-saved-article-name)) + + (if (and (gnus-uu-grab-articles list-of-articles 'gnus-uu-save-article t) + (not no-save) (not gnus-uu-save-separate-articles)) + (gnus-uu-save-file gnus-uu-saved-article-name) + gnus-uu-saved-article-name)))) + +; Function called by gnus-uu-grab-articles to treat each article. +(defun gnus-uu-save-article (buffer in-state) + (cond + (gnus-uu-save-separate-articles + (save-excursion + (set-buffer buffer) + (write-region 1 (point-max) (concat gnus-uu-saved-article-name + gnus-current-article)) + (cond ((eq in-state 'first) (list gnus-uu-saved-article-name 'begin)) + ((eq in-state 'first-and-last) (list gnus-uu-saved-article-name 'begin 'end)) + ((eq in-state 'last) (list 'end)) + (t (list 'middle))))) + ((not gnus-uu-save-in-digest) + (save-excursion + (set-buffer buffer) + (write-region 1 (point-max) gnus-uu-saved-article-name t) + (cond ((eq in-state 'first) (list gnus-uu-saved-article-name 'begin)) + ((eq in-state 'first-and-last) (list gnus-uu-saved-article-name 'begin 'end)) + ((eq in-state 'last) (list 'end)) + (t (list 'middle))))) + (t + (let (beg subj name headers headline sorthead body end-string state) + (string-match "/\\([^/]*\\)$" gnus-uu-saved-article-name) + (setq name (substring gnus-uu-saved-article-name (match-beginning 1) + (match-end 1))) + (if (or (eq in-state 'first) + (eq in-state 'first-and-last)) + (progn + (setq state (list 'begin)) + (save-excursion (set-buffer (get-buffer-create "*gnus-uu-body*")) + (erase-buffer)) + (save-excursion + (set-buffer (get-buffer-create "*gnus-uu-pre*")) + (erase-buffer) + (insert (format + "Date: %s\nFrom: %s\nSubject: %s Digest\n\nTopics:\n" + (current-time-string) name name)))) + (if (not (eq in-state 'end)) + (setq state (list 'middle)))) + (save-excursion + (set-buffer (get-buffer "*gnus-uu-body*")) + (goto-char (setq beg (point-max))) + (save-excursion + (save-restriction + (set-buffer buffer) + (goto-char 1) + (re-search-forward "\n\n") + (setq body (buffer-substring (1- (point)) (point-max))) + (narrow-to-region 1 (point)) + (setq headers (list "Date:" "From:" "To:" "Cc:" "Subject:" + "Message-ID:" "Keywords:" "Summary:")) + (while headers + (setq headline (car headers)) + (setq headers (cdr headers)) + (goto-char 1) + (if (re-search-forward (concat "^" headline ".*$") nil t) + (setq sorthead + (concat sorthead (buffer-substring + (match-beginning 0) + (match-end 0)) "\n")))) + (widen))) + (insert sorthead)(goto-char (point-max)) + (insert body)(goto-char (point-max)) + (insert (concat "\n" (make-string 30 ?-) "\n\n")) + (goto-char beg) + (if (re-search-forward "^Subject: \\(.*\\)$" nil t) + (progn + (setq subj (buffer-substring (match-beginning 1) (match-end 1))) + (save-excursion + (set-buffer (get-buffer "*gnus-uu-pre*")) + (insert (format " %s\n" subj)))))) + (if (or (eq in-state 'last) + (eq in-state 'first-and-last)) + (progn + (save-excursion + (set-buffer (get-buffer "*gnus-uu-pre*")) + (insert (format "\n\n%s\n\n" (make-string 70 ?-))) + (write-region 1 (point-max) gnus-uu-saved-article-name)) + (save-excursion + (set-buffer (get-buffer "*gnus-uu-body*")) + (goto-char (point-max)) + (insert + (concat (setq end-string (format "End of %s Digest" name)) + "\n")) + (insert (concat (make-string (length end-string) ?*) "\n")) + (write-region 1 (point-max) gnus-uu-saved-article-name t)) + (kill-buffer (get-buffer "*gnus-uu-pre*")) + (kill-buffer (get-buffer "*gnus-uu-body*")) + (setq state (cons 'end state)))) + (if (memq 'begin state) + (cons gnus-uu-saved-article-name state) + state))))) + +;; Digest and forward articles + +(defun gnus-uu-digest-and-forward (&optional marked) + "Digests and forwards all articles in this series." + (interactive) + (let ((gnus-uu-save-in-digest t) + file buf) + (setq file (gnus-uu-save-articles nil marked t)) + (switch-to-buffer (setq buf (get-buffer-create "*gnus-uu-forward*"))) + (erase-buffer) + (delete-other-windows) + (erase-buffer) + (insert-file file) + (goto-char 1) + (bury-buffer buf) + (funcall gnus-mail-forward-method))) + +(defun gnus-uu-marked-digest-and-forward (&optional marked) + "Digests and forwards all marked articles." + (interactive) + (gnus-uu-digest-and-forward t)) + + +;; Binhex treatment - not very advanced. + +(defconst gnus-uu-binhex-body-line + "^[^:]...............................................................$") +(defconst gnus-uu-binhex-begin-line + "^:...............................................................$") +(defconst gnus-uu-binhex-end-line + ":$") +(defvar gnus-uu-binhex-article-name nil) + +; This just concatenates and strips stuff from binhexed articles. +; No actual unbinhexing takes place. VIEW is ignored. +(defun gnus-uu-binhex-and-save (view marked) + (gnus-uu-initialize) + (let (list-of-articles) + (save-excursion + (if (not marked) + (setq list-of-articles (gnus-uu-get-list-of-articles)) + (setq list-of-articles + (setq gnus-newsgroup-processable + (nreverse gnus-newsgroup-processable))) + (gnus-summary-unmark-all-processable)) + (if (not list-of-articles) + (error "No list of articles")) + + (setq gnus-uu-binhex-article-name + (concat gnus-uu-work-dir + (read-file-name "Enter binhex file name: " + gnus-newsgroup-name + gnus-newsgroup-name))) + (gnus-uu-add-file gnus-uu-binhex-article-name) + (if (gnus-uu-grab-articles list-of-articles 'gnus-uu-binhex-article t) + (gnus-uu-save-file gnus-uu-binhex-article-name)))) + (gnus-uu-check-for-generated-files) + (gnus-uu-summary-next-subject)) + +(defun gnus-uu-binhex-article (buffer in-state) + (let (state start-char) + (save-excursion + (set-buffer buffer) + (widen) + (goto-char 1) + (if (not (re-search-forward gnus-uu-binhex-begin-line nil t)) + (if (not (re-search-forward gnus-uu-binhex-body-line nil t)) + (setq state (list 'wrong-type)))) + + (if (memq 'wrong-type state) + () + (beginning-of-line) + (setq start-char (point)) + (if (looking-at gnus-uu-binhex-begin-line) + (progn + (setq state (list 'begin)) + (write-region 1 1 gnus-uu-binhex-article-name)) + (setq state (list 'middle))) + (goto-char (point-max)) + (re-search-backward (concat gnus-uu-binhex-body-line "\\|" + gnus-uu-binhex-end-line) nil t) + (if (looking-at gnus-uu-binhex-end-line) + (setq state (if (memq 'begin state) + (cons 'end state) + (list 'end)))) + (beginning-of-line) + (forward-line 1) + (if (file-exists-p gnus-uu-binhex-article-name) + (append-to-file start-char (point) gnus-uu-binhex-article-name)))) + (if (memq 'begin state) + (cons gnus-uu-binhex-article-name state) + state))) + + +;; Internal view commands + +; This function takes two parameters. The first is name of the file to +; be viewed. `gnus-uu-view-file' will look for an action associated +; with the file type of the file. If it finds an appropriate action, +; the file will be attempted displayed. +; +; The second parameter specifies if the user is to be asked whether to +; save the file if viewing is unsuccessful. t means "do not ask." +; +; Note that the file given will be deleted by this function, one way +; or another. If `gnus-uu-asynchronous' is set, it won't be deleted +; right away, but sometime later. If the user is offered to save the +; file, it'll be moved to wherever the user wants it. + +; `gnus-uu-view-file' returns t if viewing is successful. + +(defun gnus-uu-view-file (file &optional silent) + (let (action did-view) + (cond + ((not (setq action (gnus-uu-get-action file))) + (if (and (not silent) (not gnus-uu-use-interactive-view)) + (progn + (message "Couldn't find any rule for file '%s'" file) + (sleep-for 2) + (gnus-uu-ask-to-save-file file)))) + + ((and gnus-uu-use-interactive-view + (not (string= (or action "") "gnus-uu-archive"))) + (gnus-uu-enter-interactive-file (or action "") file)) + + (gnus-uu-ask-before-view + (if (y-or-n-p (format "Do you want to view %s? " file)) + (setq did-view (gnus-uu-call-file-action file action))) + (message "")) + + ((setq did-view (gnus-uu-call-file-action file action))) + + ((not silent) + (gnus-uu-ask-to-save-file file))) + + (if (and (file-exists-p file) + (not gnus-uu-use-interactive-view) + (or + (not (and gnus-uu-asynchronous did-view)) + (string= (or action "") "gnus-uu-archive"))) + (delete-file file)) + + did-view)) + +(defun gnus-uu-call-file-action (file action) + (prog1 + (if gnus-uu-asynchronous + (gnus-uu-call-asynchronous file action) + (gnus-uu-call-synchronous file action)) + (if gnus-uu-view-and-save + (gnus-uu-ask-to-save-file file)))) + +(defun gnus-uu-ask-to-save-file (file) + (if (y-or-n-p (format "Do you want to save the file %s? " file)) + (gnus-uu-save-file file)) + (message "")) + +(defun gnus-uu-get-action (file-name) + (let (action) + (setq action + (gnus-uu-choose-action + file-name + (append + (if (and gnus-uu-use-interactive-view + gnus-uu-user-interactive-view-rules) + gnus-uu-user-interactive-view-rules + gnus-uu-user-view-rules) + (if (or gnus-uu-ignore-default-view-rules + (not gnus-uu-use-interactive-view)) + () + gnus-uu-default-interactive-view-rules-begin) + (if gnus-uu-ignore-default-view-rules + nil + gnus-uu-default-view-rules) + (if gnus-uu-use-interactive-view + (append gnus-uu-user-interactive-view-rules-end + (if gnus-uu-ignore-default-view-rules + () + gnus-uu-default-interactive-view-rules-end)) + gnus-uu-user-view-rules-end)))) + (if (and (not (string= (or action "") "gnus-uu-archive")) + gnus-uu-view-with-metamail) + (if (setq action + (gnus-uu-choose-action file-name gnus-uu-ext-to-mime-list)) + (setq action (format "metamail -d -b -c \"%s\"" action)))) + action)) + +; `gnus-uu-call-synchronous' takes two parameters: The name of the +; file to be displayed and the command to display it with. Returns t +; on success and nil if the file couldn't be displayed. +(defun gnus-uu-call-synchronous (file-name action) + (let (did-view command) + (save-excursion + (set-buffer (get-buffer-create gnus-uu-output-buffer-name)) + (erase-buffer) + (setq command (gnus-uu-command action file-name)) + (message "Viewing with '%s'" command) + (if (not (= 0 (call-process "sh" nil t nil "-c" command))) + (progn + (goto-char 1) + (while (re-search-forward "\n" nil t) + (replace-match " ")) + (message (concat "Error: " (buffer-substring 1 (point-max)))) + (sit-for 2)) + (message "") + (setq did-view t))) + did-view)) + +; `gnus-uu-call-asyncronous' takes two parameters: The name of the +; file to be displayed and the command to display it with. Since the +; view command is executed asynchronously, it's kinda hard to decide +; whether the command succeded or not, so this function always returns +; t. It also adds "; rm -f file-name" to the end of the execution +; string, so the file will be removed after viewing has ended. +(defun gnus-uu-call-asynchronous (file-name action) + (let (command file tmp-file start) + (while (string-match "/" file-name start) + (setq start (1+ (match-beginning 0)))) + (setq file (substring file-name start)) + (setq tmp-file (concat gnus-uu-work-dir file)) + (if (string= tmp-file file-name) + () + (rename-file file-name tmp-file t) + (setq file-name tmp-file)) + + (setq command (gnus-uu-command action file-name)) + (setq command (format "%s ; rm -f %s" command file-name)) + (message "Viewing with %s" command) + (start-process "gnus-uu-view" nil "sh" "-c" command) + t)) + +; `gnus-uu-decode-and-strip' does all the main work. It finds out what +; articles to grab, grabs them, strips the result and decodes. If any +; of these operations fail, it returns nil, t otherwise. If shar is +; t, it will pass this on to `gnus-uu-grab-articles', which will +; (probably) unshar the articles. If use-marked is non-nil, it won't +; try to find articles, but use the marked list. +(defun gnus-uu-decode-and-strip (&optional shar use-marked limit) + (let (list-of-articles) + (save-excursion + + (if use-marked + (if (not gnus-newsgroup-processable) + (message "No articles marked") + (setq list-of-articles + (setq gnus-newsgroup-processable + (nreverse gnus-newsgroup-processable))) + (gnus-summary-unmark-all-processable)) + (setq list-of-articles (gnus-uu-get-list-of-articles))) + + (and list-of-articles + (gnus-uu-grab-articles + list-of-articles + (if shar 'gnus-uu-unshar-article 'gnus-uu-uustrip-article-as) + t limit))))) + +; Takes a string and puts a \ in front of every special character; +; ignores any leading "version numbers" thingies that they use in the +; comp.binaries groups, and either replaces anything that looks like +; "2/3" with "[0-9]+/[0-9]+" or, if it can't find something like that, +; replaces the last two numbers with "[0-9]+". This, in my experience, +; should get most postings of a series. +(defun gnus-uu-reginize-string (string) + (let ((count 2) + (vernum "v[0-9]+[a-z][0-9]+:") + reg beg) + (save-excursion + (set-buffer (get-buffer-create gnus-uu-output-buffer-name)) + (buffer-disable-undo (current-buffer)) + (erase-buffer) + (insert (regexp-quote string)) + (setq beg 1) + + (setq case-fold-search nil) + (goto-char 1) + (if (looking-at vernum) + (progn + (replace-match vernum t t) + (setq beg (length vernum)))) + + (goto-char beg) + (if (re-search-forward "[ \t]*[0-9]+/[0-9]+" nil t) + (replace-match " [0-9]+/[0-9]+") + + (goto-char beg) + (if (re-search-forward "[0-9]+[ \t]*of[ \t]*[0-9]+" nil t) + (replace-match "[0-9]+ of [0-9]+") + + (end-of-line) + (while (and (re-search-backward "[0-9]" nil t) (> count 0)) + (while (and + (looking-at "[0-9]") + (< 1 (goto-char (1- (point)))))) + (re-search-forward "[0-9]+" nil t) + (replace-match "[0-9]+") + (backward-char 5) + (setq count (1- count))))) + + (goto-char beg) + (while (re-search-forward "[ \t]+" nil t) + (replace-match "[ \t]*" t t)) + + (buffer-substring 1 (point-max))))) + +(defsubst gnus-uu-string< (l1 l2) + (string< (car l1) (car l2))) + +; Finds all articles that matches the regular expression given. +; Returns the resulting list. SUBJECT is the regular expression to be +; matched. If it is nil, the current article name will be used. If +; MARK-ARTICLES is non-nil, articles found are marked. If ONLY-UNREAD +; is non-nil, only unread articles are chose. If DO-NOT-TRANSLATE is +; non-nil, article names are not equialized before sorting. +(defun gnus-uu-get-list-of-articles (&optional subject mark-articles only-unread do-not-translate) + (let (beg end reg-subject list-of-subjects list-of-numbers art-num) + (save-excursion + +; If the subject is not given, this function looks at the current subject +; and takes that. + + (if subject + (setq reg-subject subject) + (setq reg-subject + (format "%s %s [0-9]+ [0-9]+[\n\r]" + (gnus-uu-reginize-string (gnus-summary-subject-string)) + (if only-unread "[- ]" ".")))) + + (if reg-subject + (progn + +; Collect all subjects matching reg-subject. + + (let ((case-fold-search t)) + (goto-char 1) + (while (re-search-forward reg-subject nil t) + (progn + (forward-line -1) + (setq list-of-subjects + (cons (cons (gnus-summary-subject-string) + (gnus-summary-article-number)) + list-of-subjects)) + (forward-line 1)))) + +; Expand all numbers in all the subjects: (hi9 -> hi0009, etc). + + (setq list-of-subjects + (gnus-uu-expand-numbers list-of-subjects + (not do-not-translate))) + +; Sort the subjects. + + (setq list-of-subjects (sort list-of-subjects 'gnus-uu-string<)) + +; Get the article numbers from the sorted list of subjects. + + (while list-of-subjects + (setq art-num (cdr (car list-of-subjects))) + (if mark-articles (gnus-summary-mark-as-read art-num ?#)) + (setq list-of-numbers (cons art-num list-of-numbers)) + (setq list-of-subjects (cdr list-of-subjects))) + + (setq list-of-numbers (nreverse list-of-numbers)))) + + list-of-numbers))) + +; Takes a list of strings and "expands" all numbers in all the +; strings. That is, this function makes all numbers equal length by +; prepending lots of zeroes before each number. This is to ease later +; sorting to find out what sequence the articles are supposed to be +; decoded in. Returns the list of expanded strings. +(defun gnus-uu-expand-numbers (string-list &optional translate) + (let ((out-list string-list) + string pos num) + (save-excursion + (set-buffer (get-buffer-create gnus-uu-output-buffer-name)) + (buffer-disable-undo (current-buffer)) + (while string-list + (erase-buffer) + (insert (car (car string-list))) + ;; Translate multiple spaces to one space. + (goto-char 1) + (while (re-search-forward "[ \t]+" nil t) + (replace-match " ")) + ;; Translate all characters to "a". + (goto-char 1) + (if translate + (while (re-search-forward "[A-Za-z]" nil t) + (replace-match "a" t t))) + ;; Expand numbers. + (goto-char 1) + (while (re-search-forward "[0-9]+" nil t) + (replace-match + (format "%06d" + (string-to-int (buffer-substring + (match-beginning 0) (match-end 0)))))) + (setq string (buffer-substring 1 (point-max))) + (setcar (car string-list) string) + (setq string-list (cdr string-list)))) + out-list)) + + +;; gnus-uu-grab-article +; +; This is the general multi-article treatment function. It takes a +; list of articles to be grabbed and a function to apply to each +; article. +; +; The function to be called should take two parameters. The first +; parameter is the article buffer. The function should leave the +; result, if any, in this buffer. Most treatment functions will just +; generate files... +; +; The second parameter is the state of the list of articles, and can +; have four values: `first', `middle', `last' and `first-and-last'. +; +; The function should return a list. The list may contain the +; following symbols: +; `error' if an error occurred +; `begin' if the beginning of an encoded file has been received +; If the list returned contains a `begin', the first element of +; the list *must* be a string with the file name of the decoded +; file. +; `end' if the the end of an encoded file has been received +; `middle' if the article was a body part of an encoded file +; `wrong-type' if the article was not a part of an encoded file +; `ok', which can be used everything is ok + +(defvar gnus-uu-has-been-grabbed nil) + +(defun gnus-uu-unmark-list-of-grabbed (&optional dont-unmark-last-article) + (let (art) + (if (not (and gnus-uu-has-been-grabbed + gnus-uu-unmark-articles-not-decoded)) + () + (if dont-unmark-last-article + (progn + (setq art (car gnus-uu-has-been-grabbed)) + (setq gnus-uu-has-been-grabbed (cdr gnus-uu-has-been-grabbed)))) + (while gnus-uu-has-been-grabbed + (gnus-summary-tick-article (car gnus-uu-has-been-grabbed) t) + (setq gnus-uu-has-been-grabbed (cdr gnus-uu-has-been-grabbed))) + (if dont-unmark-last-article + (setq gnus-uu-has-been-grabbed (list art)))))) + +; This function takes a list of articles and a function to apply to +; each article grabbed. +; +; This function returns a list of files decoded if the grabbing and +; the process-function has been successful and nil otherwise. +(defun gnus-uu-grab-articles (list-of-articles process-function &optional sloppy limit no-errors) + (let ((state 'first) + (wrong-type t) + has-been-begin has-been-end + article result-file result-files process-state article-buffer) + + (if (not (gnus-server-opened gnus-current-select-method)) + (progn + (gnus-start-news-server) + (gnus-request-group gnus-newsgroup-name))) + + (setq gnus-uu-has-been-grabbed nil) + + (while (and list-of-articles + (not (memq 'error process-state)) + (or sloppy + (not (memq 'end process-state)))) + + (setq article (car list-of-articles)) + (setq list-of-articles (cdr list-of-articles)) + (setq gnus-uu-has-been-grabbed (cons article gnus-uu-has-been-grabbed)) + + (if (> article gnus-uu-highest-article-number) + (setq gnus-uu-highest-article-number article)) + + (if (eq list-of-articles ()) + (if (eq state 'first) + (setq state 'first-and-last) + (setq state 'last))) + + (message "Getting article %d" article) + + (if (not (gnus-server-opened gnus-current-select-method)) + (progn + (gnus-start-news-server) + (gnus-request-group gnus-newsgroup-name))) + + (if (not (= (or gnus-current-article 0) article)) + (progn + (gnus-request-article article gnus-newsgroup-name) + (setq gnus-last-article gnus-current-article) + (setq gnus-current-article article) + (if (stringp nntp-server-buffer) + (setq article-buffer nntp-server-buffer) + (setq article-buffer (buffer-name nntp-server-buffer)))) + (setq article-buffer gnus-article-buffer)) + + (buffer-disable-undo article-buffer) + (gnus-summary-mark-as-read article) + + (setq process-state (funcall process-function article-buffer state)) + + (if (or (memq 'begin process-state) + (and (or (eq state 'first) (eq state 'first-and-last)) + (memq 'ok process-state))) + (progn + (if has-been-begin + (if (and result-file (file-exists-p result-file)) + (delete-file result-file))) + (if (memq 'begin process-state) + (setq result-file (car process-state))) + (setq has-been-begin t) + (setq has-been-end nil))) + + (if (memq 'end process-state) + (progn + (setq gnus-uu-has-been-grabbed nil) + (setq result-files (cons result-file result-files)) + (setq has-been-end t) + (setq has-been-begin nil) + (if (and limit (= (length result-files) limit)) + (progn + (setq list-of-articles nil) + (setq gnus-newsgroup-processable nil))))) + + (if (and (or (eq state 'last) (eq state 'first-and-last)) + (not (memq 'end process-state))) + (if (and result-file (file-exists-p result-file)) + (delete-file result-file))) + + (setq result-file nil) + + (if (not (memq 'wrong-type process-state)) + (setq wrong-type nil) + (if gnus-uu-unmark-articles-not-decoded + (gnus-summary-tick-article article t))) + + (if sloppy (setq wrong-type nil)) + + (if (and (not has-been-begin) + (not sloppy) + (or (memq 'end process-state) + (memq 'middle process-state))) + (progn + (setq process-state (list 'error)) + (message "No begin part at the beginning") + (sleep-for 2)) + (setq state 'middle))) + + ; Make sure the last article is put in the article buffer + ; & fix windows etc. + + (if (not (string= article-buffer gnus-article-buffer)) + (save-excursion + (set-buffer (get-buffer-create gnus-article-buffer)) + (let ((buffer-read-only nil)) + (widen) + (erase-buffer) + (insert-buffer-substring article-buffer) + (goto-char 1)))) + (run-hooks 'gnus-mark-article-hook) + + (if result-files + () + (if (not has-been-begin) + (if (not no-errors) (message "Wrong type file")) + (if (memq 'error process-state) + (setq result-files nil) + (if (not (or (memq 'ok process-state) + (memq 'end process-state))) + (progn + (if (not no-errors) + (message "End of articles reached before end of file")) + (setq result-files nil)) + (gnus-uu-unmark-list-of-grabbed))))) + (setq gnus-uu-list-of-files-decoded result-files) + result-files)) + +(defun gnus-uu-uudecode-sentinel (process event) + (delete-process (get-process process))) + +; Uudecodes a file asynchronously. +(defun gnus-uu-uustrip-article-as (process-buffer in-state) + (let ((state (list 'ok)) + (process-connection-type nil) + start-char pst name-beg name-end) + (save-excursion + (set-buffer process-buffer) + (let ((case-fold-search nil) + (buffer-read-only nil)) + + (goto-char 1) + + (if gnus-uu-kill-carriage-return + (progn + (while (search-forward "\r" nil t) + (delete-backward-char 1)) + (goto-char 1))) + + (if (not (re-search-forward gnus-uu-begin-string nil t)) + (if (not (re-search-forward gnus-uu-body-line nil t)) + (setq state (list 'wrong-type)))) + + (if (memq 'wrong-type state) + () + (beginning-of-line) + (setq start-char (point)) + + (if (looking-at gnus-uu-begin-string) + (progn + (setq name-end (match-end 1)) + + ; Replace any slashes and spaces in file names before decoding + (goto-char (setq name-beg (match-beginning 1))) + (while (re-search-forward "/" name-end t) + (replace-match ",")) + (goto-char name-beg) + (while (re-search-forward " " name-end t) + (replace-match "_")) + (goto-char name-beg) + (if (re-search-forward "_*$" name-end t) + (replace-match "")) + + (setq gnus-uu-file-name (buffer-substring name-beg name-end)) + (and gnus-uu-uudecode-process + (setq pst (process-status + (or gnus-uu-uudecode-process "nevair"))) + (if (or (eq pst 'stop) (eq pst 'run)) + (progn + (delete-process gnus-uu-uudecode-process) + (gnus-uu-unmark-list-of-grabbed t)))) + (if (get-process "*uudecode*") + (delete-process "*uudecode*")) + (setq gnus-uu-uudecode-process + (start-process + "*uudecode*" + (get-buffer-create gnus-uu-output-buffer-name) + "sh" "-c" + (format "cd %s ; uudecode" gnus-uu-work-dir))) + (set-process-sentinel + gnus-uu-uudecode-process 'gnus-uu-uudecode-sentinel) + (setq state (list 'begin)) + (gnus-uu-add-file (concat gnus-uu-work-dir gnus-uu-file-name))) + (setq state (list 'middle))) + + (goto-char (point-max)) + + (re-search-backward + (concat gnus-uu-body-line "\\|" gnus-uu-end-string) nil t) + (beginning-of-line) + + (if (looking-at gnus-uu-end-string) + (setq state (cons 'end state))) + (forward-line 1) + + (and gnus-uu-uudecode-process + (setq pst (process-status + (or gnus-uu-uudecode-process "nevair"))) + (if (or (eq pst 'run) (eq pst 'stop)) + (progn + (if gnus-uu-correct-stripped-uucode + (progn + (gnus-uu-check-correct-stripped-uucode + start-char (point)) + (goto-char (point-max)) + (re-search-backward + (concat gnus-uu-body-line "\\|" + gnus-uu-end-string) + nil t) + (forward-line 1))) + + (condition-case err + (process-send-region gnus-uu-uudecode-process + start-char (point)) + (error + (progn + (delete-process gnus-uu-uudecode-process) + (message "gnus-uu: Couldn't uudecode") +; (sleep-for 2) + (setq state (list 'wrong-type))))) + + (if (memq 'end state) + (accept-process-output gnus-uu-uudecode-process))) + (setq state (list 'wrong-type)))) + (if (not gnus-uu-uudecode-process) + (setq state (list 'wrong-type))))) + + (if (memq 'begin state) + (cons (concat gnus-uu-work-dir gnus-uu-file-name) state) + state)))) + +; This function is used by `gnus-uu-grab-articles' to treat +; a shared article. +(defun gnus-uu-unshar-article (process-buffer in-state) + (let ((state (list 'ok)) + start-char) + (save-excursion + (set-buffer process-buffer) + (goto-char 1) + (if (not (re-search-forward gnus-uu-shar-begin-string nil t)) + (setq state (list 'wrong-type)) + (beginning-of-line) + (setq start-char (point)) + (call-process-region + start-char (point-max) "sh" nil + (get-buffer-create gnus-uu-output-buffer-name) nil + "-c" (concat "cd " gnus-uu-work-dir " ; sh")))) + state)) + +; Returns the name of what the shar file is going to unpack. +(defun gnus-uu-find-name-in-shar () + (let ((oldpoint (point)) + res) + (goto-char 1) + (if (re-search-forward gnus-uu-shar-name-marker nil t) + (setq res (buffer-substring (match-beginning 1) (match-end 1)))) + (goto-char oldpoint) + res)) + +; Returns the article number of the given subject. +(defun gnus-uu-article-number (subject) + (let (end) + (string-match "[0-9]+[^0-9]" subject 1) + (setq end (match-end 0)) + (string-to-int + (substring subject (string-match "[0-9]" subject 1) end)))) + +; `gnus-uu-choose-action' chooses what action to perform given the name +; and `gnus-uu-file-action-list'. Returns either nil if no action is +; found, or the name of the command to run if such a rule is found. +(defun gnus-uu-choose-action (file-name file-action-list &optional no-ignore) + (let ((action-list (copy-sequence file-action-list)) + rule action) + (and + (or no-ignore + (and (not + (and gnus-uu-ignore-files-by-name + (string-match gnus-uu-ignore-files-by-name file-name))) + (not + (and gnus-uu-ignore-files-by-type + (string-match gnus-uu-ignore-files-by-type + (or (gnus-uu-choose-action + file-name gnus-uu-ext-to-mime-list t) + "")))))) + (while (not (or (eq action-list ()) action)) + (setq rule (car action-list)) + (setq action-list (cdr action-list)) + (if (string-match (car rule) file-name) + (setq action (car (cdr rule)))))) + action)) + +(defun gnus-uu-save-directory (from-dir &optional default-dir ignore-existing) + (let (dir file-name command files file) + (setq files (directory-files from-dir t)) + (if default-dir + (setq dir default-dir) + (setq dir (gnus-uu-read-directory + (concat "Where do you want the file" + (if (< 3 (length files)) "s" "") "? ")))) + + (while files + (setq file (car files)) + (setq files (cdr files)) + (string-match "/[^/]*$" file) + (setq file-name (substring file (1+ (match-beginning 0)))) + (if (string-match "^\\.\\.?$" file-name) + () + (if (and (not ignore-existing) (file-exists-p (concat dir file-name))) + (setq file-name + (read-file-name "File exists. Enter a new name: " dir + (concat dir file-name) nil file-name)) + (setq file-name (concat dir file-name))) + (rename-file file file-name t))))) + +; Moves the file from the tmp directory to where the user wants it. +(defun gnus-uu-save-file (from-file-name &optional default-dir ignore-existing) + (let (dir file-name command) + (string-match "/[^/]*$" from-file-name) + (setq file-name (substring from-file-name (1+ (match-beginning 0)))) + (if default-dir + (setq dir default-dir) + (setq dir (gnus-uu-read-directory "Where do you want the file? "))) + (if (and (not ignore-existing) (file-exists-p (concat dir file-name))) + (setq file-name + (read-file-name "File exist. Enter a new name: " dir + (concat dir file-name) nil file-name)) + (setq file-name (concat dir file-name))) + (rename-file from-file-name file-name t))) + +(defun gnus-uu-read-directory (prompt &optional default) + (let (dir ok create) + (while (not ok) + (setq ok t) + (setq dir (if default default + (read-file-name prompt gnus-uu-current-save-dir + gnus-uu-current-save-dir))) + (while (string-match "/$" dir) + (setq dir (substring dir 0 (match-beginning 0)))) + (if (file-exists-p dir) + (if (not (file-directory-p dir)) + (progn + (setq ok nil) + (message "%s is a file" dir) + (sit-for 2))) + (setq create ?o) + (while (not (or (= create ?y) (= create ?n))) + (message "%s: No such directory. Do you want to create it? (y/n)" + dir) + (setq create (read-char))) + (if (= create ?y) (make-directory dir)))) + (setq gnus-uu-current-save-dir (concat dir "/")))) + +; Unpacks an archive and views all the files in it. Returns t if +; viewing one or more files is successful. +(defun gnus-uu-treat-archive (file-path) + (let ((did-unpack t) + action command files file file-name dir) + (setq action (gnus-uu-choose-action + file-path (append gnus-uu-user-archive-rules + (if gnus-uu-ignore-default-archive-rules + nil + gnus-uu-default-archive-rules)))) + + (if (not action) (error "No unpackers for the file %s" file-path)) + + (string-match "/[^/]*$" file-path) + (setq file-name (substring file-path (1+ (match-beginning 0)))) + (setq dir (substring file-path 0 (match-beginning 0))) + + (if (gnus-uu-string-in-list action gnus-uu-destructive-archivers) + (copy-file file-path (concat file-path "~") t)) + + (setq command (format "cd %s ; %s" dir (gnus-uu-command action file-path))) + + (save-excursion + (set-buffer (get-buffer-create gnus-uu-output-buffer-name)) + (erase-buffer)) + + (message "Unpacking: %s..." (gnus-uu-command action file-path)) + + (if (= 0 (call-process "sh" nil + (get-buffer-create gnus-uu-output-buffer-name) + nil "-c" command)) + (message "") + (if (not gnus-uu-use-interactive-view) + (progn + (message "Error during unpacking of archive") + (sleep-for 2))) + (setq did-unpack nil)) + + (if (gnus-uu-string-in-list action gnus-uu-destructive-archivers) + (rename-file (concat file-path "~") file-path t)) + + did-unpack)) + +; Tries to view all the files in the given directory. Returns t if +; viewing one or more files is successful. +(defun gnus-uu-view-directory (dir &optional dont-delete-files not-top) + (let ((first t) + files file did-view ignore-files) + (setq files (gnus-uu-directory-files dir t)) + (gnus-uu-add-file files) + (setq ignore-files files) + + (while (gnus-uu-unpack-archives + files (if not-top (list ".") + (if first () ignore-files))) + (setq first nil) + (gnus-uu-add-file + (setq files (gnus-uu-directory-files dir t)))) + + (gnus-uu-add-file (gnus-uu-directory-files dir t)) + + (while files + (setq file (car files)) + (setq files (cdr files)) + (if (not (string= (or (gnus-uu-get-action file) "") "gnus-uu-archive")) + (progn + (set-file-modes file 448) + (if (file-directory-p file) + (setq did-view (or (gnus-uu-view-directory file + dont-delete-files + t) + did-view)) + (setq did-view (or (gnus-uu-view-file file t) did-view))))) + (if (and (not dont-delete-files) (not gnus-uu-asynchronous) + (file-exists-p file)) + (delete-file file))) + + (if (and (not gnus-uu-asynchronous) (not dont-delete-files)) + (if (string-match "/$" dir) + (delete-directory (substring dir 0 (match-beginning 0))) + (delete-directory dir))) + did-view)) + +(defun gnus-uu-dir-files (dir) + (let ((dirs (directory-files dir t "[^/][^\\.][^\\.]?$")) + files file) + (while dirs + (if (file-directory-p (setq file (car dirs))) + (setq files (append files (gnus-uu-dir-files file))) + (setq files (cons file files))) + (setq dirs (cdr dirs))) + files)) + +(defun gnus-uu-directory-files-old (dir) + (let ((files (directory-files dir t)) f) + (setq f files) + (while (cdr f) + (if (string-match "/\\.\\.?$" (car (cdr f))) + (setcdr f (cdr (cdr f))) + (setq f (cdr f)))) + (if (string-match "/\\.\\.?$" (car files)) (cdr files) + files))) + +(defun gnus-uu-unpack-archives (files &optional ignore) + (let (path did-unpack) + (while files + (setq path (car files)) + (setq files (cdr files)) + (if (not (gnus-uu-string-in-list path ignore)) + (if (string= (or (gnus-uu-get-action + (gnus-uu-name-from-path path)) "") + "gnus-uu-archive") + (progn + (if (and (not (setq did-unpack (gnus-uu-treat-archive path))) + gnus-uu-use-interactive-view) + (gnus-uu-enter-interactive-file + "# error during unpacking of" path)) + (if ignore (delete-file path)))))) + did-unpack)) + + +;; Manual marking + +(defun gnus-uu-mark-by-regexp () + "Asks for a regular expression and marks all articles that match." + (interactive) + (let (exp) + (setq exp (read-from-minibuffer "Mark (regexp): ")) + (setq gnus-newsgroup-processable + (nconc gnus-newsgroup-processable + (nreverse (gnus-uu-get-list-of-articles exp t)))) + (message ""))) + +(defun gnus-uu-mark-region (beg end) + "Marks all articles between point and mark." + (interactive "r") + (let ((mark-even-if-inactive t) + (opoint 0) + tmp) + (save-excursion + (cond + ((= beg end) + (error "Empty region.")) + (t + (if (< end beg) + (progn + (setq tmp beg) + (setq beg end) + (setq end tmp))) + (goto-char beg) + (while (and (< (point) end) + (not (= (point) opoint))) + (setq opoint (point)) + (gnus-summary-set-process-mark (gnus-summary-article-number)))))))) + +(defun gnus-uu-mark-thread () + "Marks all articles downwards in this thread." + (interactive) + (beginning-of-line) + (let (level) + (if (not (search-forward ":" nil t)) + () + (setq level (current-column)) + (gnus-summary-set-process-mark (gnus-summary-article-number)) + (gnus-summary-search-forward) + (while (< level (current-column)) + (gnus-summary-set-process-mark (gnus-summary-article-number)) + (gnus-summary-search-forward)) + (gnus-summary-search-backward)))) + +(defun gnus-uu-marked-universal-argument () + "Perform any operation on all marked articles. +If you type `\\\\[gnus-uu-decode-and-view]' and then, for instance, `u', +gnus-uu will perform the operation bound to `u' on all +marked articles." + (interactive) + (let ((articles (setq gnus-newsgroup-processable + (nreverse gnus-newsgroup-processable))) + key func) + (gnus-summary-unmark-all-processable) + (if (not articles) + (error "No articles marked")) + (if (not (setq func (key-binding (read-key-sequence "C-c C-v C-u")))) + (error "Undefined key")) + (while articles + (gnus-summary-goto-subject (car articles)) + (command-execute func) + (setq articles (cdr articles))))) + + +;; Various stuff + +(defun gnus-uu-string-in-list (string list) + (while (and list + (not (string= (car list) string)) + (setq list (cdr list)))) + list) + +(defun gnus-uu-name-from-path (path) + (string-match "/[^/]*$" path) + (substring path (1+ (match-beginning 0)))) + +(defun gnus-uu-directory-files (dir &optional full) + (let (files out file) + (setq files (directory-files dir full)) + (while files + (setq file (car files)) + (setq files (cdr files)) + (if (not (string-match "/\\.\\.?$" file)) + (setq out (cons file out)))) + (setq out (reverse out)) + out)) + +(defun gnus-uu-check-correct-stripped-uucode (start end) + (let (found beg length short) + (if (not gnus-uu-correct-stripped-uucode) + () + (goto-char start) + + (if (re-search-forward " \\|`" end t) + (progn + (goto-char start) + (while (not (eobp)) + (progn + (if (looking-at "\n") (replace-match "")) + (forward-line 1)))) + + (while (not (eobp)) + (if (looking-at (concat gnus-uu-begin-string "\\|" + gnus-uu-end-string)) + () + (if (not found) + (progn + (beginning-of-line) + (setq beg (point)) + (end-of-line) + (setq length (- (point) beg)))) + (setq found t) + (beginning-of-line) + (setq beg (point)) + (end-of-line) + (if (not (= length (- (point) beg))) + (insert (make-string (- length (- (point) beg)) ? )))) + (forward-line 1)))))) + +(defun gnus-uu-initialize () + (setq gnus-uu-highest-article-number 1) + (gnus-uu-check-for-generated-files) + (setq gnus-uu-tmp-dir (expand-file-name gnus-uu-tmp-dir)) + (if (string-match "[^/]$" gnus-uu-tmp-dir) + (setq gnus-uu-tmp-dir (concat gnus-uu-tmp-dir "/"))) + (if (not (file-directory-p gnus-uu-tmp-dir)) + (error "Temp directory %s doesn't exist" gnus-uu-tmp-dir) + (if (not (file-writable-p gnus-uu-tmp-dir)) + (error "Temp directory %s can't be written to" gnus-uu-tmp-dir))) + (setq gnus-uu-work-dir + (concat gnus-uu-tmp-dir (make-temp-name "gnus"))) + (gnus-uu-add-file gnus-uu-work-dir) + (if (not (file-directory-p gnus-uu-work-dir)) + (make-directory gnus-uu-work-dir)) + (setq gnus-uu-work-dir (concat gnus-uu-work-dir "/")) + (setq gnus-uu-interactive-file-list nil)) + +; Kills the temporary uu buffers, kills any processes, etc. +(defun gnus-uu-clean-up () + (let (buf pst) + (and gnus-uu-uudecode-process + (setq pst (process-status (or gnus-uu-uudecode-process "nevair"))) + (if (or (eq pst 'stop) (eq pst 'run)) + (delete-process gnus-uu-uudecode-process))) + (and (not gnus-uu-asynchronous) + (setq buf (get-buffer gnus-uu-output-buffer-name)) + (kill-buffer buf)))) + +; `gnus-uu-check-for-generated-files' deletes any generated files that +; hasn't been deleted, if, for instance, the user terminated decoding +; with `C-g'. +(defun gnus-uu-check-for-generated-files () + (let (file dirs) + (while gnus-uu-generated-file-list + (setq file (car gnus-uu-generated-file-list)) + (setq gnus-uu-generated-file-list (cdr gnus-uu-generated-file-list)) + (if (not (string-match "/\\.[\\.]?$" file)) + (progn + (if (file-directory-p file) + (setq dirs (cons file dirs)) + (if (file-exists-p file) + (delete-file file)))))) + (setq dirs (nreverse dirs)) + (while dirs + (setq file (car dirs)) + (setq dirs (cdr dirs)) + (if (file-directory-p file) + (if (string-match "/$" file) + (delete-directory (substring file 0 (match-beginning 0))) + (delete-directory file)))))) + +; Add a file (or a list of files) to be checked (and deleted if it/they +; still exists upon exiting the newsgroup). +(defun gnus-uu-add-file (file) + (if (stringp file) + (setq gnus-uu-generated-file-list + (cons file gnus-uu-generated-file-list)) + (setq gnus-uu-generated-file-list + (append file gnus-uu-generated-file-list)))) + +; Go to the next unread subject. If there is no further unread +; subjects, go to the last subject in the buffer. +(defun gnus-uu-summary-next-subject () + (let (opi) + (if (not (gnus-summary-search-forward t)) + (progn + (goto-char 1) + (sit-for 0) + (gnus-summary-goto-subject gnus-uu-highest-article-number))) + + ; You may well find all this a bit puzzling - so do I, but I seem + ; to have to do something like this to move to the next unread article, + ; as `sit-for' seems to do some rather strange things here. Might + ; be a bug in my head, probably. + (setq opi (point)) + (sit-for 0) + (goto-char opi) + (gnus-summary-recenter))) + +; Inputs an action and a file and returns a full command, putting +; ticks round the file name and escaping any ticks in the file name. +(defun gnus-uu-command (action file) + (let ((ofile "")) + (while (string-match "`\\|\"\\|\\$\\|\\\\" file) + (progn + (setq ofile + (concat ofile (substring file 0 (match-beginning 0)) "\\" + (substring file (match-beginning 0) (match-end 0)))) + (setq file (substring file (1+ (match-beginning 0)))))) + (setq ofile (concat "\"" ofile file "\"")) + (if (string-match "%s" action) + (format action ofile) + (concat action " " ofile)))) + + +;; Initializing +(add-hook 'gnus-exit-group-hook + '(lambda () + (gnus-uu-clean-up) + (gnus-uu-check-for-generated-files))) + + +;; Interactive exec mode + +(defvar gnus-uu-output-window nil) +(defvar gnus-uu-mode-hook nil) + +(defvar gnus-uu-mode-map nil) +(if gnus-uu-mode-map + () + (setq gnus-uu-mode-map (make-sparse-keymap)) + (define-key gnus-uu-mode-map "\C-c\C-x" 'gnus-uu-interactive-execute) + (define-key gnus-uu-mode-map "\C-c\C-v" 'gnus-uu-interactive-execute) + (define-key gnus-uu-mode-map "\C-m" 'gnus-uu-interactive-execute) + (define-key gnus-uu-mode-map "\C-c\C-c" 'gnus-uu-interactive-end) + (define-key gnus-uu-mode-map "\C-cs" + 'gnus-uu-interactive-save-current-file) + (define-key gnus-uu-mode-map "\C-c\C-s" + 'gnus-uu-interactive-save-current-file-silent) + (define-key gnus-uu-mode-map "\C-c\C-w" 'gnus-uu-interactive-save-all-files) + (define-key gnus-uu-mode-map "\C-c\C-o" 'gnus-uu-interactive-save-original-file) + (define-key gnus-uu-mode-map "\C-c\C-r" 'gnus-uu-interactive-rescan-directory) + (define-key gnus-uu-mode-map "\C-cr" 'gnus-uu-interactive-scan-directory) + ) + +(defun gnus-uu-interactive-set-up-windows () + (let (int-buf out-buf height) + (gnus-configure-windows 'article) + (set-buffer + (setq int-buf (get-buffer-create gnus-uu-interactive-buffer-name))) + (if (not (get-buffer-window int-buf)) + (progn + (select-window (get-buffer-window gnus-article-buffer)) + (switch-to-buffer int-buf))) + (setq out-buf (get-buffer-create gnus-uu-output-buffer-name)) + (if (not (get-buffer-window out-buf)) + (progn + (if (> 2 (setq height (- (window-height) + gnus-uu-output-window-height))) + (setq height (/ (window-height) 2))) + (if (> height 2) + (progn + (setq gnus-uu-output-window (split-window nil height)) + (set-window-buffer gnus-uu-output-window out-buf))))))) + +(defun gnus-uu-do-interactive (&optional dont-do-windows) + (if (not gnus-uu-interactive-file-list) + (gnus-uu-enter-interactive-file "#" "")) + (if (not dont-do-windows) (gnus-uu-interactive-set-up-windows)) + (save-excursion + (set-buffer (get-buffer-create gnus-uu-output-buffer-name)) + (erase-buffer)) + (set-buffer (get-buffer-create gnus-uu-interactive-buffer-name)) + (goto-char 1) + (forward-line 3) + (run-hooks 'gnus-uu-mode-hook)) + +(defun gnus-uu-enter-interactive-file (action file) + (let (command) + (save-excursion + (set-buffer (get-buffer-create gnus-uu-interactive-buffer-name)) + (if (not gnus-uu-interactive-file-list) + (progn + (erase-buffer) + (gnus-uu-mode) + (insert + "# Press return to execute a command. +# Press `C-c C-c' to exit interactive view. + +"))) + (setq gnus-uu-interactive-file-list + (cons file gnus-uu-interactive-file-list)) +; (if (string-match (concat "^" gnus-uu-work-dir) file) +; (setq file (substring file (match-end 0)))) + (setq command (gnus-uu-command action file)) + (goto-char (point-max)) + (insert (format "%s\n" command))))) + +(defun gnus-uu-interactive-execute () + "Executes the command on the current line in interactive mode." + (interactive) + (let (beg out-buf command) + (beginning-of-line) + (setq beg (point)) + (end-of-line) + (setq command (buffer-substring beg (point))) + (setq out-buf (get-buffer-create gnus-uu-output-buffer-name)) + (save-excursion + (set-buffer out-buf) + (erase-buffer) + (insert (format "$ %s \n\n" command))) + (setq command (format "cd %s ; %s" gnus-uu-work-dir command)) + (message "Executing...") + (if gnus-uu-asynchronous + (start-process "gnus-uu-view" out-buf "sh" "-c" command) + (call-process "sh" nil out-buf nil "-c" command) + (message "")) + (end-of-line) + (if (= (forward-line 1) 1) + (progn + (end-of-line) + (insert "\n"))) + (beginning-of-line))) + +(defun gnus-uu-interactive-end () + "This function exits interactive view mode and returns to summary mode." + (interactive) + (let (buf) + (if (windowp gnus-uu-output-window) (delete-window gnus-uu-output-window)) + (gnus-configure-windows 'article) + (gnus-uu-clean-up) + (if (not gnus-uu-asynchronous) (gnus-uu-check-for-generated-files)) + (setq buf (get-buffer gnus-uu-interactive-buffer-name)) + (if gnus-article-buffer (switch-to-buffer gnus-article-buffer)) + (if buf (kill-buffer buf)) + (pop-to-buffer gnus-summary-buffer))) + + +(defun gnus-uu-interactive-scan-directory (dir) + "Read any directory and view the files. +When used in interactive mode, the files and commands will be displayed, +as usual, in the interactive mode buffer." + (interactive "DDirectory: ") + (setq gnus-uu-interactive-file-list nil) + (gnus-uu-view-directory dir gnus-uu-use-interactive-view) + (gnus-uu-do-interactive t)) + +(defun gnus-uu-interactive-rescan-directory () + "Reread the directory and view the files. +When used in interactive mode, the files and commands will be displayed, +as usual, in the interactive mode buffer." + (interactive) + (gnus-uu-interactive-scan-directory gnus-uu-work-dir)) + +(defun gnus-uu-interactive-save-original-file () + "Saves the file from whence the file on the current line came from." + (interactive) + (let ((files gnus-uu-list-of-files-decoded) + (filestr "") + file did dir) + (while files + (setq file (car files)) + (setq files (cdr files)) + (if (file-exists-p file) + (progn + (if (not did) + (progn + (setq dir (gnus-uu-read-directory + (format "Where do you want the file%s? " + (if (> (length files) 1) "s" "")))) + (setq did t))) + (setq filestr (concat filestr (gnus-uu-name-from-path file) " ")) + (gnus-uu-save-file file dir t))) + (if did + (message "Saved %s" filestr) + (message "Already saved."))))) + +(defun gnus-uu-interactive-save-current-file-silent () + "Saves the file referred to on the current line in the current directory." + (interactive) + (gnus-uu-interactive-save-current-file t)) + +(defun gnus-uu-interactive-save-current-file (&optional dont-ask silent) + "Saves the file referred to on the current line." + (interactive) + (let (files beg line file) + (setq files (copy-sequence gnus-uu-interactive-file-list)) + (beginning-of-line) + (setq beg (point)) + (end-of-line) + (setq line (buffer-substring beg (point))) + (while (and files + (not (string-match + (concat "" (regexp-quote (setq file (car files))) "") + line))) + (setq files (cdr files))) + (beginning-of-line) + (forward-line 1) + (if (not files) + (if (not silent) + (progn (message "Could not find file") (sit-for 2))) + (gnus-uu-save-file file (if dont-ask gnus-uu-current-save-dir nil) silent) + (delete-region beg (point))))) + +(defun gnus-uu-interactive-save-all-files () + "Saves all files referred to in the interactive buffer." + (interactive) + (let (dir) + (goto-char 1) + (setq dir (gnus-uu-read-directory "Where do you want the files? ")) + (while (not (eobp)) + (gnus-uu-interactive-save-current-file t t)))) + +(defun gnus-uu-mode () + "Major mode for editing view commands in gnus-uu. + +Commands: +\\Return, C-c C-v, C-c C-x Execute the current command +\\[gnus-uu-interactive-end]\tEnd interactive mode +\\[gnus-uu-interactive-save-current-file]\tSave the current file +\\[gnus-uu-interactive-save-current-file-silent]\tSave the current file without asking +\twhere to put it +\\[gnus-uu-interactive-save-all-files]\tSave all files +\\[gnus-uu-interactive-save-original-file]\tSave the original file: If the files +\toriginated in an archive, the archive +\tfile is saved. +\\[gnus-uu-interactive-rescan-directory]\tRescan the directory +\\[gnus-uu-interactive-scan-directory]\tScan any directory +" + (interactive) + (kill-all-local-variables) + (use-local-map gnus-uu-mode-map) + (setq mode-name "gnus-uu") + (setq major-mode 'gnus-uu-mode) +) + + (define-key gnus-uu-mode-map "\C-c\C-x" 'gnus-uu-interactive-execute) + (define-key gnus-uu-mode-map "\C-c\C-v" 'gnus-uu-interactive-execute) + (define-key gnus-uu-mode-map "\C-m" 'gnus-uu-interactive-execute) + (define-key gnus-uu-mode-map "\C-c\C-c" 'gnus-uu-interactive-end) + (define-key gnus-uu-mode-map "\C-cs" + 'gnus-uu-interactive-save-current-file) + (define-key gnus-uu-mode-map "\C-c\C-s" + 'gnus-uu-interactive-save-current-file-silent) + (define-key gnus-uu-mode-map "\C-c\C-a" 'gnus-uu-interactive-save-all-files) + (define-key gnus-uu-mode-map "\C-c\C-o" 'gnus-uu-interactive-save-original-file) + + +;; Major mode for posting encoded articles. + +(require 'sendmail) +(require 'rnews) + +; Any function that is to be used as and encoding method will take two +; parameters: PATH-NAME and FILE-NAME. (E.g. "/home/gaga/spiral.jpg" +; and "spiral.jpg", respectively.) The function should return nil if +; the encoding wasn't successful. +(defvar gnus-uu-post-encode-method 'gnus-uu-post-encode-uuencode + "Function used for encoding binary files. +There are three functions supplied with gnus-uu for encoding files: +`gnus-uu-post-encode-uuencode', which does straight uuencoding; +`gnus-uu-post-encode-mime', which encodes with base64 and adds MIME +headers; and `gnus-uu-post-encode-mime-uuencode', which encodes with +uuencode and adds MIME headers.") + +(defvar gnus-uu-post-include-before-composing nil + "Non-nil means that gnus-uu will ask for a file to encode before you compose the article. +If this variable is t, you can either include an encoded file with +\\\\[gnus-uu-post-insert-binary-in-article] or have one included for you when you post the article.") + +(defvar gnus-uu-post-length 990 + "Maximum length of an article. +The encoded file will be split into how many articles it takes to +post the entire file.") + +(defvar gnus-uu-post-threaded nil + "Non-nil means that gnus-uu will post the encoded file in a thread. +This may not be smart, as no other decoder I have seen are able to +follow threads when collecting uuencoded articles. (Well, I have seen +one package that does that - gnus-uu, but somehow, I don't think that +counts...) Default is nil.") + +(defvar gnus-uu-post-separate-description t + "Non-nil means that the description will be posted in a separate article. +The first article will typically be numbered (0/x). If this variable +is nil, the description the user enters will be included at the +beginning of the first article, which will be numbered (1/x). Default +is t.") + +(defconst gnus-uu-post-binary-separator "--binary follows this line--") +(defvar gnus-uu-post-message-id nil) +(defvar gnus-uu-post-inserted-file-name nil) +(defvar gnus-uu-winconf-post-news nil) + +; The following map and mode was taken from rnewspost.el and edited +; somewhat. +(defvar gnus-uu-post-reply-mode-map () "Mode map used by gnus-uu-post-reply.") +(or gnus-uu-post-reply-mode-map + (progn + (setq gnus-uu-post-reply-mode-map (make-keymap)) + (define-key gnus-uu-post-reply-mode-map "\C-c?" 'describe-mode) + (define-key gnus-uu-post-reply-mode-map "\C-c\C-f\C-d" + 'news-reply-distribution) + (define-key gnus-uu-post-reply-mode-map "\C-c\C-f\C-k" + 'news-reply-keywords) + (define-key gnus-uu-post-reply-mode-map "\C-c\C-f\C-n" + 'news-reply-newsgroups) + + (define-key gnus-uu-post-reply-mode-map "\C-c\C-f\C-f" + 'news-reply-followup-to) + (define-key gnus-uu-post-reply-mode-map "\C-c\C-f\C-s" 'mail-subject) + (define-key gnus-uu-post-reply-mode-map "\C-c\C-f\C-a" + 'gnus-uu-post-reply-summary) + (define-key gnus-uu-post-reply-mode-map "\C-c\C-r" + 'news-caesar-buffer-body) + (define-key gnus-uu-post-reply-mode-map "\C-c\C-w" 'news-reply-signature) + (define-key gnus-uu-post-reply-mode-map "\C-c\C-y" + 'news-reply-yank-original) + (define-key gnus-uu-post-reply-mode-map "\C-c\C-q" + 'mail-fill-yanked-message) + (define-key gnus-uu-post-reply-mode-map "\C-c\C-c" + 'gnus-uu-post-news-inews) + (define-key gnus-uu-post-reply-mode-map "\C-c\C-s" + 'gnus-uu-post-news-inews) + (define-key gnus-uu-post-reply-mode-map "\C-c\C-i" + 'gnus-uu-post-insert-binary-in-article) + )) + +; This mode was taken from rnewspost.el and modified slightly. +(defun gnus-uu-post-reply-mode () + "Major mode for editing binary news to be posted on USENET. +First-time posters are asked to please read the articles in newsgroup: + news.announce.newusers . + +Like news-reply-mode, which is like Text Mode, but with these +additional commands: + +\\\\[gnus-uu-post-news-inews] post the message. +C-c C-f move to a header field (and create it if there isn't): + C-c C-f C-n move to Newsgroups: C-c C-f C-s move to Subj: + C-c C-f C-f move to Followup-To: C-c C-f C-k move to Keywords: + C-c C-f C-d move to Distribution: C-c C-f C-a move to Summary: +C-c C-y news-reply-yank-original (insert current message, in NEWS). +C-c C-q mail-fill-yanked-message (fill what was yanked). +C-c C-r caesar rotate all letters by 13 places in the article's body (rot13). +\\[gnus-uu-post-insert-binary-in-article] encode and include a file in this article. + +This mode is almost identical to news-reply-mode, but has some +additional commands for treating encoded binary articles. In +particular, \\[gnus-uu-post-news-inews] will ask for a file to include, if +one hasn't been included already. It will post, first, the message +composed, and then it will post as many additional articles it takes +to post the entire encoded files. + + Relevant Variables + + `gnus-uu-post-encode-method' + There are three functions supplied with gnus-uu for encoding files: + `gnus-uu-post-encode-uuencode', which does straight uuencoding; + `gnus-uu-post-encode-mime', which encodes with base64 and adds MIME + headers; and `gnus-uu-post-encode-mime-uuencode', which encodes with + uuencode and adds MIME headers. + + `gnus-uu-post-include-before-composing' + Non-nil means that gnus-uu will ask for a file to encode before you + compose the article. If this variable is t, you can either include + an encoded file with `C-c C-i' or have one included for you when you + post the article. + + `gnus-uu-post-length' + Maximum length of an article. The encoded file will be split into how + many articles it takes to post the entire file. + + `gnus-uu-post-separate-description' + Non-nil means that the description will be posted in a separate + article. The first article will typically be numbered (0/x). If + this variable is nil, the description the user enters will be + included at the beginning of the first article, which will be + numbered (1/x). Default is t. + + `gnus-uu-post-threaded' + Non-nil means that gnus-uu will post the encoded file in a thread. + This may not be smart, as no other decoder I have seen are able to + follow threads when collecting uuencoded articles. (Well, I have seen + one package that does that - gnus-uu, but somehow, I don't think that + counts...) Default is nil. +" + (interactive) + ;; require... + (or (fboundp 'mail-setup) (load "sendmail")) + (kill-all-local-variables) + (make-local-variable 'mail-reply-buffer) + (setq mail-reply-buffer nil) + (set-syntax-table text-mode-syntax-table) + (use-local-map gnus-uu-post-reply-mode-map) + (setq local-abbrev-table text-mode-abbrev-table) + (setq major-mode 'gnus-uu-post-reply-mode) + (setq mode-name "Gnus UU News") + (make-local-variable 'paragraph-separate) + (make-local-variable 'paragraph-start) + (setq paragraph-start (concat "^" mail-header-separator "$\\|" + paragraph-start)) + (setq paragraph-separate (concat "^" mail-header-separator "$\\|" + paragraph-separate)) + (run-hooks 'text-mode-hook 'gnus-uu-post-reply-mode-hook)) + +(defun gnus-uu-post-news () + "Compose an article and post an encoded file." + (interactive) + (setq gnus-uu-post-inserted-file-name nil) + (setq gnus-uu-winconf-post-news (current-window-configuration)) + (let (news-reply-mode) + (fset 'news-reply-mode 'gnus-uu-post-reply-mode) + (gnus-summary-post-news) + (if gnus-uu-post-include-before-composing + (save-excursion (setq gnus-uu-post-inserted-file-name + (gnus-uu-post-insert-binary)))))) + +(defun gnus-uu-post-insert-binary-in-article () + "Inserts an encoded file in the buffer. +The user will be asked for a file name." + (interactive) + (if (not (eq (current-buffer) (get-buffer gnus-post-news-buffer))) + (error "Not in post-news buffer")) + (save-excursion + (setq gnus-uu-post-inserted-file-name (gnus-uu-post-insert-binary)))) + +; Encodes with uuencode and substitutes all spaces with backticks. +(defun gnus-uu-post-encode-uuencode (path file-name) + (if (gnus-uu-post-encode-file "uuencode" path file-name) + (progn + (goto-char 1) + (forward-line 1) + (while (re-search-forward " " nil t) + (replace-match "`")) + t))) + +; Encodes with uuencode and adds MIME headers. +(defun gnus-uu-post-encode-mime-uuencode (path file-name) + (if (gnus-uu-post-encode-uuencode path file-name) + (progn + (gnus-uu-post-make-mime file-name "x-uue") + t))) + +; Encodes with base64 and adds MIME headers +(defun gnus-uu-post-encode-mime (path file-name) + (if (gnus-uu-post-encode-file "mmencode" path file-name) + (progn + (gnus-uu-post-make-mime file-name "base64") + t))) + +; Adds MIME headers. +(defun gnus-uu-post-make-mime (file-name encoding) + (goto-char 1) + (insert (format "Content-Type: %s; name=\"%s\"\n" + (gnus-uu-choose-action file-name gnus-uu-ext-to-mime-list) + file-name)) + (insert (format "Content-Transfer-Encoding: %s\n\n" encoding)) + (save-restriction + (set-buffer gnus-post-news-buffer) + (goto-char 1) + (re-search-forward mail-header-separator) + (beginning-of-line) + (forward-line -1) + (narrow-to-region 1 (point)) + (or (mail-fetch-field "mime-version") + (progn + (widen) + (insert "MIME-Version: 1.0\n"))) + (widen))) + +; Encodes a file PATH with COMMAND, leaving the result in the +; current buffer. +(defun gnus-uu-post-encode-file (command path file-name) + (= 0 (call-process "sh" nil t nil "-c" + (format "%s %s %s" command path file-name)))) + +(defun gnus-uu-post-news-inews () + "Posts the composed news article and encoded file. +If no file has been included, the user will be asked for a file." + (interactive) + (if (not (eq (current-buffer) (get-buffer gnus-post-news-buffer))) + (error "Not in post news buffer")) + + (let (file-name) + + (if gnus-uu-post-inserted-file-name + (setq file-name gnus-uu-post-inserted-file-name) + (setq file-name (gnus-uu-post-insert-binary))) + + (if gnus-uu-post-threaded + (let ((gnus-required-headers + (if (memq 'Message-ID gnus-required-headers) + gnus-required-headers + (cons 'Message-ID gnus-required-headers))) + gnus-inews-article-hook elem) + + (setq gnus-inews-article-hook (if (listp gnus-inews-article-hook) + gnus-inews-article-hook + (list gnus-inews-article-hook))) + (setq gnus-inews-article-hook + (cons + '(lambda () + (save-excursion + (goto-char 1) + (if (re-search-forward "^Message-ID: \\(.*\\)$" nil t) + (setq gnus-uu-post-message-id + (buffer-substring + (match-beginning 1) (match-end 1))) + (setq gnus-uu-post-message-id nil)))) + gnus-inews-article-hook)) + (gnus-uu-post-encoded file-name t)) + (gnus-uu-post-encoded file-name nil))) + (setq gnus-uu-post-inserted-file-name nil) + (and gnus-uu-winconf-post-news + (set-window-configuration gnus-uu-winconf-post-news))) + +; Asks for a file to encode, encodes it and inserts the result in +; the current buffer. Returns the file name the user gave. +(defun gnus-uu-post-insert-binary () + (let ((uuencode-buffer-name "*uuencode buffer*") + file-path post-buf uubuf file-name) + + (setq file-path (read-file-name + "What file do you want to encode? ")) + (if (not (file-exists-p file-path)) + (error "%s: No such file" file-path)) + + (goto-char (point-max)) + (insert (format "\n%s\n" gnus-uu-post-binary-separator)) + + (if (string-match "^~/" file-path) + (setq file-path (concat "$HOME" (substring file-path 1)))) + (if (string-match "/[^/]*$" file-path) + (setq file-name (substring file-path (1+ (match-beginning 0)))) + (setq file-name file-path)) + + (unwind-protect + (if (save-excursion + (set-buffer (setq uubuf + (get-buffer-create uuencode-buffer-name))) + (erase-buffer) + (funcall gnus-uu-post-encode-method file-path file-name)) + (insert-buffer uubuf) + (error "Encoding unsuccessful")) + (kill-buffer uubuf)) + file-name)) + +; Posts the article and all of the encoded file. +(defun gnus-uu-post-encoded (file-name &optional threaded) + (let ((send-buffer-name "*uuencode send buffer*") + (encoded-buffer-name "*encoded buffer*") + (top-string "[ cut here %s (%s %d/%d) %s gnus-uu ]") + (separator (concat mail-header-separator "\n\n")) + file uubuf length parts header i end beg + beg-line minlen buf post-buf whole-len beg-binary end-binary) + + (setq post-buf (current-buffer)) + + (goto-char 1) + (if (not (re-search-forward + (if gnus-uu-post-separate-description + gnus-uu-post-binary-separator + mail-header-separator) nil t)) + (error "Internal error: No binary/header separator")) + (beginning-of-line) + (forward-line 1) + (setq beg-binary (point)) + (setq end-binary (point-max)) + + (save-excursion + (set-buffer (setq uubuf (get-buffer-create encoded-buffer-name))) + (erase-buffer) + (insert-buffer-substring post-buf beg-binary end-binary) + (goto-char 1) + (setq length (count-lines 1 (point-max))) + (setq parts (/ length gnus-uu-post-length)) + (if (not (< (% length gnus-uu-post-length) 4)) + (setq parts (1+ parts)))) + + (if gnus-uu-post-separate-description + (forward-line -1)) + (kill-region (point) (point-max)) + + (goto-char 1) + (search-forward mail-header-separator nil t) + (beginning-of-line) + (setq header (buffer-substring 1 (point))) + + (goto-char 1) + (if (not gnus-uu-post-separate-description) + () + (if (and (not threaded) (re-search-forward "^Subject: " nil t)) + (progn + (end-of-line) + (insert (format " (0/%d)" parts)))) + (gnus-inews-news)) + + (save-excursion + (setq i 1) + (setq beg 1) + (while (not (> i parts)) + (set-buffer (get-buffer-create send-buffer-name)) + (erase-buffer) + (insert header) + (if (and threaded gnus-uu-post-message-id) + (insert (format "References: %s\n" gnus-uu-post-message-id))) + (insert separator) + (setq whole-len + (- 62 (length (format top-string "" file-name i parts "")))) + (if (> 1 (setq minlen (/ whole-len 2))) + (setq minlen 1)) + (setq + beg-line + (format top-string + (make-string minlen ?-) + file-name i parts + (make-string + (if (= 0 (% whole-len 2)) (1- minlen) minlen) ?-))) + + (goto-char 1) + (if (not (re-search-forward "^Subject: " nil t)) + () + (if (not threaded) + (progn + (end-of-line) + (insert (format " (%d/%d)" i parts))) + (if (or (and (= i 2) gnus-uu-post-separate-description) + (and (= i 1) (not gnus-uu-post-separate-description))) + (replace-match "Subject: Re: ")))) + + (goto-char (point-max)) + (save-excursion + (set-buffer uubuf) + (goto-char beg) + (if (= i parts) + (goto-char (point-max)) + (forward-line gnus-uu-post-length)) + (if (and (= (1+ i) parts) (< (count-lines (point) (point-max)) 4)) + (forward-line -4)) + (setq end (point))) + (insert-buffer-substring uubuf beg end) + (insert beg-line) + (insert "\n") + (setq beg end) + (setq i (1+ i)) + (goto-char 1) + (re-search-forward mail-header-separator nil t) + (beginning-of-line) + (forward-line 2) + (if (re-search-forward gnus-uu-post-binary-separator nil t) + (progn + (replace-match "") + (forward-line 1))) + (insert beg-line) + (insert "\n") + (gnus-inews-news))) + + (and (setq buf (get-buffer send-buffer-name)) + (kill-buffer buf)) + (and (setq buf (get-buffer encoded-buffer-name)) + (kill-buffer buf)) + + (if (not gnus-uu-post-separate-description) + (progn + (set-buffer-modified-p nil) + (and (fboundp 'bury-buffer) (bury-buffer)))))) + +(provide 'gnus-uu) + +;; gnus-uu.el ends here diff --git a/lisp/gnus.el b/lisp/gnus.el new file mode 100644 index 000000000..bfd8b96a1 --- /dev/null +++ b/lisp/gnus.el @@ -0,0 +1,9748 @@ +;;; (ding) Gnus: a newsreader for GNU Emacs +;; Copyright (C) 1987,88,89,90,93,94 Free Software Foundation, Inc. + +;; Author: Masanobu UMEDA +;; Lars Ingebrigtsen +;; Keywords: news + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to +;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +;;; Commentary: + +;; Although (ding) Gnus looks suspiciously like GNUS, it isn't quite +;; the same beast. Most internal structures have been changed. If you +;; have written packages that depend on any of the hash tables, +;; `gnus-newsrc-assoc', `gnus-killed-assoc', marked lists, the .newsrc +;; buffer, or internal knowledge of the `nntp-header-' macros, or +;; dependence on the buffers having a certain format, your code will +;; fail. + +;;; Code: + +(require 'mail-utils) +(require 'rnews) +(require 'nnheader) +(require 'rmail) +(require 'nnmail) + +(defvar gnus-select-method + (list 'nntp (or (getenv "NNTPSERVER") + (if (and gnus-default-nntp-server + (not (string= gnus-default-nntp-server ""))) + gnus-default-nntp-server) + (system-name)) + "nntp") + "*Default method for selecting a newsgroup. +This variable should be a list, where the first element is how the +news is to be fetched, the second is the address, and the optional +third element is the \"port number\", if nntp is used. + +For instance, if you want to get your news via NNTP from +\"flab.flab.edu\" on port 23, you could say: + +(setq gnus-select-method '(nntp \"flab.flab.edu\" 23)) + +If you want to use your local spool, say: + +(setq gnus-select-method (list 'nnspool (system-name))) + +If you use this variable, you must set `gnus-nntp-server' to nil.") + +;; By Sudish Joseph . +(defvar gnus-post-method nil + "*Preferred method for posting USENET news. +If this variable is nil, GNUS will use the current method to decide +which method to use when posting. If it is non-nil, it will override +the current method. This method will not be used in mail groups and +the like, only in \"real\" newsgroups. + +The value must be a valid method as discussed in the documentation of +`gnus-select-method'.") + +(defvar gnus-default-nntp-server nil + "*Specify a default NNTP server. +This variable should be defined in paths.el.") + +(defvar gnus-secondary-servers nil + "*List of NNTP servers that the user can choose between interactively. +The list should contain lists, where each list contains the name of +the server. 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-nntp-service "nntp" + "NNTP service name (\"nntp\" or 119). +This is an obsolete variable, which is scarcely used. If you use an +nntp server for your newsgroup and want to change the port number +used to 899, you would say something along these lines: + +(setq gnus-select-method '(nntp "my.nntp.server" 899))") + +(defvar gnus-startup-file "~/.newsrc" + "*Your `.newsrc' file. Use `.newsrc-SERVER' instead if it exists.") + +(defvar gnus-signature-file "~/.signature" + "*Your `.signature' file.") + +(defvar gnus-init-file "~/.gnus" + "*Your Gnus elisp startup file. +If a file with the .el or .elc suffixes exist, they will be read +instead.") + +(defvar gnus-default-subscribed-newsgroups nil + "*This variable lists what newsgroups should be susbcribed the first time Gnus is used. +It should be a list of strings. +If it is `t', Gnus will not do anything special the first time it is +started; it'll just use the normal newsgroups subscription methods.") + +(defconst gnus-backup-default-subscribed-newsgroups + '("news.announce.newusers" "news.groups.questions") + "Default default new newsgroups the first time Gnus is run.") + +(defvar gnus-post-prepare-function nil + "*Function that is run after a post buffer has been prepared. +It is called with the name of the newsgroup that is posted to. It +might be use, for instance, for inserting signatures based on the +newsgroup name. (In that case, `gnus-signature-file' and +`mail-signature' should both be set to nil).") + +(defvar gnus-use-cross-reference t + "*Non-nil means that cross referenced articles will be marked as read. +If nil, ignore cross references. If t, mark articles as read in +all newsgroups.") + +(defvar gnus-use-followup-to t + "*Specifies what to do with Followup-To field. +If nil, ignore the field. If it is t, use its value, but ignore +`poster'. If it is neither nil nor t, always use the value.") + +(defvar gnus-followup-to-function nil + "*A variable that contains a function that returns a followup address. +The function will be called in the buffer of the article that is being +followed up. The buffer will be narrowed to the headers of the +article. To pick header fields, one might use `mail-fetch-field'. The +function will be called with the name of the current newsgroup as the +argument. + +Here's an example `gnus-followup-to-function': + +(setq gnus-followup-to-function + (lambda (group) + (cond ((string= group \"mail.list\") + (or (mail-fetch-field \"sender\") + (mail-fetch-field \"from\"))) + (t + (or (mail-fetch-field \"reply-to\") + (mail-fetch-field \"from\"))))))") + +(defvar gnus-reply-to-function nil + "*A variable that contains a function that returns a reply address. +See the `gnus-followup-to-function' variable for an explanation of how +this variable is used.") + +(defvar gnus-large-newsgroup 50 + "*The number of articles which indicates a large newsgroup. +If the number of articles in a newsgroup is greater than the value, +confirmation is required for selecting the newsgroup.") + +(defvar gnus-author-copy (getenv "AUTHORCOPY") + "*Name of the file the article will be saved before it is posted using the FCC: field. +Initialized from the AUTHORCOPY environment variable. + +Articles are saved using a function specified by the the variable +`gnus-author-copy-saver' (`rmail-output' is default) if a file name is +given. Instead, if the first character of the name is `|', the +contents of the article is piped out to the named program. It is +possible to save an article in an MH folder as follows: + +\(setq gnus-author-copy \"|/usr/local/lib/mh/rcvstore +Article\")") + +(defvar gnus-author-copy-saver (function rmail-output) + "*A function called with a file name to save an author copy to. +The default function is `rmail-output' which saves in Unix mailbox format.") + +(defvar gnus-use-long-file-name (not (memq system-type '(usg-unix-v xenix))) + "*Non-nil means that the default name of a file to save articles in is the newsgroup name. +If it's nil, the directory form of the newsgroup name is used instead.") + +(defvar gnus-article-save-directory (getenv "SAVEDIR") + "*Name of the directory articles will be saved in (default \"~/News\"). +Initialized from the SAVEDIR environment variable.") + +(defvar gnus-kill-files-directory (getenv "SAVEDIR") + "*Name of the directory where kill files will be stored (default \"~/News\"). +Initialized from the SAVEDIR environment variable.") + +(defvar gnus-default-article-saver (function gnus-summary-save-in-rmail) + "*A function to save articles in your favorite format. +The function must be interactively callable (in other words, it must +be an Emacs command). + +Gnus provides the following functions: + +* gnus-summary-save-in-rmail (Rmail format) +* gnus-summary-save-in-mail (Unix mail format) +* gnus-summary-save-in-folder (MH folder) +* gnus-summary-save-in-file (article format).") + +(defvar gnus-rmail-save-name (function gnus-plain-save-name) + "*A function generating a file name to save articles in Rmail format. +The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE.") + +(defvar gnus-mail-save-name (function gnus-plain-save-name) + "*A function generating a file name to save articles in Unix mail format. +The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE.") + +(defvar gnus-folder-save-name (function gnus-folder-save-name) + "*A function generating a file name to save articles in MH folder. +The function is called with NEWSGROUP, HEADERS, and optional LAST-FOLDER.") + +(defvar gnus-file-save-name (function gnus-numeric-save-name) + "*A function generating a file name to save articles in article format. +The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE.") + +(defvar gnus-kill-file-name "KILL" + "*Suffix of the kill files.") + +(defvar gnus-novice-user t + "*Non-nil means that you are a usenet novice. +If non-nil, verbose messages may be displayed and confirmations may be +required.") + +(defvar gnus-expert-user nil + "*Non-nil means that you will never be asked for confirmation about anything. +And that means *anything*.") + +(defvar gnus-keep-same-level nil + "*Non-nil means that the next newsgroup after the current will be on the same level. +When you type, for instance, `n' after reading the last article in the +current newsgroup, you will go to the next newsgroup. If this variable +is nil, the next newsgroup will be the next from the Newsgroup +buffer. If this variable is non-nil, Gnus will either put you in the +next newsgroup with the same level, or, if no such newsgroup is +available, the next newsgroup with the lowest possible level higher +than the current level.") + +(defvar gnus-gather-loose-threads t + "*Non-nil means sub-threads from a common thread will be gathered. +If the root of a thread has expired or been read in a previous +session, the information necessary to build a complete thread has been +lost. Instead of having many small sub-threads from this original thread +scattered all over the Summary buffer, Gnus will gather them. If the +`gnus-summary-make-false-root' variable is non-nil, Gnus will also +present them as one thread with a new root.") + +(defvar gnus-summary-make-false-root 'adopt + "*nil means that Gnus won't print dummy roots of threads in the summary buffer. +If `gnus-gather-loose-threads' is non-nil, Gnus will try to gather all +loose sub-threads from an original thread into one large thread. If +this variable is nil, these sub-threads will not get a common root, +but will just be presented after one another. If this variable is +`dummy', Gnus will create a dummy root that will have all the +sub-threads as children. +If this variable is `adopt', Gnus will make one of the \"children\" +the parent and mark all the step-children as such.") + +(defvar gnus-check-new-newsgroups t + "*Non-nil means that Gnus will add new newsgroups at startup. +If this variable is nil, then you have to tell Gnus explicitly to +check for new newsgroups with \\\\[gnus-find-new-newsgroups].") + +(defvar gnus-check-bogus-newsgroups nil + "*Non-nil means that Gnus will check and delete bogus newsgroup at startup. +If this variable is nil, then you have to tell Gnus explicitly to +check for bogus newsgroups with \\\\[gnus-group-check-bogus-groups].") + +(defvar gnus-read-active-file t + "*Non-nil means that Gnus will read the entire active file at startup. +If this variable is nil, Gnus will only read parts of the active file.") + +(defvar gnus-activate-foreign-newsgroups nil + "*If nil, Gnus will not check foreign newsgroups at startup. +If it is non-nil, it should be a number between one and nine. Foreign +newsgroups that have a level lower or equal to this number will be +activated on startup. For instance, if you want to active all +subscribed newsgroups, but not the rest, you'd set this variable to 5. + +If you subscribe to lots of newsgroups from different servers, startup +might take a while. By setting this variable to nil, you'll save time, +but you won't be told how many unread articles there are in the +newsgroups.") + +(defvar gnus-save-newsrc-file t + "*Non-nil means that Gnus will save a .newsrc file. +Gnus always saves its own startup file, which is called \".newsrc.el\". +The file called \".newsrc\" is in a format that can be readily +understood by other newsreaders. If you don't plan on using other +newsreaders, set this variable to nil to save some time on exit.") + +(defvar gnus-save-killed-list t + "If non-nil, save the list of killed groups to the startup file. +This will save both time (when starting and quitting) and space (on +disk), but it will also mean that Gnus has no record of what +newsgroups are new or old, so the automatic new newsgroups +subscription methods become meaningless. You should always set +`gnus-check-new-newsgroups' to nil if you set this variable to nil.") + +(defvar gnus-interactive-catchup t + "*Require your confirmation when catching up a newsgroup if non-nil.") + +(defvar gnus-interactive-post t + "*Newsgroup and subject will be asked for if non-nil.") + +(defvar gnus-interactive-exit t + "*Require your confirmation when exiting Gnus if non-nil.") + +(defvar gnus-kill-killed t + "*If non-nil, Gnus will apply kill files to already \"killed\" articles. +If it is nil, Gnus will never apply kill files to articles that have +already been through the kill process, which might very well save lots +of time.") + +(defvar gnus-user-login-name nil + "*The login name of the user. +Got from the function `user-login-name' if undefined.") + +(defvar gnus-user-full-name nil + "*The full name of the user. +Got from the NAME environment variable if undefined.") + +(defvar gnus-show-mime nil + "*Show MIME message if non-nil.") + +(defvar gnus-show-threads t + "*Show conversation threads in Summary Mode if non-nil.") + +(defvar gnus-thread-hide-subtree nil + "*Non-nil means hide thread subtrees initially. +If non-nil, you have to run the command `gnus-summary-show-thread' by +hand or by using `gnus-select-article-hook' to show hidden threads.") + +(defvar gnus-thread-hide-killed t + "*Non-nil means hide killed thread subtrees automatically.") + +(defvar gnus-thread-ignore-subject nil + "*Don't take care of subject differences, but only references if non-nil. +If it is non-nil, some commands work with subjects do not work properly.") + +(defvar gnus-thread-indent-level 4 + "*Indentation of thread subtrees.") + +;; jwz: nuke newsgroups whose name is all digits - that means that +;; some loser has let articles get into the root of the news spool, +;; which is toxic. Lines beginning with whitespace also tend to be +;; toxic. +(defvar gnus-ignored-newsgroups + (purecopy (mapconcat 'identity + '("^to\\." ; not "real" groups + "^[0-9. \t]+ " ; all digits in name + "[][\"#'();\\]" ; bogus characters + ) + "\\|")) + "*A regexp to match uninteresting newsgroups in the active file. +Any lines in the active file matching this regular expression are +removed from the newsgroup list before anything else is done to it, +thus making them effectively non-existant.") + +(defvar gnus-ignored-headers + "^Path:\\|^Posting-Version:\\|^Article-I.D.:\\|^Expires:\\|^Date-Received:\\|^References:\\|^Control:\\|^Xref:\\|^Lines:\\|^Posted:\\|^Relay-Version:\\|^Message-ID:\\|^Nf-ID:\\|^Nf-From:\\|^Approved:\\|^Sender:\\|^Received:\\|^Mail-from:" + "All header lines that match this regexp will be hidden. +Also see `gnus-visible-headers'.") + +(defvar gnus-visible-headers "^From:\\|^Newsgroups:\\|^Subject:\\|^Date:\\|Followup-To:\\|Organization:" + "All header lines that do not match this regexp will be hidden. +Also see `gnus-ignored-headers'.") + +(defvar gnus-sorted-header-list + '("^From:" "^Subject:" "^Newsgroups:" "^Date:" "^Organization:") + "This variable is a list of regular expressions. +If it is non-nil, header lines that match the regular expressions will +be placed first in the Article buffer in the sequence specified by +this list.") + +(defvar gnus-required-headers + '(From Date Newsgroups Subject Message-ID Organization Lines X-Newsreader) + ;; changed by jwz because it's not so nice to do "Lines: 0" by default. + ;; and to remove Path, since it's incorrect for Gnus to try + ;; and generate that - it is the responsibility of inews or nntpd. + "*All required fields for articles you post. +RFC977 and RFC1036 require From, Date, Newsgroups, Subject, Message-ID +and Path fields. Organization, Lines and X-Newsreader are optional. +If you want Gnus not to insert some field, remove it from this +variable.") + +(defvar gnus-show-all-headers nil + "*Show all headers of an article if non-nil.") + +(defvar gnus-save-all-headers t + "*Save all headers of an article if non-nil.") + +(defvar gnus-inhibit-startup-message nil + "The startup message will not be displayed if this function is non-nil.") + +(defvar gnus-auto-extend-newsgroup t + "*Extend visible articles to forward and backward if non-nil.") + +(defvar gnus-auto-select-first t + "*Select the first unread article automagically if non-nil. +If you want to prevent automatic selection of the first unread article +in some newsgroups, set the variable to nil in `gnus-select-group-hook' +or `gnus-apply-kill-hook'.") + +(defvar gnus-auto-select-next t + "*Select the next newsgroup automagically if non-nil. +If the value is t and the next newsgroup is empty, Gnus will exit +Summary mode and go back to Group mode. If the value is neither nil +nor t, Gnus will select the following unread newsgroup. Especially, if +the value is the symbol `quietly', the next unread newsgroup will be +selected without any confirmations.") + +(defvar gnus-auto-select-same nil + "*Select the next article with the same subject automagically if non-nil.") + +(defvar gnus-auto-center-summary t + "*Always center the current summary in Gnus Summary window if non-nil.") + +(defvar gnus-auto-mail-to-author nil + "*Insert `To: author' of the article when following up if non-nil. +Mail is sent using the function specified by the variable +`gnus-mail-send-method'.") + +(defvar gnus-break-pages t + "*Break an article into pages if non-nil. +Page delimiter is specified by the variable `gnus-page-delimiter'.") + +(defvar gnus-page-delimiter "^\^L" + "*Regexp describing line-beginnings that separate pages of news article.") + +(defvar gnus-digest-show-summary t + "*Show a summary of undigestified messages if non-nil.") + +(defvar gnus-digest-separator "^Subject:[ \t]" + "*Regexp that separates messages in a digest article.") + +(defvar gnus-use-full-window t + "*Non-nil means to take up the entire screen of Emacs.") + +(defvar gnus-window-configuration + '((summary (0 1 0)) + (newsgroups (1 0 0)) + (article (0 3 10))) + "*Specify window configurations for each action. +The format of the variable is either a list of (ACTION (G S A)), where +G, S, and A are the relative height of Group, Summary, and Article +windows, respectively, or a list of (ACTION FUNCTION), where FUNCTION +is a function that will be called with ACTION as an argument. ACTION +can be `summary', `newsgroups', or `article'.") + +(defvar gnus-show-mime-method (function metamail-buffer) + "*Function to process a MIME message. +The function is expected to process current buffer as a MIME message.") + +(defvar gnus-mail-reply-method + (function gnus-mail-reply-using-mail) + "*Function to compose reply mail. +The function `gnus-mail-reply-using-mail' uses usual sendmail mail +program. The function `gnus-mail-reply-using-mhe' uses the MH-E mail +program. You can use yet another program by customizing this variable.") + +(defvar gnus-mail-forward-method + (function gnus-mail-forward-using-mail) + "*Function to forward current message to another user. +The function `gnus-mail-reply-using-mail' uses usual sendmail mail +program. You can use yet another program by customizing this variable.") + +(defvar gnus-mail-other-window-method + (function gnus-mail-other-window-using-mail) + "*Function to compose mail in other window. +The function `gnus-mail-other-window-using-mail' uses the usual sendmail +mail program. The function `gnus-mail-other-window-using-mhe' uses the MH-E +mail program. You can use yet another program by customizing this variable.") + +(defvar gnus-mail-send-method send-mail-function + "*Function to mail a message too which is being posted as an article. +The message must have To: or Cc: field. The default is copied from +the variable `send-mail-function'.") + +(defvar gnus-subscribe-newsgroup-method + (function gnus-subscribe-zombies) + "*Function called with a newsgroup name when new newsgroup is found. +The function `gnus-subscribe-randomly' inserts a new newsgroup a the +beginning of newsgroups. The function `gnus-subscribe-alphabetically' +inserts it in strict alphabetic order. The function +`gnus-subscribe-hierarchically' inserts it in hierarchical newsgroup +order. The function `gnus-subscribe-interactively' asks for your decision.") + +;; Suggested by a bug report by Hallvard B Furuseth +;; . +(defvar gnus-subscribe-options-newsgroup-method + (function gnus-subscribe-alphabetically) + "*This function is called to subscribe newsgroups mentioned on \"options -n\" lines. +If, for instance, you want to subscribe to all newsgroups in the +\"no\" and \"alt\" hierarchies, you'd put the following in your +.newsrc file: + +options -n no.all alt.all + +Gnus will the subscribe all new newsgroups in these hierarchies with +the subscription method in this variable.") + +(defvar gnus-group-mode-hook nil + "*A hook for Gnus Group Mode.") + +(defvar gnus-summary-mode-hook nil + "*A hook for Gnus Summary Mode.") + +(defvar gnus-article-mode-hook nil + "*A hook for Gnus Article Mode.") + +(defvar gnus-kill-file-mode-hook nil + "*A hook for Gnus KILL File Mode.") + +(defvar gnus-open-server-hook nil + "*A hook called just before opening connection to news server.") + +(defvar gnus-startup-hook nil + "*A hook called at startup time. +This hook is called after Gnus is connected to the NNTP server. So, it +is possible to change the behavior of Gnus according to the selected +NNTP server.") + +(defvar gnus-group-prepare-hook nil + "*A hook called after the newsgroup list is created in the Newsgroup buffer. +If you want to modify the Newsgroup buffer, you can use this hook.") + +(defvar gnus-summary-prepare-hook nil + "*A hook called after summary list is created in the Summary buffer. +If you want to modify the Summary buffer, you can use this hook.") + +(defvar gnus-article-prepare-hook nil + "*A hook called after an article is prepared in the Article buffer. +If you want to run a special decoding program like nkf, use this hook.") + +(defvar gnus-article-display-hook '(gnus-article-hide-headers-if-wanted) + "A hook called after the article is displayed in the Article buffer. +The hook is designed to change the contents of the Article +buffer. Typical functions that this hook may contain are +`gnus-article-hide-headers' and `gnus-article-hide-signature'.") + +(defvar gnus-select-group-hook nil + "*A hook called when a newsgroup is selected. +If you want to sort Summary buffer by date and then by subject, you +can use the following hook: + + (setq gnus-select-group-hook + (list + (lambda () + ;; First of all, sort by date. + (gnus-keysort-headers + (function string-lessp) + (lambda (a) + (gnus-sortable-date (gnus-header-date a)))) + ;; Then sort by subject string ignoring `Re:'. + ;; If case-fold-search is non-nil, case of letters is ignored. + (gnus-keysort-headers + (function string-lessp) + (lambda (a) + (if case-fold-search + (downcase (gnus-simplify-subject (gnus-header-subject a) t)) + (gnus-simplify-subject (gnus-header-subject a) t))))))) + +If you'd like to simplify subjects like the +`gnus-summary-next-same-subject' command does, you can use the +following hook: + + (setq gnus-select-group-hook + (list + (lambda () + (mapcar (lambda (header) + (header-set-subject + header + (gnus-simplify-subject + (gnus-header-subject header) 're-only))) + gnus-newsgroup-headers)))) +") + +(defvar gnus-select-article-hook + '(gnus-summary-show-thread) + "*A hook called when an article is selected. +The default hook shows conversation thread subtrees of the selected +article automatically using `gnus-summary-show-thread'. + +If you'd like to run RMAIL on a digest article automagically, you can +use the following hook: + +\(setq gnus-select-article-hook + (list + (lambda () + (gnus-summary-show-thread) + (cond ((string-equal \"comp.sys.sun\" gnus-newsgroup-name) + (gnus-summary-rmail-digest)) + ((and (string-equal \"comp.text\" gnus-newsgroup-name) + (string-match \"^TeXhax Digest\" + (gnus-header-subject gnus-current-headers))) + (gnus-summary-rmail-digest) + )))))") + +(defvar gnus-select-digest-hook + (list + (lambda () + ;; Reply-To: is required by `undigestify-rmail-message'. + (or (mail-position-on-field "Reply-to" t) + (progn + (mail-position-on-field "Reply-to") + (insert (gnus-fetch-field "From")))))) + "*A hook called when reading digest messages using Rmail. +This hook can be used to modify incomplete digest articles as follows +\(this is the default): + +\(setq gnus-select-digest-hook + (list + (lambda () + ;; Reply-To: is required by `undigestify-rmail-message'. + (or (mail-position-on-field \"Reply-to\" t) + (progn + (mail-position-on-field \"Reply-to\") + (insert (gnus-fetch-field \"From\")))))))") + +(defvar gnus-rmail-digest-hook nil + "*A hook called when reading digest messages using Rmail. +This hook is intended to customize Rmail mode for reading digest articles.") + +(defvar gnus-apply-kill-hook '(gnus-apply-kill-file) + "*A hook called when a newsgroup is selected and summary list is prepared. +This hook is intended to apply a KILL file to the selected newsgroup. +The function `gnus-apply-kill-file' is called by default. + +Since a general KILL file is too heavy to use only for a few +newsgroups, I recommend you to use a lighter hook function. For +example, if you'd like to apply a KILL file to articles which contains +a string `rmgroup' in subject in newsgroup `control', you can use the +following hook: + +\(setq gnus-apply-kill-hook + (list + (lambda () + (cond ((string-match \"control\" gnus-newsgroup-name) + (gnus-kill \"Subject\" \"rmgroup\") + (gnus-expunge \"X\"))))))") + +(defvar gnus-prepare-article-hook (list (function gnus-inews-insert-signature)) + "*A hook called after preparing body, but before preparing header fields. +The default hook (`gnus-inews-insert-signature') inserts a signature +file specified by the variable `gnus-signature-file'.") + +(defvar gnus-inews-article-hook (list (function gnus-inews-do-fcc)) + "*A hook called before finally posting an article. +The default hook (`gnus-inews-do-fcc') does FCC processing (save article +to a file).") + +(defvar gnus-exit-group-hook nil + "*A hook called when exiting (not quitting) Summary mode. +If your machine is so slow that exiting from Summary mode takes very +long time, set the variable `gnus-use-cross-reference' to nil. This +inhibits marking articles as read using cross-reference information.") + +(defvar gnus-suspend-gnus-hook nil + "*A hook called when suspending (not exiting) Gnus.") + +(defvar gnus-exit-gnus-hook (list 'nntp-request-close) + "*A hook called when exiting Gnus.") + +(defvar gnus-save-newsrc-hook nil + "*A hook called when saving the newsrc file. +This hook is called before saving the `.newsrc' file.") + +(defvar gnus-auto-expirable-newsgroups nil + "*All newsgroups that match this regexp will have all read articles automatically marked as expirable.") + +(defvar gnus-subscribe-hierarchical-interactive nil + "*If non-nil, Gnus will offer to subscribe hierarchically. +When a new hierarchy appears, Gnus will ask the user: + +'alt.binaries': Do you want to subscribe to this hierarchy? ([d]ys): + +If the user pressed `d', Gnus will descend the hierarchy, `y' will +subscribe to all newsgroups in the hierarchy and `s' will skip this +hierarchy in its entirety.") + +(defvar gnus-group-line-format "%M%S%5N: %G %O %z\n" + "*Format of Newsgroups lines. +It works along the same lines as a normal formatting string, +with some simple extrensions. + +%M Only marked articles (character, \"*\" or \" \") +%S Whether the group is subscribed (character, \"U\", \"K\", \"Z\" or \" \") +%L Level of subscribedness (integer, 1-9) +%N Number of unread articles (integer) +%G Group name (string) +%D Newsgroup description (string) +%s Select method (string) +%o Moderated group (char, \"m\") +%O Moderated group (string, \"(m)\" or \"\") +%n Select from where (string) +%z A string that look like `<%s:%n>' if a foreign select method is used + +Note that this format specification is not always respected. For +reasons of efficiency, when listing killed groups, this specification +is ignored altogether. If the spec is changed considerably, your +output may end up looking strange when listing both alive and killed +groups. + +If you use %o or %O, reading the active file will be slower and quite +a bit of extra memory will be used. %D will also worsen performance. +Also note that if you change the format specification to include any +of these specs, you must probably re-start Gnus to see them go into +effect.") + +(defvar gnus-summary-line-format "%U%R%X %I%[%4L: %-20,20n%] %s\n" + "*The format specification of the lines in the Summary buffer. +The first specification must always be \"%U%R%X\", at least in this +version of Gnus. + +It works along the same lines as a normal formatting string, +with some simple extensions. + +%N Article number, left padded with spaces (integer) +%S Subject (string) +%s Subject if it is at the root of a thread, and \"\" otherwise (string) +%n Name of the poster (string) +%A Address of the poster (string) +%L Number of lines in the article (integer) +%D Date of the article (string) +%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 +%C This is the current article (character, \"+\" or \" \") +%U Status of this article (character, \"D\", \"K\", \"-\" or \" \") +%[ Opening bracket (character, \"[\" or \"=\") +%] Closing bracket (character, \"]\" or \"=\") +") + +(defconst gnus-summary-dummy-line-format "* : : %S\n" + "*The format specification for the dummy roots in the Summary buffer. +It works along the same lines as a normal formatting string, +with some simple extensions. + +%S The subject") + +(defvar gnus-summary-mode-line-format "(ding) %G/%A %Z" + "*The format specification for the Summary mode line.") + +(defvar gnus-article-mode-line-format "(ding) %G/%A %S" + "*The format specification for the Article mode line.") + +(defconst gnus-group-mode-line-format "(ding) List of Newsgroups {%M:%S}" + "*The format specification for the Newsgroup mode line.") + + + +;; Site dependent variables. You have to define these variables in +;; site-init.el, default.el or your .emacs. + +(defvar gnus-local-timezone nil + "*Local time zone. +This value is used only if `current-time-zone' does not work in your Emacs. +It specifies the GMT offset, i.e. a decimal integer +of the form +-HHMM giving the hours and minutes ahead of (i.e. east of) GMT. +For example, +0900 should be used in Japan, since it is 9 hours ahead of GMT. + +For backwards compatibility, it may also be a string like \"JST\", +but strings are obsolescent: you should use numeric offsets instead.") + +(defvar gnus-local-domain nil + "*Local domain name without a host name like: \"stars.flab.Fujitsu.CO.JP\" +The `DOMAINNAME' environment variable is used instead if defined. If +the function (system-name) returns the full internet name, there is no +need to define the name.") + +(defvar gnus-local-organization nil + "*Local organization like: \"Fujitsu Laboratories Ltd., Kawasaki, Japan.\" +The `ORGANIZATION' environment variable is used instead if defined.") + +(defvar gnus-use-generic-from nil + "*If nil, prepend local host name to the defined domain in the From: +field; if stringp, use this; if non-nil, strip of the local host name.") + +(defvar gnus-use-generic-path nil + "*If nil, use the NNTP server name in the Path: field; if stringp, +use this; if non-nil, use no host name (user name only)") + +(defvar gnus-valid-select-methods + '(("nntp" post) ("nnspool" post) ("nnvirtual" none) + ("nnmail" mail respool) ("nnml" mail respool)) + "A list of valid select methods. +Each element in this list should be a list. The first element of these +lists should be a string with the name of the select method. The +other elements may be be the category of this method (ie. `post', +`mail', `none' or whatever) or other properties that this method has +(like being respoolable). +If you implement a new select method, all you should have to change is +this variable. I think.") + +(defvar gnus-updated-mode-lines '(group article summary) + "This variable is a list of buffers that should keep their mode lines updated. +The list may contain the symbols `group', `article' and `summary'. If +the corresponding symbol is present, Gnus will keep that mode line +updated with information that may be pertinent. +If this variable is nil, screen refresh may be quicker.") + + +;; Internal variables. + +(defvar caesar-translate-table nil) + +(defvar gnus-dribble-buffer nil) + +(defvar gnus-article-reply nil) + +(defvar gnus-newsgroup-dependencies nil) + +(defconst gnus-group-edit-buffer "*Gnus edit newsgroup*") + +(defvar gnus-default-subscribe-level 2 + "Default subscription level.") + +(defvar gnus-default-unsubscribe-level 6 + "Default unsubscription level.") + +(defvar gnus-default-kill-level 9 + "Default kill level.") + +(defconst gnus-group-line-format-alist + (list (list ?M 'marked ?c) + (list ?S 'subscribed ?c) + (list ?L 'level ?d) + (list ?N 'number ?s) + (list ?G 'group ?s) + (list ?D 'newsgroup-description ?s) + (list ?o 'moderated ?c) + (list ?O 'moderated-string ?s) + (list ?s 'news-server ?s) + (list ?n 'news-method ?s) + (list ?z 'news-method-string ?s))) + +(defconst gnus-summary-line-format-alist + (list (list ?N 'number ?d) + (list ?S 'subject ?s) + (list ?s 'subject-or-nil ?s) + (list ?n 'name ?s) + (list ?A 'address ?s) + (list ?F 'from ?s) + (list ?x (macroexpand '(header-xref header)) ?s) + (list ?D (macroexpand '(header-date header)) ?s) + (list ?M (macroexpand '(header-id header)) ?s) + (list ?r (macroexpand '(header-references header)) ?s) + (list ?L 'lines ?d) + (list ?I 'indentation ?s) + (list ?T 'thread-space ?s) + (list ?C 'current ?c) + (list ?R 'replied ?c) + (list ?X 'expirable ?c) + (list ?\[ 'opening-bracket ?c) + (list ?\] 'closing-bracket ?c) + (list ?U 'unread ?c)) + "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).") + +(defconst gnus-summary-dummy-line-format-alist + (list (list ?S 'subject ?s) + (list ?N 'number ?d))) + +(defconst gnus-summary-mode-line-format-alist + (list (list ?G 'group-name ?s) + (list ?A 'article-number ?d) + (list ?Z 'unread-and-unselected ?s) + (list ?V 'gnus-version ?s) + (list ?U 'unread ?d) + (list ?S 'subject ?s) + (list ?u 'unselected ?d))) + +(defconst gnus-group-mode-line-format-alist + (list (list ?S 'news-server ?s) + (list ?M 'news-method ?s))) + +(defvar gnus-have-read-active-file nil) + +(defconst gnus-foreign-group-prefix "foreign.") + +(defconst gnus-version "(ding) Gnus v0.5" + "Version numbers of this version of Gnus.") + +(defvar gnus-info-nodes + '((gnus-group-mode "(gnus)Newsgroup Commands") + (gnus-summary-mode "(gnus)Summary Commands") + (gnus-article-mode "(gnus)Article Commands") + (gnus-kill-file-mode "(gnus)Kill File")) + "Assoc list of major modes and related Info nodes.") + +(defvar gnus-group-buffer "*Newsgroup*") +(defvar gnus-summary-buffer "*Summary*") +(defvar gnus-article-buffer "*Article*") +(defvar gnus-digest-buffer "Gnus Digest") +(defvar gnus-digest-summary-buffer "Gnus Digest-summary") + +(defvar gnus-buffer-list nil + "Gnus buffers that should be killed when exiting.") + +(defvar gnus-variable-list + '(gnus-newsrc-options + gnus-newsrc-options-n-yes gnus-newsrc-options-n-no + gnus-newsrc-assoc gnus-killed-list gnus-zombie-list) + "Gnus variables saved in the quick startup file.") + +(defvar gnus-overload-functions + '((news-inews gnus-inews-news "rnewspost") + (caesar-region gnus-caesar-region "rnews")) + "Functions overloaded by gnus. +It is a list of `(original overload &optional file)'.") + +(defvar gnus-newsrc-options nil + "Options line in the .newsrc file.") + +(defvar gnus-newsrc-options-n-yes nil + "Regexp representing subscribed newsgroups.") + +(defvar gnus-newsrc-options-n-no nil + "Regexp representing unsubscribed newsgroups.") + +(defvar gnus-newsrc-assoc nil + "Assoc list of read articles. +gnus-newsrc-hashtb should be kept so that both hold the same information.") + +(defvar gnus-newsrc-hashtb nil + "Hashtable of gnus-newsrc-assoc.") + +(defvar gnus-killed-list nil + "List of killed newsgroups.") + +(defvar gnus-killed-hashtb nil + "Hash table equivalent of gnus-killed-list.") + +(defvar gnus-zombie-list nil + "List of almost dead newsgroups.") + +(defvar gnus-description-hashtb nil + "Descriptions of newsgroups (from the file 'newsgroups').") + +(defvar gnus-list-of-killed-groups nil + "List of newsgroups that have recently been killed by the user.") + +(defvar gnus-xref-hashtb nil + "Hash table of cross-posted articles.") + +(defvar gnus-active-hashtb nil + "Hashtable of active articles.") + +(defvar gnus-moderated-list nil + "List of moderated newsgroups.") + +(defvar gnus-current-startup-file nil + "Startup file for the current host.") + +(defvar gnus-last-search-regexp nil + "Default regexp for article search command.") + +(defvar gnus-last-shell-command nil + "Default shell command on article.") + +(defvar gnus-current-select-method nil + "The current method for selecting a newsgroup.") + +(defvar gnus-have-all-newsgroups nil) + +(defvar gnus-article-internal-prepare-hook nil) + +(defvar gnus-newsgroup-name nil) +(defvar gnus-newsgroup-begin nil) +(defvar gnus-newsgroup-end nil) +(defvar gnus-newsgroup-last-rmail nil) +(defvar gnus-newsgroup-last-mail nil) +(defvar gnus-newsgroup-last-folder nil) +(defvar gnus-newsgroup-last-file nil) +(defvar gnus-newsgroup-auto-expire nil + "If non-nil, all read articles will be marked as expirable.") + +(defvar gnus-newsgroup-unreads nil + "List of unread articles in the current newsgroup.") + +(defvar gnus-newsgroup-unselected nil + "List of unselected unread articles in the current newsgroup.") + +(defvar gnus-newsgroup-marked nil + "List of ticked articles in the current newsgroup (a subset of unread art).") + +(defvar gnus-newsgroup-killed nil + "List of ranges of articles that have been through the kill process.") + +(defvar gnus-newsgroup-replied nil + "List of articles that have been replied to in the current newsgroup.") + +(defvar gnus-newsgroup-expirable nil + "List of articles in the current newsgroup that can be expired.") + +(defvar gnus-newsgroup-processable nil + "List of articles in the current newsgroup that can be processed.") + +(defvar gnus-newsgroup-bookmarks nil + "List of articles in the current newsgroup that have bookmarks.") + +(defvar gnus-newsgroup-interesting nil + "List of interesting articles in the current newsgroup.") + +(defvar gnus-newsgroup-headers nil + "List of article headers in the current newsgroup.") +(defvar gnus-newsgroup-headers-hashtb-by-number nil) + +(defvar gnus-current-article nil) +(defvar gnus-article-current nil) +(defvar gnus-current-headers nil) +(defvar gnus-have-all-headers nil "Must be either T or NIL.") +(defvar gnus-last-article nil) +(defvar gnus-current-kill-article nil) +(defvar gnus-newsgroup-interesting-subjects nil) + +;; Save window configuration. +(defvar gnus-winconf-kill-file nil) + +(defconst gnus-group-mode-map nil) +(defvar gnus-summary-mode-map nil) +(defvar gnus-article-mode-map nil) +(defvar gnus-kill-file-mode-map nil) + +;; Format specs +(defvar gnus-summary-line-format-spec nil) +(defvar gnus-summary-dummy-line-format-spec nil) +(defvar gnus-group-line-format-spec nil) +(defvar gnus-summary-mode-line-format-spec nil) +(defvar gnus-article-mode-line-format-spec nil) +(defvar gnus-group-mode-line-format-spec nil) + +(defvar gnus-reffed-article-number nil) + +(defvar rmail-default-file (expand-file-name "~/XMBOX")) +(defvar rmail-default-rmail-file (expand-file-name "~/XNEWS")) + +(defvar gnus-summary-local-variables + '(gnus-newsgroup-name + gnus-newsgroup-begin gnus-newsgroup-end gnus-newsgroup-last-rmail + gnus-newsgroup-last-mail gnus-newsgroup-last-folder + gnus-newsgroup-last-file gnus-newsgroup-auto-expire + gnus-newsgroup-unreads gnus-newsgroup-unselected gnus-newsgroup-marked + gnus-newsgroup-replied gnus-newsgroup-expirable + gnus-newsgroup-processable gnus-newsgroup-killed + gnus-newsgroup-bookmarks gnus-newsgroup-interesting + gnus-newsgroup-interesting-subjects + gnus-newsgroup-headers gnus-newsgroup-headers-hashtb-by-number + gnus-current-article gnus-current-headers gnus-have-all-headers + gnus-last-article gnus-article-internal-prepare-hook)) + +(defvar gnus-mark-article-hook + (list + (lambda () + (or (memq gnus-current-article gnus-newsgroup-marked) + (memq gnus-current-article gnus-newsgroup-interesting) + (gnus-summary-mark-as-read gnus-current-article)))) + "*A hook called when an article is selected at the first time. +The hook is intended to mark an article as read (or unread) +automatically when it is selected. + +If you'd like to tick articles instead, use the following hook: + +\(setq gnus-mark-article-hook + (list + (lambda () + (gnus-summary-tick-article gnus-current-article) + (gnus-summary-set-current-mark \"+\"))))") + +;; Define some autoload functions Gnus may use. +(eval-and-compile + (autoload 'metamail-buffer "metamail") + (autoload 'Info-goto-node "info") + + (autoload 'timezone-make-date-arpa-standard "timezone") + (autoload 'timezone-fix-time "timezone") + (autoload 'timezone-make-sortable-date "timezone") + (autoload 'timezone-make-time-string "timezone") + + (autoload 'rmail-output "rmailout" + "Append this message to Unix mail file named FILE-NAME." t) + (autoload 'mail-position-on-field "sendmail") + + (autoload 'gnus-mail-reply-using-mhe "gnus-mh") + (autoload 'gnus-mail-forward-using-mhe "gnus-mh") + (autoload 'gnus-mail-other-window-using-mhe "gnus-mh") + (autoload 'gnus-summary-save-in-folder "gnus-mh") + (autoload 'gnus-Folder-save-name "gnus-mh") + (autoload 'gnus-folder-save-name "gnus-mh")) + +(put 'gnus-group-mode 'mode-class 'special) +(put 'gnus-summary-mode 'mode-class 'special) +(put 'gnus-article-mode 'mode-class 'special) + +(autoload 'gnus-uu-ctl-map "gnus-uu" nil nil 'keymap) + + +;; Fix by Hallvard B Furuseth . +(defun gnus-summary-position-cursor () nil) +(defun gnus-group-position-cursor () nil) +(fset 'gnus-summary-position-cursor 'gnus-goto-colon) +(fset 'gnus-group-position-cursor 'gnus-goto-colon) + +(defmacro gnus-eval-in-buffer-window (buffer &rest forms) + "Pop to BUFFER, evaluate FORMS, and then returns to original window." + (` (let ((GnusStartBufferWindow (selected-window))) + (unwind-protect + (progn + (pop-to-buffer (, buffer)) + (,@ forms)) + (select-window GnusStartBufferWindow))))) + +(defun gnus-make-hashtable (&optional hashsize) + "Make a hash table (default and minimum size is 255). +Optional argument HASHSIZE specifies the table size." + (make-vector (if hashsize + (max (gnus-create-hash-size hashsize) 255) + 255) 0)) + +(defmacro gnus-gethash (string hashtable) + "Get hash value of STRING in HASHTABLE." + ;;(` (symbol-value (abbrev-symbol (, string) (, hashtable)))) + ;;(` (abbrev-expansion (, string) (, hashtable))) + (` (symbol-value (intern-soft (, string) (, hashtable))))) + +(defmacro gnus-sethash (string value hashtable) + "Set hash value. Arguments are STRING, VALUE, and HASHTABLE." + ;; We cannot use define-abbrev since it only accepts string as value. +; (set (intern string hashtable) value)) + (` (set (intern (, string) (, hashtable)) (, value)))) + +(defsubst gnus-buffer-substring (beg end) + (buffer-substring (match-beginning beg) (match-end end))) + +(defsubst gnus-simplify-subject-re (subject) + "Remove \"Re:\" from subject lines." + (if (string-match "^[Rr][Ee]:[ \t]*" subject) + (substring subject (match-end 0)) + subject)) + + +;;; +;;; Gnus Utility Functions +;;; + +(defsubst gnus-extract-address-components (from) + (let (name address) + (if (string-match "([^)]+)" from) + (setq name (substring from (1+ (match-beginning 0)) + (1- (match-end 0))))) + (if (string-match "\\b[^@ \t<>]+@[^@ \t<>]+\\b" from) + (setq address (substring from (match-beginning 0) (match-end 0)))) + (if (and (not name) address) + (if (string-match (concat "<" address ">") from) + (setq name (substring from 0 (1- (match-beginning 0)))))) + (cons (or name from) (or address from)))) + +(defun gnus-fetch-field (field) + "Return the value of the header FIELD of current article." + (save-excursion + (save-restriction + (gnus-narrow-to-headers) + (mail-fetch-field field)))) + +(defun gnus-goto-colon () + (beginning-of-line) + (search-forward ":" (save-excursion (end-of-line) (point)) t)) + +(defun gnus-prefs-p (&rest values) + (< 0 + (apply '+ (mapcar + (lambda (v) + (if (consp v) + (* (cdr v) + (or (car v) + (cdr (assq (car v) gnus-user-preferences)) + ;; Check if the user said (novice) + ;; instead of (novice . 100) + (if (memq (car v) gnus-user-preferences) 100) + (cdr (assq (car v) gnus-default-preferences)) + 0)) + v)) + values)))) + +(defun gnus-narrow-to-headers () + (widen) + (save-excursion + (goto-char 1) + (if (search-forward "\n\n") + (narrow-to-region 1 (1- (point)))))) + +;; Get a number that is suitable for hashing; bigger than MIN +(defun gnus-create-hash-size (min) + (let ((i 1)) + (while (< i min) + (setq i (* 2 i))) + (1- i))) + +(defun gnus-update-format-specifications () + (setq gnus-summary-line-format-spec + (gnus-parse-format gnus-summary-line-format + gnus-summary-line-format-alist)) + (setq gnus-summary-dummy-line-format-spec + (gnus-parse-format gnus-summary-dummy-line-format + gnus-summary-dummy-line-format-alist)) + (if (and (memq 'newsgroup-description + (cdr (cdr (setq gnus-group-line-format-spec + (gnus-parse-format + gnus-group-line-format + gnus-group-line-format-alist))))) + (not gnus-description-hashtb)) + (gnus-read-descriptions-file)) + (setq gnus-summary-mode-line-format-spec + (gnus-parse-format gnus-summary-mode-line-format + gnus-summary-mode-line-format-alist)) + (setq gnus-article-mode-line-format-spec + (gnus-parse-format gnus-article-mode-line-format + gnus-summary-mode-line-format-alist)) + (setq gnus-group-mode-line-format-spec + (gnus-parse-format gnus-group-mode-line-format + gnus-group-mode-line-format-alist))) + +(defun gnus-format-max-width (var length) + (let (result) + (if (> (length (setq result (eval var))) length) + (format "%s" (substring result 0 length)) + (format "%s" result)))) + +(defun gnus-parse-format (format spec-alist) +;; This function parses the FORMAT string with the help of the +;; SPEC-ALIST and returns a list that can be eval'ed to return the +;; string. The list will consist of the symbol `format', a format +;; specification string, and a list of forms depending on the +;; SPEC-ALIST. + (let ((max-width 0) + spec flist fstring b newspec max-width elem beg) + (save-excursion + (set-buffer (get-buffer-create "*gnus work*")) + (buffer-disable-undo (current-buffer)) + (gnus-add-current-to-buffer-list) + (erase-buffer) + (insert format) + (goto-char 1) + (while (re-search-forward "%[-0-9]*\\(,[0-9]*\\)*\\(.\\)" nil t) + (setq spec (string-to-char (buffer-substring (match-beginning 2) + (match-end 2)))) + ;; First check if there are any specs that look anything like + ;; "%12,12A", ie. with a "max width specification". These have + ;; to be treated specially. + (if (setq beg (match-beginning 1)) + (setq max-width + (string-to-int + (buffer-substring (1+ (match-beginning 1)) (match-end 1)))) + (setq max-width 0) + (setq beg (match-beginning 2))) + ;; Find the specification from `spec-alist'. + (if (not (setq elem (cdr (assq spec spec-alist)))) + (setq elem '("*" ?s))) + (if (not (= max-width 0)) + (progn + (setq flist (cons (list 'gnus-format-max-width + (car elem) max-width) flist)) + (setq newspec ?s)) + (setq flist (cons (car elem) flist)) + (setq newspec (car (cdr elem)))) + ;; Remove the old specification (and possibly a ",12" string). + (delete-region beg (match-end 2)) + ;; Insert the new specification. + (goto-char beg) + (insert newspec)) + (setq fstring (buffer-substring 1 (point-max))) + (kill-buffer (current-buffer))) + (cons 'format (cons fstring (nreverse flist))))) + +;; Suggested by Brian Edmonds . +(defun gnus-read-init-file () + (if (and gnus-init-file + (file-exists-p gnus-init-file)) + (load gnus-init-file nil t))) + +;; Article file names when saving. + +(defun gnus-Numeric-save-name (newsgroup headers &optional last-file) + "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE. +If variable `gnus-use-long-file-name' is nil, it is ~/News/News.group/num. +Otherwise, it is like ~/News/news/group/num." + (let ((default + (expand-file-name + (concat (if gnus-use-long-file-name + (gnus-capitalize-newsgroup newsgroup) + (gnus-newsgroup-directory-form newsgroup)) + "/" (int-to-string (header-number headers))) + (or gnus-article-save-directory "~/News")))) + (if (and last-file + (string-equal (file-name-directory default) + (file-name-directory last-file)) + (string-match "^[0-9]+$" (file-name-nondirectory last-file))) + default + (or last-file default)))) + +(defun gnus-numeric-save-name (newsgroup headers &optional last-file) + "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE. +If variable `gnus-use-long-file-name' is nil, it is ~/News/news.group/num. +Otherwise, it is like ~/News/news/group/num." + (let ((default + (expand-file-name + (concat (if gnus-use-long-file-name + newsgroup + (gnus-newsgroup-directory-form newsgroup)) + "/" (int-to-string (header-number headers))) + (or gnus-article-save-directory "~/News")))) + (if (and last-file + (string-equal (file-name-directory default) + (file-name-directory last-file)) + (string-match "^[0-9]+$" (file-name-nondirectory last-file))) + default + (or last-file default)))) + +(defun gnus-Plain-save-name (newsgroup headers &optional last-file) + "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE. +If variable `gnus-use-long-file-name' is nil, it is ~/News/News.group. +Otherwise, it is like ~/News/news/group/news." + (or last-file + (expand-file-name + (if gnus-use-long-file-name + (gnus-capitalize-newsgroup newsgroup) + (concat (gnus-newsgroup-directory-form newsgroup) "/news")) + (or gnus-article-save-directory "~/News")))) + +(defun gnus-plain-save-name (newsgroup headers &optional last-file) + "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE. +If variable `gnus-use-long-file-name' is nil, it is ~/News/news.group. +Otherwise, it is like ~/News/news/group/news." + (or last-file + (expand-file-name + (if gnus-use-long-file-name + newsgroup + (concat (gnus-newsgroup-directory-form newsgroup) "/news")) + (or gnus-article-save-directory "~/News")))) + +;; For subscribing new newsgroup + +(defun gnus-subscribe-hierarchical-interactive (groups) + (let ((groups (sort groups 'string<)) + prefixes prefix start rest ans group starts) + (while groups + (setq prefixes (list "^")) + (while (and groups prefixes) + (while (not (string-match (car prefixes) (car groups))) + (setq prefixes (cdr prefixes))) + (setq prefix (car prefixes)) + (setq start (1- (length prefix))) + (if (and (string-match "[^\\.]\\." (car groups) start) + (cdr groups) + (setq prefix + (concat "^" (substring (car groups) 0 (match-end 0)))) + (string-match prefix (car (cdr groups)))) + (progn + (setq prefixes (cons prefix prefixes)) + (message "Descend hierarchy %s'? ([y]nsq): " + (substring prefix 1 (1- (length prefix)))) + (setq ans (read-char)) + (cond ((= ans ?n) + (while (and groups + (string-match prefix + (setq group (car groups)))) + (setq gnus-killed-list + (cons group gnus-killed-list)) + (gnus-sethash group group gnus-killed-hashtb) + (setq groups (cdr groups))) + (setq starts (cdr starts))) + ((= ans ?s) + (while (and groups + (string-match prefix + (setq group (car groups)))) + (gnus-sethash group group gnus-killed-hashtb) + (funcall gnus-subscribe-newsgroup-method + (car groups)) + (setq groups (cdr groups))) + (setq starts (cdr starts))) + ((= ans ?q) + (while groups + (setq group (car groups)) + (setq gnus-killed-list (cons group gnus-killed-list)) + (gnus-sethash group group gnus-killed-hashtb) + (setq groups (cdr groups)))) + (t nil))) + (message "Subscribe '%s'? ([n]yq)" (car groups)) + (setq ans (read-char)) + (cond ((= ans ?y) + (funcall gnus-subscribe-newsgroup-method (car groups)) + (gnus-sethash group group gnus-killed-hashtb)) + ((= ans ?q) + (while groups + (setq group (car groups)) + (setq gnus-killed-list (cons group gnus-killed-list)) + (gnus-sethash group group gnus-killed-hashtb) + (setq groups (cdr groups)))) + (t + (setq gnus-killed-list (cons group gnus-killed-list)) + (gnus-sethash group group gnus-killed-hashtb))) + (setq groups (cdr groups))))))) + +(defun gnus-subscribe-randomly (newsgroup) + "Subscribe new NEWSGROUP by making it the first newsgroup." + (gnus-subscribe-newsgroup newsgroup)) + +(defun gnus-subscribe-alphabetically (newgroup) + "Subscribe new NEWSGROUP and insert it in alphabetical order." + ;; Basic ideas by mike-w@cs.aukuni.ac.nz (Mike Williams) + (let ((groups (cdr gnus-newsrc-assoc)) + before) + (while (and (not before) groups) + (if (string< newgroup (car (car groups))) + (setq before (car (car groups))) + (setq groups (cdr groups)))) + (gnus-subscribe-newsgroup newgroup before))) + +(defun gnus-subscribe-hierarchically (newgroup) + "Subscribe new NEWSGROUP and insert it in hierarchical newsgroup order." + ;; Basic ideas by mike-w@cs.aukuni.ac.nz (Mike Williams) + (save-excursion + (set-buffer (find-file-noselect gnus-current-startup-file)) + (let ((groupkey newgroup) + before) + (while (and (not before) groupkey) + (goto-char (point-min)) + (let ((groupkey-re + (concat "^\\(" (regexp-quote groupkey) ".*\\)[!:]"))) + (while (and (re-search-forward groupkey-re nil t) + (progn + (setq before (buffer-substring + (match-beginning 1) (match-end 1))) + (string< before newgroup))))) + ;; Remove tail of newsgroup name (eg. a.b.c -> a.b) + (setq groupkey + (if (string-match "^\\(.*\\)\\.[^.]+$" groupkey) + (substring groupkey (match-beginning 1) (match-end 1))))) + (gnus-subscribe-newsgroup newgroup before)))) + +(defun gnus-subscribe-interactively (newsgroup) + "Subscribe new NEWSGROUP interactively. +It is inserted in hierarchical newsgroup order if subscribed. If not, +it is killed." + (if (y-or-n-p (format "Subscribe new newsgroup: %s " newsgroup)) + (gnus-subscribe-hierarchically newsgroup) + (setq gnus-killed-list (cons newsgroup gnus-killed-list)))) + +(defun gnus-subscribe-zombies (newsgroup) + "Make new NEWSGROUP a zombie group." + (setq gnus-zombie-list (cons newsgroup gnus-zombie-list))) + +(defun gnus-subscribe-newsgroup (newsgroup &optional next) + "Subscribe new NEWSGROUP. +If NEXT is non-nil, it is inserted before NEXT. Otherwise it is made +the first newsgroup." + ;; We subscribe the group by changing its level to 3. + (gnus-group-change-level + newsgroup 3 9 + (if next (gnus-gethash next gnus-newsrc-hashtb) + (gnus-gethash (car (nth 1 gnus-newsrc-assoc)) gnus-newsrc-hashtb))) + (message "Subscribe newsgroup: %s" newsgroup)) + +;; For directories + +(defun gnus-newsgroup-directory-form (newsgroup) + "Make hierarchical directory name from NEWSGROUP name." + (let ((newsgroup (substring newsgroup 0)) ;Copy string. + (len (length newsgroup)) + (idx 0)) + ;; Replace all occurrences of `.' with `/'. + (while (< idx len) + (if (= (aref newsgroup idx) ?.) + (aset newsgroup idx ?/)) + (setq idx (1+ idx))) + newsgroup + )) + +(defun gnus-make-directory (directory) + "Make DIRECTORY recursively." + (let ((directory (expand-file-name directory default-directory))) + (or (file-exists-p directory) + (gnus-make-directory-1 "" directory)) + )) + +(defun gnus-make-directory-1 (head tail) + (cond ((string-match "^/\\([^/]+\\)" tail) + ;; ange-ftp interferes with calling match-* after + ;; calling file-name-as-directory. + (let ((beg (match-beginning 1)) + (end (match-end 1))) + (setq head (concat (file-name-as-directory head) + (substring tail beg end))) + (or (file-exists-p head) + (call-process "mkdir" nil nil nil head)) + (gnus-make-directory-1 head (substring tail end)))) + ((string-equal tail "") t) + )) + +(defun gnus-capitalize-newsgroup (newsgroup) + "Capitalize NEWSGROUP name with treating '.' and '-' as part of words." + ;; Suggested by "Jonathan I. Kamens" . + (let ((current-syntax-table (syntax-table))) + (unwind-protect + (progn + (set-syntax-table (copy-syntax-table current-syntax-table)) + (modify-syntax-entry ?- "w") + (modify-syntax-entry ?. "w") + (capitalize newsgroup)) + (set-syntax-table current-syntax-table)))) + +;; Var + +(defun gnus-simplify-subject (subject &optional re-only) + "Remove `Re:' and words in parentheses. +If optional argument RE-ONLY is non-nil, strip `Re:' only." + (let ((case-fold-search t)) ;Ignore case. + ;; Remove `Re:' and `Re^N:'. + (if (string-match "^re:[ \t]*" subject) + (setq subject (substring subject (match-end 0)))) + ;; Remove words in parentheses from end. + (or re-only + (while (string-match "[ \t\n]*([^()]*)[ \t\n]*\\'" subject) + (setq subject (substring subject 0 (match-beginning 0))))) + ;; Return subject string. + subject + )) + +(defun gnus-add-current-to-buffer-list () + (setq gnus-buffer-list (cons (current-buffer) gnus-buffer-list))) + +;; Functions accessing headers. +;; Functions are more convenient than macros in some case. + +(defun gnus-header-number (header) + "Return article number in HEADER." + (header-number header)) + +(defun gnus-header-subject (header) + "Return subject string in HEADER." + (header-subject header)) + +(defun gnus-header-from (header) + "Return author string in HEADER." + (header-from header)) + +(defun gnus-header-xref (header) + "Return xref string in HEADER." + (header-xref header)) + +(defun gnus-header-lines (header) + "Return lines in HEADER." + (header-lines header)) + +(defun gnus-header-date (header) + "Return date in HEADER." + (header-date header)) + +(defun gnus-header-id (header) + "Return Id in HEADER." + (header-id header)) + +(defun gnus-header-references (header) + "Return references in HEADER." + (header-references header)) + +(defun gnus-clear-system () + "Clear all variables and buffers." + ;; Clear Gnus variables. + (let ((variables gnus-variable-list)) + (while variables + (set (car variables) nil) + (setq variables (cdr variables)))) + ;; Clear other internal variables. + (setq gnus-list-of-killed-groups nil + gnus-have-read-active-file nil + gnus-newsrc-assoc nil + gnus-newsrc-hashtb nil + gnus-killed-list nil + gnus-zombie-list nil + gnus-killed-hashtb nil + gnus-active-hashtb nil + gnus-moderated-list nil + gnus-use-moderated nil + gnus-description-hashtb nil + gnus-newsgroup-headers nil + gnus-newsgroup-headers-hashtb-by-number nil + gnus-current-select-method nil) + ;; Kill the startup file. + (and gnus-current-startup-file + (get-file-buffer gnus-current-startup-file) + (kill-buffer (get-file-buffer gnus-current-startup-file))) + (setq gnus-current-startup-file nil) + (gnus-dribble-clear) + ;; Kill Gnus buffers. + (while gnus-buffer-list + (if (and (get-buffer (car gnus-buffer-list)) + (buffer-name (get-buffer (car gnus-buffer-list)))) + (kill-buffer (car gnus-buffer-list))) + (setq gnus-buffer-list (cdr gnus-buffer-list)))) + +(defun gnus-configure-windows (action &optional force) + "Configure Gnus windows according to the next ACTION. +The ACTION is either a symbol, such as `summary', or a +configuration list such as `(1 1 2)'. If ACTION is not a list, +configuration list is got from the variable gnus-window-configuration. +If FORCE is non-nil, the updating will be done whether it is necessary +or not." + (let* ((windows + (if (listp action) action + (if (listp gnus-window-configuration) + (car (cdr (assq action gnus-window-configuration))) + gnus-window-configuration))) + (grpwin (get-buffer-window gnus-group-buffer)) + (subwin (get-buffer-window gnus-summary-buffer)) + (artwin (get-buffer-window gnus-article-buffer)) + (winsum nil) + (height nil) + (grpheight 0) + (subheight 0) + (artheight 0)) + (if (and (symbolp windows) (fboundp windows)) + (funcall windows action) + (if (and (not force) + (or (null windows) ;No configuration is specified. + (and (eq (null grpwin) + (zerop (nth 0 windows))) + (eq (null subwin) + (zerop (nth 1 windows))) + (eq (null artwin) + (zerop (nth 2 windows)))))) + ;; No need to change window configuration. + nil + (select-window (or grpwin subwin artwin (selected-window))) + ;; First of all, compute the height of each window. + (cond (gnus-use-full-window + ;; Take up the entire screen. + (delete-other-windows) + (setq height (window-height (selected-window)))) + (t + (setq height (+ (if grpwin (window-height grpwin) 0) + (if subwin (window-height subwin) 0) + (if artwin (window-height artwin) 0))))) + ;; The Newsgroup buffer exits always. So, use it to extend the + ;; Group window so as to get enough window space. + (switch-to-buffer gnus-group-buffer 'norecord) + (and (get-buffer gnus-summary-buffer) + (delete-windows-on gnus-summary-buffer)) + (and (get-buffer gnus-article-buffer) + (delete-windows-on gnus-article-buffer)) + ;; Compute expected window height. + (setq winsum (apply (function +) windows)) + (if (not (zerop (nth 0 windows))) + (setq grpheight (max window-min-height + (/ (* height (nth 0 windows)) winsum)))) + (if (not (zerop (nth 1 windows))) + (setq subheight (max window-min-height + (/ (* height (nth 1 windows)) winsum)))) + (if (not (zerop (nth 2 windows))) + (setq artheight (max window-min-height + (/ (* height (nth 2 windows)) winsum)))) + (setq height (+ grpheight subheight artheight)) + (enlarge-window (max 0 (- height (window-height (selected-window))))) + ;; Then split the window. + (and (not (zerop artheight)) + (or (not (zerop grpheight)) + (not (zerop subheight))) + (split-window-vertically (+ grpheight subheight))) + (and (not (zerop grpheight)) + (not (zerop subheight)) + (split-window-vertically grpheight)) + ;; Then select buffers in each window. + (and (not (zerop grpheight)) + (progn + (switch-to-buffer gnus-group-buffer 'norecord) + (other-window 1))) + (and (not (zerop subheight)) + (progn + (switch-to-buffer gnus-summary-buffer 'norecord) + (other-window 1))) + (and (not (zerop artheight)) + (progn + ;; If Article buffer does not exist, it will be created + ;; and initialized. + (gnus-article-setup-buffer) + (switch-to-buffer gnus-article-buffer 'norecord))))) + )) + +(defun gnus-window-configuration-split (action) + (switch-to-buffer gnus-group-buffer t) + (delete-other-windows) + (split-window-horizontally) + (cond ((or (eq action 'newsgroup) (eq action 'summary)) + (if (and (get-buffer gnus-summary-buffer) + (buffer-name gnus-summary-buffer)) + (switch-to-buffer-other-window gnus-summary-buffer))) + ((eq action 'article) + (switch-to-buffer gnus-summary-buffer t) + (other-window 1) + (gnus-article-setup-buffer) + (switch-to-buffer gnus-article-buffer t)))) + +(defun gnus-version () + "Version numbers of this version of Gnus." + (interactive) + (let ((methods gnus-valid-select-methods) + (mess gnus-version) + meth) + ;; Go through all the legal select methods and add their version + ;; numbers to the total version string. Only the backends that are + ;; currently in use will have their message numbers taken into + ;; consideration. + (while methods + (setq meth (intern (concat (car (car methods)) "-version"))) + (and (boundp meth) + (stringp (symbol-value meth)) + (setq mess (concat mess "; " (symbol-value meth)))) + (setq methods (cdr methods))) + (message mess))) + +(defun gnus-info-find-node () + "Find Info documentation of Gnus." + (interactive) + ;; Enlarge info window if needed. + (cond ((eq major-mode 'gnus-group-mode) + (gnus-configure-windows '(1 0 0)) ;Take all windows. + (pop-to-buffer gnus-group-buffer)) + ((eq major-mode 'gnus-summary-mode) + (gnus-configure-windows '(0 1 0)) ;Take all windows. + (pop-to-buffer gnus-summary-buffer))) + (Info-goto-node (car (cdr (assq major-mode gnus-info-nodes))))) + +(defun gnus-overload-functions (&optional overloads) + "Overload functions specified by optional argument OVERLOADS. +If nothing is specified, use the variable gnus-overload-functions." + (let ((defs nil) + (overloads (or overloads gnus-overload-functions))) + (while overloads + (setq defs (car overloads)) + (setq overloads (cdr overloads)) + ;; Load file before overloading function if necessary. Make + ;; sure we cannot use `require' always. + (and (not (fboundp (car defs))) + (car (cdr (cdr defs))) + (load (car (cdr (cdr defs))) nil 'nomessage)) + (fset (car defs) (car (cdr defs))) + ))) + +;; List and range functions + +(defun gnus-last-element (list) + "Return last element of LIST." + (while (cdr list) + (setq list (cdr list))) + (car list)) + +(defun gnus-set-difference (list1 list2) + "Return a list of elements of LIST1 that do not appear in LIST2." + (let ((list1 (copy-sequence list1))) + (while list2 + (setq list1 (delq (car list2) list1)) + (setq list2 (cdr list2))) + list1 + )) + +(defun gnus-intersection (list1 list2) + (let ((result nil)) + (while list2 + (if (memq (car list2) list1) + (setq result (cons (car list2) result))) + (setq list2 (cdr list2))) + result + )) + +(defun gnus-compress-sequence (numbers &optional always-list) + "Convert list of numbers to a list of ranges or a single range. +If ALWAYS-LIST is non-nil, this function will always release a list of +ranges." + (let* ((numbers (sort numbers (function <))) + (first (car numbers)) + (last (car numbers)) + result) + (while numbers + (cond ((= last (car numbers)) nil) ;Omit duplicated number + ((= (1+ last) (car numbers)) ;Still in sequence + (setq last (car numbers))) + (t ;End of one sequence + (setq result (cons (cons first last) result)) + (setq first (car numbers)) + (setq last (car numbers)))) + (setq numbers (cdr numbers))) + (if (and (not always-list) (null result)) + (cons first last) + (nreverse (cons (cons first last) result))))) + +(defun gnus-uncompress-sequence (ranges) + "Expand a list of ranges into a list of numbers. +RANGES is either a single range on the form `(num . num)' or a list of +these ranges." + (let (first last result) + (if (atom (car ranges)) + (progn + (setq first (car ranges)) + (setq last (cdr ranges)) + (while (<= first last) + (setq result (cons first result)) + (setq first (1+ first)))) + (while ranges + (setq first (car (car ranges))) + (setq last (cdr (car ranges))) + (while (<= first last) + (setq result (cons first result)) + (setq first (1+ first))) + (setq ranges (cdr ranges)))) + (nreverse result))) + +(defun gnus-add-to-range (ranges list) + "Return a list of ranges that has all articles from both RANGES and LIST. +Note: LIST has to be sorted over `<'." + (let* ((ranges (if (and ranges (atom (car ranges))) (list ranges) ranges)) + (inrange ranges) + range nranges first last) + (if (not ranges) + (gnus-compress-sequence list t) + (while (and ranges list) + (setq range (car ranges)) + (while (and list (<= (car list) (cdr range))) + (setq list (cdr list))) + (while (and list (= (1- (car list)) (cdr range))) + (setcdr range (car list)) + (setq list (cdr list))) + (if (and list (and (> (car list) (cdr range)) (cdr ranges) + (< (car list) (car (car (cdr ranges)))))) + (setcdr ranges (cons (cons (car list) (car list)) (cdr ranges)))) + (setq ranges (cdr ranges))) + (if (and list (not ranges)) + (setq inrange (nconc inrange (gnus-compress-sequence list t)))) + (setq ranges inrange) + (while ranges + (if (and (cdr ranges) (>= (1+ (cdr (car ranges))) + (car (car (cdr ranges))))) + (progn + (setcdr (car ranges) (cdr (car (cdr ranges)))) + (setcdr ranges (cdr (cdr ranges)))) + (setq ranges (cdr ranges)))) + (if (not (cdr inrange)) + (car inrange) + inrange)))) + +(defun gnus-member-of-range (number ranges) + (let ((not-stop t)) + (while (and ranges not-stop) + (if (and (>= number (car (car ranges))) + (<= number (cdr (car ranges)))) + (setq not-stop nil)) + (setq ranges (cdr ranges))) + (not not-stop))) + + +;;; +;;; Gnus Group Mode +;;; + +(if gnus-group-mode-map + nil + (setq gnus-group-mode-map (make-keymap)) + (suppress-keymap gnus-group-mode-map) + (define-key gnus-group-mode-map " " 'gnus-group-read-group) + (define-key gnus-group-mode-map "=" 'gnus-group-select-group) + (define-key gnus-group-mode-map "j" 'gnus-group-jump-to-group) + (define-key gnus-group-mode-map "n" 'gnus-group-next-unread-group) + (define-key gnus-group-mode-map "p" 'gnus-group-prev-unread-group) + (define-key gnus-group-mode-map [del] 'gnus-group-prev-unread-group) + (define-key gnus-group-mode-map "N" 'gnus-group-next-group) + (define-key gnus-group-mode-map "P" 'gnus-group-prev-group) + (define-key gnus-group-mode-map "\M-n" 'gnus-group-next-unread-group-same-level) + (define-key gnus-group-mode-map "\M-p" 'gnus-group-prev-unread-group-same-level) + (define-key gnus-group-mode-map "\r" 'gnus-group-select-group) + (define-key gnus-group-mode-map "u" 'gnus-group-unsubscribe-current-group) + (define-key gnus-group-mode-map "U" 'gnus-group-unsubscribe-group) + (define-key gnus-group-mode-map "c" 'gnus-group-catchup-current) + (define-key gnus-group-mode-map "C" 'gnus-group-catchup-current-all) + (define-key gnus-group-mode-map "l" 'gnus-group-list-groups) + (define-key gnus-group-mode-map "L" 'gnus-group-list-all-groups) + (define-key gnus-group-mode-map "m" 'gnus-group-mail) + (define-key gnus-group-mode-map "g" 'gnus-group-get-new-news) + (define-key gnus-group-mode-map "\M-g" 'gnus-group-get-new-news-this-group) + (define-key gnus-group-mode-map "R" 'gnus-group-restart) + (define-key gnus-group-mode-map "r" 'gnus-group-read-init-file) + (define-key gnus-group-mode-map "B" 'gnus-group-browse-foreign-server) + (define-key gnus-group-mode-map "b" 'gnus-group-check-bogus-groups) + (define-key gnus-group-mode-map "F" 'gnus-find-new-newsgroups) + (define-key gnus-group-mode-map "D" 'gnus-group-describe-group) + (define-key gnus-group-mode-map "\M-d" 'gnus-group-describe-all-groups) + (define-key gnus-group-mode-map "a" 'gnus-group-post-news) + (define-key gnus-group-mode-map "\M-a" 'gnus-group-add-newsgroup) + (define-key gnus-group-mode-map "\M-e" 'gnus-group-edit-newsgroup) + (define-key gnus-group-mode-map "\ek" 'gnus-group-edit-local-kill) + (define-key gnus-group-mode-map "\eK" 'gnus-group-edit-global-kill) + (define-key gnus-group-mode-map "k" 'gnus-group-kill-group) + (define-key gnus-group-mode-map "\C-k" 'gnus-group-kill-group) + (define-key gnus-group-mode-map "y" 'gnus-group-yank-group) + (define-key gnus-group-mode-map "\C-y" 'gnus-group-yank-group) + (define-key gnus-group-mode-map "\C-w" 'gnus-group-kill-region) + (define-key gnus-group-mode-map "\M-z" 'gnus-group-kill-all-zombies) + (define-key gnus-group-mode-map "\C-x\C-t" 'gnus-group-transpose-groups) + (define-key gnus-group-mode-map "\C-c\C-l" 'gnus-group-list-killed) + (define-key gnus-group-mode-map "\C-c\C-k" 'gnus-group-list-killed) + (define-key gnus-group-mode-map "\C-c\C-z" 'gnus-group-list-zombies) + (define-key gnus-group-mode-map "\C-c\C-x" 'gnus-group-expire-articles) + (define-key gnus-group-mode-map "\C-c\M-\C-x" 'gnus-group-expire-all-groups) + (define-key gnus-group-mode-map "V" 'gnus-version) + (define-key gnus-group-mode-map "S" 'gnus-group-set-current-level) + (define-key gnus-group-mode-map "s" 'gnus-group-save-newsrc) + (define-key gnus-group-mode-map "z" 'gnus-group-suspend) + (define-key gnus-group-mode-map "Z" 'gnus-group-clear-dribble) + (define-key gnus-group-mode-map "q" 'gnus-group-exit) + (define-key gnus-group-mode-map "Q" 'gnus-group-quit) + (define-key gnus-group-mode-map "?" 'gnus-group-describe-briefly) + (define-key gnus-group-mode-map "\C-c\C-i" 'gnus-info-find-node) + (define-key gnus-group-mode-map [mouse-2] 'gnus-mouse-pick-group) + + ;; Make a menu bar item. + (define-key gnus-group-mode-map [menu-bar Gnus] + (cons "Gnus" (make-sparse-keymap "Gnus"))) + + (define-key gnus-group-mode-map [menu-bar Gnus force-update] + '("Force Update" . gnus-group-force-update)) + (define-key gnus-group-mode-map [menu-bar Gnus quit] + '("Quit" . gnus-group-quit)) + (define-key gnus-group-mode-map [menu-bar Gnus exit] + '("Exit" . gnus-group-exit)) + (define-key gnus-group-mode-map [menu-bar Gnus restart] + '("Restart" . gnus-group-restart)) + (define-key gnus-group-mode-map [menu-bar Gnus suspend] + '("Suspend" . gnus-group-suspend)) + (define-key gnus-group-mode-map [menu-bar Gnus get-new-news] + '("Get New News" . gnus-group-get-new-news)) + + ;; Make a menu bar item. + (define-key gnus-group-mode-map [menu-bar groups] + (cons "Groups" (make-sparse-keymap "Groups"))) + + (define-key gnus-group-mode-map [menu-bar groups catchup] + '("Catchup" . gnus-group-catchup)) + (define-key gnus-group-mode-map [menu-bar groups edit-global-kill] + '("Edit Kill File" . gnus-group-edit-global-kill)) + + (define-key gnus-group-mode-map [menu-bar groups separator-2] + '("--")) + + (define-key gnus-group-mode-map [menu-bar groups yank-group] + '("Yank Group" . gnus-group-yank-group)) + (define-key gnus-group-mode-map [menu-bar groups kill-group] + '("Kill Group" . gnus-group-kill-group)) + + (define-key gnus-group-mode-map [menu-bar groups separator-1] + '("--")) + + (define-key gnus-group-mode-map [menu-bar groups jump-to-group] + '("Jump to Group..." . gnus-group-jump-to-group)) + (define-key gnus-group-mode-map [menu-bar groups list-all-groups] + '("List All Groups" . gnus-group-list-all-groups)) + (define-key gnus-group-mode-map [menu-bar groups list-groups] + '("List Groups" . gnus-group-list-groups)) + (define-key gnus-group-mode-map [menu-bar groups unsub-current-group] + '("Unsubscribe Group" . gnus-group-unsubscribe-current-group)) + ) + +(defun gnus-group-mode () + "Major mode for reading news. +All normal editing commands are switched off. +The following commands are available: + +\\ +\\[gnus-group-read-group]\t Choose the current group +\\[gnus-group-select-group]\t Select the current group without selecting the first article +\\[gnus-group-jump-to-group]\t Go to some group +\\[gnus-group-next-unread-group]\t Go to the next unread group +\\[gnus-group-prev-unread-group]\t Go to the previous unread group +\\[gnus-group-next-group]\t Go to the next group +\\[gnus-group-prev-group]\t Go to the previous group +\\[gnus-group-next-unread-group-same-level]\t Go to the next unread group on the same level +\\[gnus-group-prev-unread-group-same-level]\t Go to the previous unread group un the same level +\\[gnus-group-unsubscribe-current-group]\t (Un)subscribe to the current group +\\[gnus-group-unsubscribe-group]\t (Un)subscribe to some group +\\[gnus-group-catchup-current]\t Mark all unread articles in the current group as read +\\[gnus-group-catchup-current-all]\t Mark all alrticles in the current group as read +\\[gnus-group-list-groups]\t List groups that have unread articles +\\[gnus-group-list-all-groups]\t List all groups +\\[gnus-group-mail]\t Compose a mail +\\[gnus-group-get-new-news]\t Look for new news +\\[gnus-group-get-new-news-this-group]\t Look for new news for the current group +\\[gnus-group-restart]\t Restart Gnus +\\[gnus-group-save-newsrc]\t Save the startup file(s) +\\[gnus-group-browse-foreign-server]\t Browse a foreign (NNTP) server +\\[gnus-group-check-bogus-groups]\t Check for and delete bogus newsgroups +\\[gnus-find-new-newsgroups]\t Find new newsgroups +\\[gnus-group-describe-group]\t Describe the current newsgroup +\\[gnus-group-describe-all-groups]\t Describe all newsgroups +\\[gnus-group-post-news]\t Post an article to some newsgroup +\\[gnus-group-add-newsgroup]\t Add a newsgroup entry +\\[gnus-group-edit-newsgroup]\t Edit a newsgroup entry +\\[gnus-group-edit-local-kill]\t Edit a local kill file +\\[gnus-group-edit-global-kill]\t Edit the global kill file +\\[gnus-group-kill-group]\t Kill the current newsgroup +\\[gnus-group-yank-group]\t Yank a previously killed newsgroup +\\[gnus-group-kill-region]\t Kill all newsgroups between point and mark +\\[gnus-group-kill-all-zombies]\t Kill all zombie newsgroups +\\[gnus-group-transpose-groups]\t Transpose two newsgroups +\\[gnus-group-list-killed]\t List all killed newsgroups +\\[gnus-group-list-zombies]\t List all zombie newsgroups +\\[gnus-group-expire-articles]\t Expire the expirable articles in the current newsgroup +\\[gnus-group-expire-all-groups]\t Expire expirable articles in all newsgroups +\\[gnus-version]\t Display the current Gnus version +\\[gnus-group-set-current-level]\t Set the level of the current newsgroup +\\[gnus-group-suspend]\t Suspend Gnus +\\[gnus-group-clear-dribble]\t Clear the dribble buffer +\\[gnus-group-exit]\t Stop reading news +\\[gnus-group-quit]\t Stop reading news without saving the startup files +\\[gnus-group-describe-briefly]\t Give a brief description of the current mode +\\[gnus-info-find-node]\t Find the info pages for Gnus +" + (interactive) + (kill-all-local-variables) + (setq mode-line-modified "--- ") + (setq major-mode 'gnus-group-mode) + (setq mode-name "Newsgroup") + (gnus-group-set-mode-line) + (setq mode-line-process nil) + (use-local-map gnus-group-mode-map) + (buffer-disable-undo (current-buffer)) + (setq truncate-lines t) + (setq buffer-read-only t) + (run-hooks 'gnus-group-mode-hook)) + +(defun gnus-mouse-pick-group (e) + (interactive "e") + (mouse-set-point e) + (gnus-group-read-group nil)) + +(defalias '\(ding\) 'gnus) + +;;;###autoload +(defun gnus (&optional arg) + "Read network news. +If ARG is non-nil and a positive number, Gnus will use that as the +startup level. If ARG is non-nil and not a positive number, Gnus will +prompt the user for the name of an NNTP server to use." + (interactive "P") + (gnus-clear-system) + (gnus-read-init-file) + (if (and gnus-signature-file mail-signature) + (setq gnus-signature-file nil)) + (let ((level (and arg (numberp arg) (> arg 0) arg))) + (unwind-protect + (progn + (switch-to-buffer (get-buffer-create gnus-group-buffer)) + (gnus-add-current-to-buffer-list) + (gnus-group-mode) + (gnus-start-news-server (and arg (not level)))) + (if (not (gnus-server-opened gnus-select-method)) + (gnus-group-quit) + ;; NNTP server is successfully open. + (gnus-update-format-specifications) + (let ((buffer-read-only nil)) + (erase-buffer) + (if (not gnus-inhibit-startup-message) + (progn + (gnus-group-startup-message) + (sit-for 0)))) + (run-hooks 'gnus-startup-hook) + (gnus-setup-news nil (or level 7)) + (gnus-dribble-open) + (or (not gnus-novice-user) + gnus-expert-user + (gnus-group-describe-briefly)) ;Show brief help message. + (gnus-group-list-groups (or level 5)))))) + +(defun gnus-group-startup-message (&optional x y) + "Insert startup message in current buffer." + ;; Insert the message. + (erase-buffer) + (insert + (format " +%s + A newsreader + for GNU Emacs + + Based on GNUS + written by + Masanobu UMEDA + +Lars Ingebrigtsen + larsi@ifi.uio.no +" + gnus-version)) + ;; And then hack it. + ;; 18 is the longest line. + (indent-rigidly (point-min) (point-max) + (/ (max (- (window-width) (or x 28)) 0) 2)) + (goto-char (point-min)) + ;; +4 is fuzzy factor. + (insert-char ?\n (/ (max (- (window-height) (or y 12)) 0) 2))) + +(defun gnus-group-list-groups (level &optional unread) + "List newsgroups with level LEVEL or lower that have unread alticles. +Default is 5, which lists all subscribed groups. +If argument UNREAD is non-nil, groups with no unread articles are also listed." + (interactive "P") + (setq level (or level 5)) + (let ((case-fold-search nil) + (group (gnus-group-group-name))) + (set-buffer gnus-group-buffer) ;May call from out of Group buffer + (gnus-group-prepare level unread) + (if (zerop (buffer-size)) + ;; Suggested by Andrew Eskilsson . + (message "No news is horrible news") + (goto-char (point-min)) + (if (not group) + () + ;; Find the right group to put point on. If the current group + ;; has disapeared in the new listing, try to find the next + ;; one. If no next one can be found, just leave point at the + ;; first newsgroup in the buffer. + (if (not (re-search-forward (gnus-group-make-regexp group) nil t)) + (let ((newsrc (nthcdr 3 (gnus-gethash group gnus-newsrc-hashtb)))) + (while (and newsrc + (not (re-search-forward + (gnus-group-make-regexp (car (car newsrc))) + nil t))) + (setq newsrc (cdr newsrc)))))) + ;; Adjust cursor point. + (gnus-group-position-cursor)))) + +(defun gnus-group-prepare (level &optional all lowest) + "List all newsgroups with unread articles of level LEVEL or lower. +If ALL is non-nil, list groups that have no unread articles. +If LOWEST is non-nil, list all newsgroups of level LOWEST or higher." + (set-buffer (get-buffer-create gnus-group-buffer)) + (gnus-add-current-to-buffer-list) + (let ((buffer-read-only nil) + (newsrc (cdr gnus-newsrc-assoc)) + (zombie gnus-zombie-list) + (killed gnus-killed-list) + info clevel unread active group) + (if (not lowest) + (setq lowest 1)) + (erase-buffer) + (if (< lowest 8) + ;; List alive newsgroups. + (while newsrc + (setq info (car newsrc) + group (car info) + newsrc (cdr newsrc) + unread (car (gnus-gethash group gnus-newsrc-hashtb))) + (if (and unread ; This group might be bogus + (or all (eq unread t) (> unread 0)) + (and (<= (setq clevel (car (cdr info))) level)) + (>= clevel lowest)) + (gnus-group-insert-group-line + nil group (car (cdr info)) (nth 3 info) unread + (nth 4 info))))) + + ;; List zombies and killed lists somehwat faster, which was + ;; suggested by Jack Vinson . It does + ;; this by ignoring the group format specification altogether. + (let ((lists (list 'gnus-zombie-list 'gnus-killed-list)) + mark beg) + (while lists + (if (or (and (eq (car lists) 'gnus-zombie-list) + (progn (setq mark ?Z) + (and (>= level 8) (<= lowest 8)))) + (and (eq (car lists) 'gnus-killed-list) + (progn (setq mark ?K) + (and (>= level 9) (<= lowest 9))))) + (progn + (setq newsrc (set (car lists) + (sort (symbol-value (car lists)) + (function string<)))) + (while newsrc + (setq group (car newsrc) + newsrc (cdr newsrc)) + (insert (format " %c *: %s" mark group)) + (setq beg (point)) + (insert (format " %s %d\n" group + (if (= mark ?Z) 8 9))) + (set-text-properties beg (1- (point)) + '(invisible t))))) + (setq lists (cdr lists)))) + + (gnus-group-set-mode-line) + (setq gnus-have-all-newsgroups all) + (run-hooks 'gnus-group-prepare-hook))) + +(defun gnus-group-real-name (group) + "Find the real name of a foreign newsgroup." + (if (string-match (concat "^" gnus-foreign-group-prefix) group) + (substring group (match-end 0)) + group)) + +(defun gnus-group-set-info (info) + (let ((entry (gnus-gethash (car info) gnus-newsrc-hashtb))) + (if entry + (progn + (setcar (nthcdr 2 entry) info) + (if (and (not (eq (car entry) t)) + (gnus-gethash (car info) gnus-active-hashtb)) + (setcar entry (length (gnus-list-of-unread-articles + (car info)))))) + (error "No such group: %s" (car info))))) + +(defun gnus-group-update-group-line () + "This function updates the current line in the newsgroup buffer and +moves the point to the colon." + (let ((group (gnus-group-group-name)) + (buffer-read-only nil)) + (let ((entry (gnus-gethash group gnus-newsrc-hashtb))) + (if entry + (gnus-dribble-enter + (concat "(gnus-group-set-info '" (prin1-to-string (nth 2 entry)) + ")")))) + (beginning-of-line) + (delete-region (point) (save-excursion (forward-line 1) (point))) + (gnus-group-insert-group-line-info group) + (forward-line -1) + (gnus-group-position-cursor))) + +(defun gnus-group-insert-group-line-info (group) + (let ((entry (gnus-gethash group gnus-newsrc-hashtb)) + active info) + (if entry + (progn + (setq info (nth 2 entry)) + (gnus-group-insert-group-line + nil group (nth 1 info) (nth 3 info) (car entry) (nth 4 info))) + (setq active (gnus-gethash group gnus-active-hashtb)) + (gnus-group-insert-group-line + nil group (if (member group gnus-zombie-list) 8 9) + nil (- (1+ (cdr active)) (car active)) nil)))) + +(defun gnus-group-insert-group-line (gformat group level marked number method) + (let* ((gformat (or gformat gnus-group-line-format-spec)) + (marked (if (and (assq 'tick marked) (numberp number) + (>= (1- (length (assq 'tick marked))) number)) + ?* ? )) + (subscribed (cond ((< level 6) ? ) + ((< level 8) ?U) + ((= level 8) ?Z) + (t ?K))) + (buffer-read-only nil) + (newsgroup-description + (if gnus-description-hashtb + (or (gnus-gethash group gnus-description-hashtb) "") + "")) + (moderated (if (member group gnus-moderated-list) ?m ? )) + (moderated-string (if (eq moderated ?m) "(m)" "")) + (news-server (or (car (cdr method)) "")) + (news-method (or (car method) "")) + (news-method-string + (if method (format "(%s:%s)" (car method) (car (cdr method))) "")) + (number (if (eq number t) "*" number)) + flist b) + (beginning-of-line) + (let ((group (if method (gnus-group-real-name group) group))) + ;; Insert the visible text. + (insert (eval gformat))) + (forward-char -1) + ;; Insert the invisible info on the end of the line. + (setq b (point)) + ;; The info is GROUP UNREAD MARKED LEVEL. + (insert + (format " %s%c%c%d" + group (if (or (stringp number) (> number 0)) ?+ ? ) + marked level)) + (set-text-properties b (point) '(invisible t)) + (forward-char 1))) + +(defun gnus-group-update-group (group &optional visible-only) + "Update newsgroup info of GROUP. +If VISIBLE-ONLY is non-nil, the group won't be displayed if it isn't already." + (let ((buffer-read-only nil) + (case-fold-search nil) + (regexp (gnus-group-make-regexp group)) + (visible nil)) + (let ((entry (gnus-gethash group gnus-newsrc-hashtb))) + (if entry + (gnus-dribble-enter + (concat "(gnus-group-set-info '" (prin1-to-string (nth 2 entry)) + ")")))) + ;; Buffer may be narrowed. + (save-restriction + (widen) + ;; Search a line to modify. If the buffer is large, the search + ;; takes long time. In most cases, current point is on the line + ;; we are looking for. So, first of all, check current line. + ;; And then if current point is in the first half, search from + ;; the beginning. Otherwise, search from the end. + (if (cond ((progn + (beginning-of-line) + (looking-at regexp))) + ((and (> (/ (buffer-size) 2) (point)) ;In the first half. + (progn + (goto-char (point-min)) + (re-search-forward regexp nil t)))) + ((progn + (goto-char (point-max)) + (re-search-backward regexp nil t)))) + ;; GROUP is listed in current buffer. So, delete old line. + (progn + (setq visible t) + (beginning-of-line) + (delete-region (point) (progn (forward-line 1) (point)))) + ;; No such line in the buffer, find out where it's supposed to + ;; go, and insert it there (or at the end of the buffer). + (let ((entry (cdr (gnus-gethash group gnus-newsrc-hashtb)))) + (goto-char (point-min)) + (while (and entry + (not (re-search-forward (gnus-group-make-regexp + (car (car entry))) nil t))) + (setq entry (cdr entry))) + (if (not entry) + (goto-char (point-max))))) + (if (or visible (not visible-only)) + (progn + (gnus-group-insert-group-line-info group) + (forward-line -1) ; Move point back to the inserted line. + )))) + (gnus-group-set-mode-line)) + +(defun gnus-group-set-mode-line () + (if (memq 'group gnus-updated-mode-lines) + (let* ((gformat (or gnus-group-mode-line-format-spec + (setq gnus-group-mode-line-format-spec + (gnus-parse-format + gnus-group-mode-line-format + gnus-group-mode-line-format-alist)))) + (news-server (car (cdr gnus-select-method))) + (news-method (car gnus-select-method)) + (mode-string (eval gformat)) + (max-len 60)) + (if (> (length mode-string) max-len) + (setq mode-string (substring mode-string 0 (- max-len 4)))) + (setq mode-line-buffer-identification mode-string) + (set-buffer-modified-p t)))) + +(defun gnus-group-group-name () + "Get the name of the newsgroup on the current line." + (save-excursion + (let ((buffer-read-only nil)) + (beginning-of-line) + (if (re-search-forward " \\([^ ]*\\)...$" nil t) + (prog2 + (set-text-properties (match-beginning 1) (match-end 1) nil) + (buffer-substring (match-beginning 1) (match-end 1)) + (set-text-properties (match-beginning 1) (match-end 1) + '(invisible t))))))) + +(defun gnus-group-group-level () + "Get the level of the newsgroup on the current line." + (save-excursion + (end-of-line) + (forward-char -1) + (let ((c (following-char))) + (if (and (>= c ?1) (<= c ?9)) + (1+ (- c ?1)))))) + +(defun gnus-group-make-regexp (newsgroup) + "Return regexp that will match the line that NEWSGROUP is on." + (concat " " (regexp-quote newsgroup) "...$")) + +(defun gnus-group-search-forward (&optional backward all level) + "Find the next newsgroup with unread articles. +If BACKWARD is non-nil, find the previous newsgroup instead. +If ALL is non-nil, just find any newsgroup. +If LEVEL is non-nil, find group with level LEVEL, or higher if no such +group exists." + (if (not level) + (let ((regexp (if all "...$" "\\+.[1-5]$"))) + (prog1 + (if backward + (progn + (beginning-of-line) + (re-search-backward regexp nil t)) + (end-of-line) + (re-search-forward regexp nil t)) + (gnus-group-position-cursor))) + (let ((beg (point))) + (while (and (< level 10) + (goto-char beg) + (let ((regexp (format "%s.%d$" (if all "." "\\+") level))) + (not + (if backward + (progn + (beginning-of-line) + (re-search-backward regexp nil t)) + (end-of-line) + (re-search-forward regexp nil t))))) + (setq level (1+ level))) + (< level 10)))) + +;; Gnus Group mode command + +(defun gnus-group-read-group (all &optional no-article) + "Read news in this newsgroup. +If argument ALL is non-nil, already read articles become readable. +If optional argument NO-ARTICLE is non-nil, no article body is displayed." + (interactive "P") + (let ((group (gnus-group-group-name)) + number active) + (if (not group) + (error "No group on current line")) + ;; This group might be a dead group. In that case we have to get + ;; the number of unread articles from `gnus-active-hashtb'. + (if (>= (gnus-group-group-level) 8) + (setq number (- (1+ (cdr (setq active (gnus-gethash + group gnus-active-hashtb)))) + (car active))) + (setq number (car (gnus-gethash group gnus-newsrc-hashtb)))) + (gnus-summary-read-group + group (or all (and (numberp number) (zerop number))) no-article))) + +(defun gnus-group-select-group (all) + "Select this newsgroup. +No article is selected automatically. +If argument ALL is non-nil, already read articles become readable." + (interactive "P") + (gnus-group-read-group all t)) + +(defun gnus-group-jump-to-group (group) + "Jump to newsgroup GROUP." + (interactive + (list + (completing-read "Newsgroup: " gnus-active-hashtb nil t))) + (let ((case-fold-search nil)) + (goto-char (point-min)) + ;; Either go to the line in the group buffer... + (or (re-search-forward (gnus-group-make-regexp group) nil t) + ;; ... or insert the line. + (gnus-group-update-group group)) + ;; Adjust cursor point. + (gnus-group-position-cursor))) + +(defun gnus-group-next-group (n) + "Go to next N'th newsgroup. +If N is negative, search backward instead. +Returns the difference between N and the number of skips actually +done." + (interactive "p") + (gnus-group-next-unread-group n t)) + +(defun gnus-group-next-unread-group (n &optional all level) + "Go to next N'th unread newsgroup. +If N is negative, search backward instead. +If ALL is non-nil, choose any newsgroup, unread or not. +If LEVEL is non-nil, choose the next group with level LEVEL, or, if no +such group can be found, the next group with a level higher than +LEVEL. +Returns the difference between N and the number of skips actually +done." + (interactive "p") + (let ((backward (< n 0)) + (n (abs n))) + (while (and (> n 0) + (gnus-group-search-forward backward all level)) + (setq n (1- n))) + (if (/= 0 n) (message "No more%s newsgroups%s" (if all "" " unread") + (if level " on this level or higher" ""))) + n)) + +(defun gnus-group-prev-group (n) + "Go to previous N'th newsgroup. +Returns the difference between N and the number of skips actually +done." + (interactive "p") + (gnus-group-next-unread-group (- n) t)) + +(defun gnus-group-prev-unread-group (n) + "Go to previous N'th unread newsgroup. +Returns the difference between N and the number of skips actually +done." + (interactive "p") + (gnus-group-next-unread-group (- n))) + +(defun gnus-group-next-unread-group-same-level (n) + "Go to next N'th unread newsgroup on the same level. +If N is negative, search backward instead. +Returns the difference between N and the number of skips actually +done." + (interactive "p") + (gnus-group-next-unread-group n t (gnus-group-group-level)) + (gnus-group-position-cursor)) + +(defun gnus-group-prev-unread-group-same-level (n) + "Go to next N'th unread newsgroup on the same level. +Returns the difference between N and the number of skips actually +done." + (interactive "p") + (gnus-group-next-unread-group (- n) t (gnus-group-group-level)) + (gnus-group-position-cursor)) + +(defun gnus-group-add-newsgroup (&optional name how where) + "Add a new newsgroup." + (interactive) + (let ((methods gnus-valid-select-methods) + nname) + (if (not name) + (setq name (read-string "Newsgroup name: "))) + (setq nname (concat gnus-foreign-group-prefix name)) + (while (gnus-gethash nname gnus-newsrc-hashtb) + (setq name (read-string "Name already in use. Newsgroup name: ")) + (setq nname (concat gnus-foreign-group-prefix name))) + (if (not how) + (setq how (completing-read (format "%s method: " name) methods nil t))) + (if (not where) + (setq where (read-string + (format "Get %s by method %s from: " name how)))) + (gnus-group-change-level + (list t nname 3 nil nil (list (intern how) where)) + 3 9 (gnus-gethash (gnus-group-group-name) gnus-newsrc-hashtb) + t) + (gnus-group-insert-group-line-info nname))) + +(defun gnus-group-edit-newsgroup () + (interactive) + (let ((group (gnus-group-group-name)) + info) + (if group (setq info (nth 2 (gnus-gethash group gnus-newsrc-hashtb))) + (error "No group on current line")) + (switch-to-buffer (get-buffer-create gnus-group-edit-buffer)) + (gnus-add-current-to-buffer-list) + (emacs-lisp-mode) + (erase-buffer) + (insert ";; Type `C-c C-c' after you have edited the newsgroup entry.\n\n") + (insert (format "(gnus-group-set-info\n '%S)\n" info)) + (local-set-key "\C-c\C-c" 'gnus-group-edit-newsgroup-done))) + +(defun gnus-group-edit-newsgroup-done () + (interactive) + (set-buffer (get-buffer-create gnus-group-edit-buffer)) + (eval-current-buffer) + (kill-buffer (current-buffer)) + (set-buffer gnus-group-buffer) + (gnus-group-update-group (gnus-group-group-name)) + (gnus-group-position-cursor)) + +(defun gnus-group-make-mail-groups (method) + ;; Suggested by Brian Edmonds . + (interactive + (list + (intern + (completing-read + "Mail method: " + (gnus-methods-using 'mail) nil t "nnmail")))) + (let ((groups nnmail-split-methods) + group) + (while groups + (setq group (concat gnus-foreign-group-prefix (car (car groups)))) + (if (not (gnus-gethash group gnus-newsrc-hashtb)) + (progn + (gnus-group-change-level + (list t group 1 nil nil (list method "")) + 1 9 (gnus-gethash (gnus-group-group-name) gnus-newsrc-hashtb) + t) + (gnus-group-insert-group-line-info group))) + (setq groups (cdr groups))))) + +(defun gnus-group-catchup-current (n &optional all) + "Mark all articles not marked as unread in current newsgroup as read. +If prefix argument N is numeric, the ARG next newsgroups will be +caught up. If ALL is non-nil, marked articles will also be marked as +read. Cross references (Xref: field) of articles are ignored. +The difference between N and actual number of newsgroups that were +caught up is returned." + (interactive "p") + (if (or (not gnus-interactive-catchup) ;Without confirmation? + gnus-expert-user + (y-or-n-p + (if all + "Do you really want to mark all articles as read? " + "Mark all unread articles as read? "))) + (progn + (while + (and (> n 0) + (progn + (setq n (1- n)) + (gnus-group-catchup (gnus-group-group-name) all) + (gnus-group-update-group-line) + t) + (= 0 (gnus-group-next-unread-group 1)))))) + n) + +(defun gnus-group-catchup-current-all (n) + "Mark all articles in current newsgroup as read. +Cross references (Xref: field) of articles are ignored." + (interactive "p") + (gnus-group-catchup-current n 'all)) + +(defun gnus-group-catchup (group &optional all) + "Mark all articles in GROUP as read. +If ALL is non-nil, all articles are marked as read. +The return value is the number of articles that were marked as read, +or nil if no action could be taken." + (let* ((entry (gnus-gethash group gnus-newsrc-hashtb)) + (num (car entry)) + ticked) + ;; Do the updating only if the newsgroup isn't killed + (if entry + (progn + (setq ticked (if all nil (cdr (assq 'tick (nth 3 (nth 2 entry)))))) + (gnus-update-read-articles group ticked nil ticked))) + num)) + +(defun gnus-group-expire-articles (newsgroup) + "Expire all expirable articles in the current newsgroup." + (interactive (list (gnus-group-group-name))) + (if (not newsgroup) (error "No current newsgroup")) + (let ((expirable + (assq 'expire (nth 3 (nth 2 (gnus-gethash newsgroup + gnus-newsrc-hashtb)))))) + (if (and expirable + (gnus-check-backend-function + 'gnus-request-expire-articles newsgroup)) + (setcdr expirable + (gnus-request-expire-articles (cdr expirable) newsgroup))))) + +(defun gnus-group-expire-all-groups () + "Expire all expirable articles in all newsgroups." + (interactive) + (let ((newsrc (cdr gnus-newsrc-assoc))) + (while newsrc + (gnus-group-expire-articles (car (car newsrc))) + (setq newsrc (cdr newsrc))))) + +(defun gnus-group-set-current-level (n) + "Set the level of the current group to the numeric prefix." + (interactive "P") + (let ((group (gnus-group-group-name))) + (if (not group) (error "No newsgroup on current line.") + (if (and (numberp n) (>= n 1) (<= n 9)) + (progn + (gnus-group-change-level group n (gnus-group-group-level)) + (gnus-group-update-group-line)) + (error "Illegal level: %s" n))))) + +(defun gnus-group-unsubscribe-current-group (arg) + "Toggle subscribe from/to unsubscribe current group." + (interactive "P") + (let ((group (gnus-group-group-name))) + (if group + (progn + (if (not arg) + (setq arg (if (<= (gnus-group-group-level) 5) 7 3))) + (gnus-group-unsubscribe-group group arg) + (gnus-group-next-group 1)) + (message "No newsgroup on current line")))) + +(defun gnus-group-unsubscribe-group (group &optional level) + "Toggle subscribe from/to unsubscribe GROUP. +New newsgroup is added to .newsrc automatically." + (interactive + (list (completing-read "Newsgroup: " gnus-active-hashtb nil t))) + (let ((newsrc (gnus-gethash group gnus-newsrc-hashtb))) + (cond (newsrc + ;; Toggle subscription flag. + (gnus-group-change-level + newsrc (if level level (if (< (nth 1 (nth 2 newsrc)) 6) 7 4))) + (gnus-group-update-group group)) + ((and (stringp group) + (gnus-gethash group gnus-active-hashtb)) + ;; Add new newsgroup. + (gnus-group-change-level + group + (if level level 3) + (if (member group gnus-zombie-list) 8 9) + (or (and (gnus-group-group-name) + (gnus-gethash (gnus-group-group-name) gnus-newsrc-hashtb)) + (gnus-gethash (car (car gnus-newsrc-assoc)) + gnus-newsrc-hashtb))) + (gnus-group-update-group group)) + (t (error "No such newsgroup: %s" group))) + (gnus-group-position-cursor))) + +(defun gnus-group-transpose-groups (arg) + "Exchange current newsgroup and previous newsgroup. +With argument ARG, takes previous newsgroup and moves it past ARG newsgroup." + (interactive "p") + ;; BUG: last newsgroup and the last but one cannot be transposed + ;; since gnus-group-search-forward does not move forward beyond the + ;; last. If we instead use forward-line, no problem, but I don't + ;; want to use it for later extension. + (while (> arg 0) + (gnus-group-search-forward t t) + (gnus-group-kill-group 1) + (gnus-group-search-forward nil t) + (gnus-group-yank-group) + (gnus-group-search-forward nil t) + (setq arg (1- arg)) + )) + +(defun gnus-group-kill-all-zombies () + "Kill all zombie newsgroups." + (interactive) + (setq gnus-killed-list (nconc gnus-zombie-list gnus-killed-list)) + (setq gnus-zombie-list nil) + (gnus-group-prepare 5) + (goto-char (point-min)) + (gnus-group-position-cursor)) + +(defun gnus-group-kill-region (begin end) + "Kill newsgroups in current region (excluding current point). +The killed newsgroups can be yanked by using \\[gnus-group-yank-group]." + (interactive "r") + (let ((lines + ;; Exclude a line where current point is on. + (1- + ;; Count lines. + (save-excursion + (count-lines + (progn + (goto-char begin) + (beginning-of-line) + (point)) + (progn + (goto-char end) + (end-of-line) + (point))))))) + (goto-char begin) + (beginning-of-line) ;Important when LINES < 1 + (gnus-group-kill-group lines))) + +(defun gnus-group-kill-group (n) + "Kill newsgroup on current line, repeated prefix argument N times. +The killed newsgroups can be yanked by using \\[gnus-group-yank-group]. +However, only groups that were alive can be yanked; already killed +groups or zombie groups can't be yanked. +The return value is the name of the (last) newsgroup that was killed." + (interactive "p") + (let ((buffer-read-only nil) + group entry level) + (while (>= (setq n (1- n)) 0) + (setq group (gnus-group-group-name)) + (or group + (signal 'end-of-buffer nil)) + (setq level (gnus-group-group-level)) + (beginning-of-line) + (delete-region (point) + (progn (forward-line 1) (point))) + (if (setq entry (gnus-gethash group gnus-newsrc-hashtb)) + (setq gnus-list-of-killed-groups + (cons (cons (car entry) (nth 2 entry)) + gnus-list-of-killed-groups))) + (gnus-group-change-level + (if entry entry group) 9 + (if entry nil level))) + (if (eobp) + (forward-line -1)) + (gnus-group-position-cursor) + group)) + +(defun gnus-group-yank-group (&optional arg) + "Yank the last newsgroups killed with \\[gnus-group-kill-group], +inserting it before the current newsgroup. The numeric ARG specifies +how many newsgroups are to be yanked. The name of the (last) +newsgroup yanked is returned." + (interactive "p") + (if (not arg) (setq arg 1)) + (let (info group prev) + (while (>= (setq arg (1- arg)) 0) + (if (not (setq info (car gnus-list-of-killed-groups))) + (error "No more newsgroups to yank")) + (setq group (nth 2 info)) + ;; Find which newsgroup to insert this one before - search + ;; backward until something suitable is found. If there are no + ;; other newsgroups in this buffer, just make this newsgroup the + ;; first newsgroup. + (while (and (not (setq prev (gnus-group-group-name))) + (= 0 (forward-line -1)))) + (if (not prev) + (setq prev (car (car gnus-newsrc-assoc)))) + (gnus-group-change-level + info (nth 2 info) 9 + (gnus-gethash prev gnus-newsrc-hashtb) + t) + (gnus-group-insert-group-line-info (nth 1 info)) + (setq gnus-list-of-killed-groups + (cdr gnus-list-of-killed-groups))) + (forward-line -1) + (gnus-group-position-cursor) + group)) + +(defun gnus-group-list-all-groups (arg) + "List all newsgroups with level ARG or lower. +Default is 7, which lists all subscribed and unsubscribed groups." + (interactive "P") + (setq arg (or arg 7)) + (gnus-group-list-groups arg t)) + +(defun gnus-group-list-killed () + "List all killed newsgroups in the Newsgroup buffer." + (interactive) + (gnus-group-prepare 9 t 9) + (goto-char (point-min)) + (gnus-group-position-cursor)) + +(defun gnus-group-list-zombies () + "List all zombie newsgroups in the Newsgroup buffer." + (interactive) + (gnus-group-prepare 8 t 8) + (goto-char (point-min)) + (gnus-group-position-cursor)) + +(defun gnus-group-get-new-news (&optional arg) + "Get newly arrived articles. +If ARG is non-nil, it should be a number between one and nine to +specify which levels you are interested in re-scanning." + (interactive "P") + (if (and gnus-read-active-file (not arg)) + (gnus-read-active-file)) + (if arg + (let ((gnus-read-active-file nil)) + (gnus-get-unread-articles arg)) + (gnus-get-unread-articles 7)) + (gnus-group-list-groups 5 gnus-have-all-newsgroups)) + +(defun gnus-group-get-new-news-this-group (n) + "Check for newly arrived news in the current group (and the N-1 next groups). +The difference between N and the number of newsgroup checked is returned. +If N is negative, this group and the N-1 previous groups will be checked." + (interactive "p") + (let ((backward (< n 0)) + (n (abs n)) + group) + (while (and (> n 0) + (progn + (and (setq group (gnus-group-group-name)) + (gnus-activate-newsgroup + group (gnus-group-real-name group)) + (progn + (gnus-get-unread-articles-in-group + (nth 2 (gnus-gethash group gnus-newsrc-hashtb)) + (gnus-gethash group gnus-active-hashtb)) + (gnus-group-update-group-line))) + t) + (= 0 (gnus-group-next-group 1))) + (setq n (1- n))) + (if (/= 0 n) (message "No more newsgroups")) + n)) + +(defun gnus-group-describe-group (&optional group) + "Display a description of the current newsgroup." + (interactive) + (let ((group (or group (gnus-group-group-name)))) + (if (not group) + (message "No group on current line") + (and (or gnus-description-hashtb + (gnus-read-descriptions-file)) + (message + (or (gnus-gethash group gnus-description-hashtb) + "No description available")))))) + +;; Suggested by Per Abrahamsen . +(defun gnus-group-describe-all-groups () + "Pop up a buffer with descriptons of all newsgroups." + (interactive) + (if (not (or gnus-description-hashtb + (gnus-read-descriptions-file))) + (error "Couldn't request descriptions file")) + (let ((buffer-read-only nil) + beg) + (erase-buffer) + (mapatoms + (lambda (group) + (insert (format " *: %-20s %s" (symbol-name group) + (symbol-value group))) + (setq beg (point)) + (insert (format " %s 6\n" group)) + (set-text-properties beg (1- (point)) '(invisible t))) + gnus-description-hashtb) + (goto-char (point-min)) + (gnus-group-position-cursor))) + +;; Suggested by Jack Vinson . +(defun gnus-group-save-newsrc () + "Save the Gnus startup files." + (interactive) + (gnus-save-newsrc-file)) + +(defun gnus-group-restart (&optional arg) + "Force Gnus to read the .newsrc file." + (interactive "P") + (gnus-save-newsrc-file) + (gnus-setup-news 'force) + (gnus-group-list-groups (or arg 5) gnus-have-all-newsgroups)) + +(defun gnus-group-read-init-file () + "Read the Gnus elisp init file." + (interactive) + (gnus-read-init-file)) + +(defun gnus-group-check-bogus-groups () + "Check bogus newsgroups." + (interactive) + (gnus-check-bogus-newsgroups (not gnus-expert-user)) ;Require confirmation. + (gnus-group-list-groups 5 gnus-have-all-newsgroups)) + +(defun gnus-group-mail () + "Start composing a mail." + (interactive) + (mail)) + +(defun gnus-group-edit-global-kill () + "Edit a global KILL file." + (interactive) + (setq gnus-current-kill-article nil) ;No articles selected. + (gnus-kill-file-edit-file nil) ;Nil stands for global KILL file. + (message + (substitute-command-keys + "Editing a global KILL file (Type \\[gnus-kill-file-exit] to exit)"))) + +(defun gnus-group-edit-local-kill () + "Edit a local KILL file." + (interactive) + (setq gnus-current-kill-article nil) ;No articles selected. + (gnus-kill-file-edit-file (gnus-group-group-name)) + (message + (substitute-command-keys + "Editing a local KILL file (Type \\[gnus-kill-file-exit] to exit)"))) + +(defun gnus-group-force-update () + "Update `.newsrc' file." + (interactive) + (gnus-save-newsrc-file)) + +(defun gnus-group-suspend () + "Suspend the current Gnus session. +In fact, cleanup buffers except for Group Mode buffer. +The hook gnus-suspend-gnus-hook is called before actually suspending." + (interactive) + (run-hooks 'gnus-suspend-gnus-hook) + ;; Kill Gnus buffers except for Group Mode buffer. + (let ((group-buf (get-buffer gnus-group-buffer))) + (while gnus-buffer-list + (and (not (eq (car gnus-buffer-list) group-buf)) + (get-buffer (car gnus-buffer-list)) + (buffer-name (get-buffer (car gnus-buffer-list))) + (kill-buffer (car gnus-buffer-list))) + (setq gnus-buffer-list (cdr gnus-buffer-list))) + (setq gnus-buffer-list (list group-buf)) + (bury-buffer group-buf) + (delete-windows-on group-buf t))) + +(defun gnus-group-clear-dribble () + "Clear all information from the dribble buffer." + (interactive) + (gnus-dribble-clear)) + +(defun gnus-group-exit () + "Quit reading news after updating .newsrc.eld and .newsrc. +The hook `gnus-exit-gnus-hook' is called before actually exiting." + (interactive) + (if (or noninteractive ;For gnus-batch-kill + (zerop (buffer-size)) ;No news is good news. + (not (gnus-server-opened gnus-select-method)) ;NNTP connection closed + (not gnus-interactive-exit) ;Without confirmation + gnus-expert-user + (y-or-n-p "Are you sure you want to quit reading news? ")) + (progn + (message "") ;Erase "Yes or No" question. + (run-hooks 'gnus-exit-gnus-hook) + (gnus-save-newsrc-file) + (gnus-clear-system)))) + +(defun gnus-group-quit () + "Quit reading news without updating .newsrc.eld or .newsrc. +The hook `gnus-exit-gnus-hook' is called before actually exiting." + (interactive) + (if (or noninteractive ;For gnus-batch-kill + (zerop (buffer-size)) + (not (gnus-server-opened gnus-select-method)) + gnus-expert-user + (yes-or-no-p + (format "Quit reading news without saving %s? " + (file-name-nondirectory gnus-current-startup-file)))) + (progn + (message "") ;Erase "Yes or No" question. + (run-hooks 'gnus-exit-gnus-hook) + (gnus-dribble-save) + (gnus-clear-system)))) + +(defun gnus-group-describe-briefly () + "Give a one line description of the Group mode commands." + (interactive) + (message + (substitute-command-keys "\\[gnus-group-read-group]:Select \\[gnus-group-next-unread-group]:Forward \\[gnus-group-prev-unread-group]:Backward \\[gnus-group-exit]:Exit \\[gnus-info-find-node]:Run Info \\[gnus-group-describe-briefly]:This help"))) + +(defun gnus-group-browse-foreign-server (method) + "Browse a foreign news server. +If called interactively, this function will ask for a select method + (nntp, nnspool, etc.) and a server address (eg. nntp.some.where). +If not, METHOD should be a list where the first element is the method +and the second element is the address." + (interactive + (list (list (completing-read "Select method: " + gnus-valid-select-methods + nil t "nntp") + (read-string "Server name: ")))) + (gnus-browse-foreign-server method)) + + +;;; +;;; Browse Server Mode +;;; + +(defvar gnus-browse-server-mode-hook nil) +(defvar gnus-browse-server-mode-map nil) + +(if gnus-browse-server-mode-map + nil + (setq gnus-browse-server-mode-map (make-keymap)) + (suppress-keymap gnus-browse-server-mode-map) + (define-key gnus-browse-server-mode-map " " 'gnus-browse-read-group) + (define-key gnus-browse-server-mode-map "=" 'gnus-browse-read-group) + (define-key gnus-browse-server-mode-map "n" 'gnus-group-next-group) + (define-key gnus-browse-server-mode-map "p" 'gnus-group-prev-group) + (define-key gnus-browse-server-mode-map [del] 'gnus-group-prev-group) + (define-key gnus-browse-server-mode-map "N" 'gnus-group-next-group) + (define-key gnus-browse-server-mode-map "P" 'gnus-group-prev-group) + (define-key gnus-browse-server-mode-map "\M-n" 'gnus-group-next-group) + (define-key gnus-browse-server-mode-map "\M-p" 'gnus-group-prev-group) + (define-key gnus-browse-server-mode-map [down] 'gnus-group-next-group) + (define-key gnus-browse-server-mode-map [up] 'gnus-group-prev-group) + (define-key gnus-browse-server-mode-map "\r" 'gnus-group-next-group) + (define-key gnus-browse-server-mode-map "u" 'gnus-browse-unsubscribe-current-group) + (define-key gnus-browse-server-mode-map "q" 'gnus-browse-exit) + (define-key gnus-browse-server-mode-map "Q" 'gnus-browse-exit) + (define-key gnus-browse-server-mode-map "\C-c\C-c" 'gnus-browse-quit) + (define-key gnus-browse-server-mode-map "?" 'gnus-browse-describe-briefly) + (define-key gnus-browse-server-mode-map "\C-c\C-i" 'gnus-info-find-node) + ) + +(defvar gnus-browse-current-method nil) + +(defun gnus-browse-foreign-server (method) + (setq gnus-browse-current-method method) + (let ((gnus-select-method method) + groups group) + (message "Connecting to %s..." (nth 1 method)) + (if (not (gnus-request-list method)) + (error "Unable to contact server: " (gnus-status-message method))) + (set-buffer (get-buffer-create "*Gnus Browse Server*")) + (gnus-add-current-to-buffer-list) + (buffer-disable-undo (current-buffer)) + (let ((buffer-read-only nil)) + (erase-buffer)) + (gnus-browse-server-mode) + (setq mode-line-buffer-identification + (format + "(ding) Browse Server {%s:%s}" (car method) (car (cdr method)))) + (save-excursion + (set-buffer nntp-server-buffer) + (let ((cur (current-buffer))) + (goto-char 1) + (while (re-search-forward + "\\(^[^ \t]+\\)[ \t]+[0-9]+[ \t]+[0-9]+" nil t) + (goto-char (match-end 1)) + (setq groups (cons (cons (buffer-substring (match-beginning 1) + (match-end 1)) + (- (read cur) (read cur))) + groups))))) + (setq groups (sort groups + (lambda (l1 l2) + (string< (car l1) (car l2))))) + (let ((buffer-read-only nil)) + (while groups + (setq group (car groups)) + (insert + (format "K%7d: %s\n" (cdr group) (car group))) + (setq groups (cdr groups)))) + (switch-to-buffer (current-buffer)) + (goto-char 1) + (gnus-group-position-cursor))) + +(defun gnus-browse-server-mode () + "Major mode for reading network news." + (interactive) + (kill-all-local-variables) + (setq mode-line-modified "--- ") + (setq major-mode 'gnus-browse-server-mode) + (setq mode-name "Browse Server") + (setq mode-line-process nil) + (use-local-map gnus-browse-server-mode-map) + (buffer-disable-undo (current-buffer)) + (setq truncate-lines t) + (setq buffer-read-only t) + (run-hooks 'gnus-browse-server-mode-hook)) + +(defun gnus-browse-read-group () + "Not implemented, and will probably never be." + (interactive) + (error "You can't read while browsing")) + +(defun gnus-browse-unsubscribe-current-group (arg) + "(Un)subscribe to the next ARG groups." + (interactive "p") + (let ((ward (if (< arg 0) -1 1)) + (arg (abs arg))) + (while (and (> arg 0) + (gnus-browse-unsubscribe-group) + (= (gnus-group-next-group ward) 0)) + (setq arg (1- arg))) + (gnus-group-position-cursor) + (if (/= 0 arg) (message "No more newsgroups" )) + arg)) + +(defun gnus-browse-unsubscribe-group () + (let ((sub nil) + (buffer-read-only nil) + group) + (save-excursion + (beginning-of-line) + (if (= (following-char) ?K) (setq sub t)) + (re-search-forward ": \\(.*\\)$" nil t) + (setq group + (concat gnus-foreign-group-prefix + (buffer-substring (match-beginning 1) (match-end 1)))) + (beginning-of-line) + (delete-char 1) + (if sub + (progn + (gnus-group-change-level + (list t group 3 nil nil gnus-browse-current-method) 3 9 + (gnus-gethash (car (nth 1 gnus-newsrc-assoc)) gnus-newsrc-hashtb) + t) + (insert ? )) + (gnus-group-change-level group 9 3) + (insert ?K))) + t)) + +(defun gnus-browse-exit () + "Quit browsing and return to the Newsgroup buffer." + (interactive) + (if (eq major-mode 'gnus-browse-server-mode) + (kill-buffer (current-buffer))) + (switch-to-buffer gnus-group-buffer) + (gnus-group-list-groups 5)) + +(defun gnus-browse-describe-briefly () + "Give a one line description of the Group mode commands." + (interactive) + (message + (substitute-command-keys "\\[gnus-group-next-group]:Forward \\[gnus-group-prev-group]:Backward \\[gnus-browse-exit]:Exit \\[gnus-info-find-node]:Run Info \\[gnus-browse-describe-briefly]:This help"))) + + +;;; +;;; Gnus Summary Mode +;;; + +(defvar gnus-summary-kill-map nil) +(define-prefix-command 'gnus-summary-kill-map) + +(if gnus-summary-mode-map + nil + (setq gnus-summary-mode-map (make-keymap)) + (suppress-keymap gnus-summary-mode-map) + (define-key gnus-summary-mode-map "\C-c\C-k" gnus-summary-kill-map) + (define-key gnus-summary-mode-map "\C-c\C-v" 'gnus-uu-ctl-map) + (define-key gnus-summary-mode-map "#" 'gnus-summary-mark-as-processable) + (define-key gnus-summary-mode-map "\M-#" 'gnus-summary-unmark-as-processable) + (define-key gnus-summary-mode-map "\C-c\M-#" 'gnus-summary-unmark-all-processable) + (define-key gnus-summary-mode-map " " 'gnus-summary-next-page) + (define-key gnus-summary-mode-map "\177" 'gnus-summary-prev-page) + (define-key gnus-summary-mode-map "\r" 'gnus-summary-scroll-up) + (define-key gnus-summary-mode-map "n" 'gnus-summary-next-unread-article) + (define-key gnus-summary-mode-map "p" 'gnus-summary-prev-unread-article) + (define-key gnus-summary-mode-map "N" 'gnus-summary-next-article) + (define-key gnus-summary-mode-map "P" 'gnus-summary-prev-article) + (define-key gnus-summary-mode-map "\M-\C-n" 'gnus-summary-next-same-subject) + (define-key gnus-summary-mode-map "\M-\C-p" 'gnus-summary-prev-same-subject) + (define-key gnus-summary-mode-map "\C-c\C-n" 'gnus-summary-next-digest) + (define-key gnus-summary-mode-map "\C-c\C-p" 'gnus-summary-prev-digest) + (define-key gnus-summary-mode-map "\M-n" 'gnus-summary-next-unread-subject) + (define-key gnus-summary-mode-map "\M-p" 'gnus-summary-prev-unread-subject) + (define-key gnus-summary-mode-map "." 'gnus-summary-first-unread-article) + (define-key gnus-summary-mode-map "s" 'gnus-summary-isearch-article) + (define-key gnus-summary-mode-map "\M-s" 'gnus-summary-search-article-forward) + (define-key gnus-summary-mode-map "\M-r" 'gnus-summary-search-article-backward) + (define-key gnus-summary-mode-map "<" 'gnus-summary-beginning-of-article) + (define-key gnus-summary-mode-map ">" 'gnus-summary-end-of-article) + (define-key gnus-summary-mode-map "j" 'gnus-summary-goto-subject) + (define-key gnus-summary-mode-map "l" 'gnus-summary-goto-last-article) + (define-key gnus-summary-mode-map "^" 'gnus-summary-refer-parent-article) + (define-key gnus-summary-mode-map "\M-^" 'gnus-summary-refer-article) + (define-key gnus-summary-mode-map "'" 'gnus-summary-tick-article-forward) + (define-key gnus-summary-mode-map "u" 'gnus-summary-tick-article-forward) + (define-key gnus-summary-mode-map "U" 'gnus-summary-tick-article-backward) + (define-key gnus-summary-mode-map "d" 'gnus-summary-mark-as-read-forward) + (define-key gnus-summary-mode-map "D" 'gnus-summary-mark-as-read-backward) + (define-key gnus-summary-mode-map "\M-u" 'gnus-summary-clear-mark-forward) + (define-key gnus-summary-mode-map "\M-U" 'gnus-summary-clear-mark-backward) + (define-key gnus-summary-mode-map "k" 'gnus-summary-kill-same-subject-and-select) + (define-key gnus-summary-mode-map "\C-k" 'gnus-summary-kill-same-subject) + (define-key gnus-summary-mode-map "\M-\C-t" 'gnus-summary-toggle-threads) + (define-key gnus-summary-mode-map "\M-\C-s" 'gnus-summary-show-thread) + (define-key gnus-summary-mode-map "\M-\C-h" 'gnus-summary-hide-thread) + (define-key gnus-summary-mode-map "\M-\C-f" 'gnus-summary-next-thread) + (define-key gnus-summary-mode-map "\M-\C-b" 'gnus-summary-prev-thread) + (define-key gnus-summary-mode-map "\M-\C-u" 'gnus-summary-up-thread) + (define-key gnus-summary-mode-map "\M-\C-d" 'gnus-summary-down-thread) + (define-key gnus-summary-mode-map "\M-\C-k" 'gnus-summary-kill-thread) + (define-key gnus-summary-mode-map "&" 'gnus-summary-execute-command) + (define-key gnus-summary-mode-map "c" 'gnus-summary-catchup-and-exit) + (define-key gnus-summary-mode-map "\C-t" 'gnus-summary-toggle-truncation) + (define-key gnus-summary-mode-map "\M-d" 'gnus-summary-delete-marked-as-read) + (define-key gnus-summary-mode-map "\C-c\M-\C-d" 'gnus-summary-delete-marked-with) + (define-key gnus-summary-mode-map "x" 'gnus-summary-mark-as-expirable) + (define-key gnus-summary-mode-map "X" 'gnus-summary-unmark-as-expirable) + (define-key gnus-summary-mode-map "b" 'gnus-summary-set-bookmark) + (define-key gnus-summary-mode-map "B" 'gnus-summary-remove-bookmark) + (define-key gnus-summary-mode-map "i" 'gnus-summary-mark-as-interesting) + (define-key gnus-summary-mode-map "\M-i" 'gnus-summary-show-all-interesting) + (define-key gnus-summary-mode-map "\C-c\C-sn" 'gnus-summary-sort-by-number) + (define-key gnus-summary-mode-map "\C-c\C-sa" 'gnus-summary-sort-by-author) + (define-key gnus-summary-mode-map "\C-c\C-ss" 'gnus-summary-sort-by-subject) + (define-key gnus-summary-mode-map "\C-c\C-sd" 'gnus-summary-sort-by-date) + (define-key gnus-summary-mode-map "\C-c\C-s\C-n" 'gnus-summary-sort-by-number) + (define-key gnus-summary-mode-map "\C-c\C-s\C-a" 'gnus-summary-sort-by-author) + (define-key gnus-summary-mode-map "\C-c\C-s\C-s" 'gnus-summary-sort-by-subject) + (define-key gnus-summary-mode-map "\C-c\C-s\C-d" 'gnus-summary-sort-by-date) + (define-key gnus-summary-mode-map "=" 'gnus-summary-expand-window) + (define-key gnus-summary-mode-map "\C-x\C-s" 'gnus-summary-reselect-current-group) + (define-key gnus-summary-mode-map "\M-g" 'gnus-summary-rescan-group) + (define-key gnus-summary-mode-map "w" 'gnus-summary-stop-page-breaking) + (define-key gnus-summary-mode-map "\C-c\C-r" 'gnus-summary-caesar-message) + (define-key gnus-summary-mode-map "g" 'gnus-summary-show-article) + (define-key gnus-summary-mode-map "t" 'gnus-summary-toggle-header) + (define-key gnus-summary-mode-map "\M-t" 'gnus-summary-toggle-mime) + (define-key gnus-summary-mode-map "\C-d" 'gnus-summary-rmail-digest) + (define-key gnus-summary-mode-map "a" 'gnus-summary-post-news) + (define-key gnus-summary-mode-map "f" 'gnus-summary-followup) + (define-key gnus-summary-mode-map "F" 'gnus-summary-followup-with-original) + (define-key gnus-summary-mode-map "C" 'gnus-summary-cancel-article) + (define-key gnus-summary-mode-map "S" 'gnus-summary-supersede-article) + (define-key gnus-summary-mode-map "r" 'gnus-summary-reply) + (define-key gnus-summary-mode-map "R" 'gnus-summary-reply-with-original) + (define-key gnus-summary-mode-map "\C-c\C-f" 'gnus-summary-mail-forward) + (define-key gnus-summary-mode-map "m" 'gnus-summary-mail-other-window) + (define-key gnus-summary-mode-map "o" 'gnus-summary-save-article) + (define-key gnus-summary-mode-map "\C-o" 'gnus-summary-save-article-rmail) + (define-key gnus-summary-mode-map "|" 'gnus-summary-pipe-output) + (define-key gnus-summary-mode-map "\M-m" 'gnus-summary-move-article) + (define-key gnus-summary-mode-map "\M-\C-m" 'gnus-summary-respool-article) + (define-key gnus-summary-mode-map "\M-k" 'gnus-summary-edit-local-kill) + (define-key gnus-summary-mode-map "\M-K" 'gnus-summary-edit-global-kill) + (define-key gnus-summary-mode-map "V" 'gnus-version) + (define-key gnus-summary-mode-map "\C-c\C-d" 'gnus-summary-describe-group) + (define-key gnus-summary-mode-map "q" 'gnus-summary-exit) + (define-key gnus-summary-mode-map "Q" 'gnus-summary-quit) + (define-key gnus-summary-mode-map "?" 'gnus-summary-describe-briefly) + (define-key gnus-summary-mode-map "\C-c\C-i" 'gnus-info-find-node) + (define-key gnus-summary-mode-map [mouse-2] 'gnus-mouse-pick-article) + (define-key gnus-summary-kill-map "\C-s" 'gnus-kill-file-kill-by-subject) + (define-key gnus-summary-kill-map "\C-a" 'gnus-kill-file-kill-by-author) + (define-key gnus-summary-kill-map "\C-t" 'gnus-kill-file-kill-by-thread) + (define-key gnus-summary-kill-map "\C-x" 'gnus-kill-file-kill-by-xref) + + (define-key gnus-summary-mode-map [menu-bar misc] + (cons "Misc" (make-sparse-keymap "misc"))) + + (define-key gnus-summary-mode-map [menu-bar misc caesar-message] + '("Caesar Message" . gnus-summary-caesar-message)) + (define-key gnus-summary-mode-map [menu-bar misc cancel-article] + '("Cancel Article" . gnus-summary-cancel-article)) + (define-key gnus-summary-mode-map [menu-bar misc edit-local-kill] + '("Edit Kill File" . gnus-summary-edit-local-kill)) + + (define-key gnus-summary-mode-map [menu-bar misc tick] + '("Tick" . gnus-summary-tick-article-forward)) + (define-key gnus-summary-mode-map [menu-bar misc mark-as-read] + '("Mark as Read" . gnus-summary-mark-as-read)) + + (define-key gnus-summary-mode-map [menu-bar misc quit] + '("Quit Group" . gnus-summary-quit)) + (define-key gnus-summary-mode-map [menu-bar misc exit] + '("Exit Group" . gnus-summary-exit)) + + (define-key gnus-summary-mode-map [menu-bar sort] + (cons "Sort" (make-sparse-keymap "sort"))) + + (define-key gnus-summary-mode-map [menu-bar sort sort-by-author] + '("Sort by Author" . gnus-summary-sort-by-author)) + (define-key gnus-summary-mode-map [menu-bar sort sort-by-date] + '("Sort by Date" . gnus-summary-sort-by-date)) + (define-key gnus-summary-mode-map [menu-bar sort sort-by-number] + '("Sort by Number" . gnus-summary-sort-by-number)) + (define-key gnus-summary-mode-map [menu-bar sort sort-by-subject] + '("Sort by Subject" . gnus-summary-sort-by-subject)) + + (define-key gnus-summary-mode-map [menu-bar show/hide] + (cons "Show/Hide" (make-sparse-keymap "show/hide"))) + + (define-key gnus-summary-mode-map [menu-bar show/hide hide-all-threads] + '("Hide All Threads" . gnus-summary-hide-all-threads)) + (define-key gnus-summary-mode-map [menu-bar show/hide hide-thread] + '("Hide Thread" . gnus-summary-hide-thread)) + (define-key gnus-summary-mode-map [menu-bar show/hide show-all-threads] + '("Show All Threads" . gnus-summary-show-all-threads)) + (define-key gnus-summary-mode-map [menu-bar show/hide show-all-headers] + '("Show All Headers" . gnus-summary-show-all-headers)) + (define-key gnus-summary-mode-map [menu-bar show/hide show-thread] + '("Show Thread" . gnus-summary-show-thread)) + (define-key gnus-summary-mode-map [menu-bar show/hide show-article] + '("Show Article" . gnus-summary-show-article)) + (define-key gnus-summary-mode-map [menu-bar show/hide toggle-truncation] + '("Toggle Truncation" . gnus-summary-toggle-truncation)) + (define-key gnus-summary-mode-map [menu-bar show/hide toggle-mime] + '("Toggle Mime" . gnus-summary-toggle-mime)) + (define-key gnus-summary-mode-map [menu-bar show/hide toggle-header] + '("Toggle Header" . gnus-summary-toggle-header)) + + (define-key gnus-summary-mode-map [menu-bar action] + (cons "Action" (make-sparse-keymap "action"))) + + (define-key gnus-summary-mode-map [menu-bar action kill-same-subject] + '("Kill Same Subject" . gnus-summary-kill-same-subject)) + (define-key gnus-summary-mode-map [menu-bar action kill-thread] + '("Kill Thread" . gnus-summary-kill-thread)) + (define-key gnus-summary-mode-map [menu-bar action delete-marked-with] + '("Delete Marked With" . gnus-summary-delete-marked-with)) + (define-key gnus-summary-mode-map [menu-bar action delete-marked-as-read] + '("Delete Marked As Read" . gnus-summary-delete-marked-as-read)) + (define-key gnus-summary-mode-map [menu-bar action catchup-and-exit] + '("Catchup And Exit" . gnus-summary-catchup-and-exit)) + (define-key gnus-summary-mode-map [menu-bar action catchup-to-here] + '("Catchup to Here" . gnus-summary-catchup-to-here)) + + (define-key gnus-summary-mode-map [menu-bar action ignore] + '("---")) + + (define-key gnus-summary-mode-map [menu-bar action save-in-file] + '("Save in File" . gnus-summary-save-in-file)) + (define-key gnus-summary-mode-map [menu-bar action save-article] + '("Save Article" . gnus-summary-save-article)) + + (define-key gnus-summary-mode-map [menu-bar action lambda] + '("---")) + + (define-key gnus-summary-mode-map [menu-bar action forward] + '("Forward" . gnus-summary-mail-forward)) + (define-key gnus-summary-mode-map [menu-bar action followup-with-original] + '("Followup with Original" . gnus-summary-followup-with-original)) + (define-key gnus-summary-mode-map [menu-bar action followup] + '("Followup" . gnus-summary-followup)) + (define-key gnus-summary-mode-map [menu-bar action reply-with-original] + '("Reply with Original" . gnus-summary-reply-with-original)) + (define-key gnus-summary-mode-map [menu-bar action reply] + '("Reply" . gnus-summary-reply)) + (define-key gnus-summary-mode-map [menu-bar action post] + '("Post News" . gnus-summary-post-news)) + + (define-key gnus-summary-mode-map [menu-bar move] + (cons "Move" (make-sparse-keymap "move"))) + + (define-key gnus-summary-mode-map [menu-bar move isearch-article] + '("Search in Article" . gnus-summary-isearch-article)) + (define-key gnus-summary-mode-map [menu-bar move search-through-articles] + '("Search through Articles" . gnus-summary-search-article-forward)) + (define-key gnus-summary-mode-map [menu-bar move down-thread] + '("Down Thread" . gnus-summary-down-thread)) + (define-key gnus-summary-mode-map [menu-bar move prev-same-subject] + '("Prev Same Subject" . gnus-summary-prev-same-subject)) + (define-key gnus-summary-mode-map [menu-bar move prev-group] + '("Prev Group" . gnus-summary-prev-group)) + (define-key gnus-summary-mode-map [menu-bar move next-unread-same-subject] + '("Next Unread Same Subject" . gnus-summary-next-unread-same-subject)) + (define-key gnus-summary-mode-map [menu-bar move next-unread-article] + '("Next Unread Article" . gnus-summary-next-unread-article)) + (define-key gnus-summary-mode-map [menu-bar move next-thread] + '("Next Thread" . gnus-summary-next-thread)) + (define-key gnus-summary-mode-map [menu-bar move next-group] + '("Next Group" . gnus-summary-next-group)) + (define-key gnus-summary-mode-map [menu-bar move first-unread-article] + '("First Unread Article" . gnus-summary-first-unread-article)) + ) + + +(defun gnus-summary-mode () + "Major mode for reading articles in this newsgroup. +All normal editing commands are switched off. +The following commands are available: + +\\ +\\[gnus-summary-next-page]\t Scroll the article buffer a page forwards +\\[gnus-summary-prev-page]\t Scroll the article buffer a page backwards +\\[gnus-summary-scroll-up]\t Scroll the article buffer one line forwards +\\[gnus-summary-next-unread-article]\t Go to the next unread article +\\[gnus-summary-prev-unread-article]\t Go to the previous unread article +\\[gnus-summary-next-article]\t Go to the next article +\\[gnus-summary-prev-article]\t Go to the previous article +\\[gnus-summary-next-same-subject]\t Go to the next summary line with the same subject +\\[gnus-summary-prev-same-subject]\t Go to the previous summary line with the same subject +\\[gnus-summary-next-digest]\t Go to the next digest +\\[gnus-summary-prev-digest]\t Go to the previous digest +\\[gnus-summary-next-subject]\t Go to the next summary line +\\[gnus-summary-prev-subject]\t Go to the previous summary line +\\[gnus-summary-next-unread-subject]\t Go to the next unread summary line +\\[gnus-summary-prev-unread-subject]\t Go to the previous unread summary line +\\[gnus-summary-first-unread-article]\t Go to the first unread article +\\[gnus-summary-goto-subject]\t Go to some subject +\\[gnus-summary-goto-last-article]\t Go to the previous article + +\\[gnus-summary-beginning-of-article]\t Go to the beginning of the article +\\[gnus-summary-end-of-article]\t Go to the end of the article + +\\[gnus-summary-refer-parent-article]\t Get the parent of the current article from the server +\\[gnus-summary-refer-article]\t Request some article by Message-ID from the server + +\\[gnus-summary-isearch-article]\t Do an interactive search on the current article +\\[gnus-summary-search-article-forward]\t Search all articles forward for a regular expression +\\[gnus-summary-search-article-backward]\t Search all articles backward for a regular expression + +\\[gnus-summary-tick-article-forward]\t Tick current article and move forward +\\[gnus-summary-tick-article-backward]\t Tick current article and move backward +\\[gnus-summary-mark-as-read-forward]\t Mark the current article as read and move forward +\\[gnus-summary-mark-as-read-backward]\t Mark the current article as read and move backward +\\[gnus-summary-clear-mark-forward]\t Clear tick and read marks and move forward +\\[gnus-summary-clear-mark-backward]\t Clear tick and read marks and move backward +\\[gnus-summary-mark-as-processable]\t Set the process mark on the current article +\\[gnus-summary-unmark-as-processable]\t Remove the process mark from the current article +\\[gnus-summary-unmark-all-processable]\t Remove the process mark from all articles + +\\[gnus-summary-kill-same-subject-and-select]\t Kill all articles with the current subject and select the next article +\\[gnus-summary-kill-same-subject]\t Kill all articles with the current subject + +\\[gnus-summary-toggle-threads]\t Toggle thread display +\\[gnus-summary-show-thread]\t Show the current thread +\\[gnus-summary-hide-thread]\t Hide the current thread +\\[gnus-summary-next-thread]\t Go to the next thread +\\[gnus-summary-prev-thread]\t Go to the previous thread +\\[gnus-summary-up-thread]\t Go up the current thread +\\[gnus-summary-down-thread]\t Descend the current thread +\\[gnus-summary-kill-thread]\t Kill the current thread +\\[gnus-summary-mark-as-expirable]\t Mark the current artivles as expirable +\\[gnus-summary-unmark-as-expirable]\t Remove the expirable mark from the current article +\\[gnus-summary-delete-marked-as-read]\t Delete all articles that are marked as read +\\[gnus-summary-delete-marked-with]\t Delete all articles that have some mark + +\\[gnus-summary-execute-command]\t Execute a command +\\[gnus-summary-catchup-and-exit]\t Mark all unread articles as read and exit +\\[gnus-summary-toggle-truncation]\t Toggle truncation of summary lines +\\[gnus-summary-expand-window]\t Expand the summary window + +\\[gnus-summary-sort-by-number]\t Sort the Summary buffer by article number +\\[gnus-summary-sort-by-author]\t Sort the Summary buffer by author +\\[gnus-summary-sort-by-subject]\t Sort the Summary buffer by subject +\\[gnus-summary-sort-by-date]\t Sort the Summary buffer by date + +\\[gnus-summary-reselect-current-group]\t Exit and reselect the current group +\\[gnus-summary-rescan-group]\t Exit, get new articles and reselect the group +\\[gnus-summary-stop-page-breaking]\t Stop page breaking of the current article +\\[gnus-summary-caesar-message]\t Caesar rotate (rot13) the current article +\\[gnus-summary-show-article]\t Reselect the current article +\\[gnus-summary-toggle-header]\t Toggle header display +\\[gnus-summary-toggle-mime]\t Toggle whether to use MIME +\\[gnus-summary-rmail-digest]\t Use rmail digest +\\[gnus-summary-post-news]\t Post an article to the current group +\\[gnus-summary-followup]\t Post a followup to the current article +\\[gnus-summary-followup-with-original]\t Post a followup and include the original article +\\[gnus-summary-cancel-article]\t Cancel the current article +\\[gnus-summary-supersede-article]\t Supersede the current article +\\[gnus-summary-reply]\t Mail a reply to the author of the current article +\\[gnus-summary-reply-with-original]\t Mail a reply and include the current article +\\[gnus-summary-mail-forward]\t Forward the current article +\\[gnus-summary-mail-other-window]\t Mail in the other window +\\[gnus-summary-save-article]\t Save the current article +\\[gnus-summary-save-article-rmail]\t Save the current article in rmail format +\\[gnus-summary-pipe-output]\t Pipe the current article to a process +\\[gnus-summary-move-article]\t Move the article to a different newsgroup +\\[gnus-summary-respool-article]\t Respool the article +\\[gnus-summary-edit-local-kill]\t Edit the local kill file +\\[gnus-summary-edit-global-kill]\t Edit the global kill file +\\[gnus-version]\t Display the current Gnus version +\\[gnus-summary-exit]\t Exit the Summary buffer +\\[gnus-summary-quit]\t Exit the Summary buffer without saving any changes +\\[gnus-summary-describe-group]\t Describe the current newsgroup +\\[gnus-summary-describe-briefly]\t Give a brief key overview +\\[gnus-info-find-node]\t Go to the Gnus info node +\\[gnus-kill-file-kill-by-subject]\t Kill articles with the current subject +\\[gnus-kill-file-kill-by-author]\t Kill articles from the current author +\\[gnus-kill-file-kill-by-thread]\t Kill articles in the current thread +\\[gnus-kill-file-kill-by-xref]\t Kill articles with the current cross-posting +" + (interactive) + (kill-all-local-variables) + (let ((locals gnus-summary-local-variables)) + (while locals + (make-local-variable (car locals)) + (set (car locals) nil) + (setq locals (cdr locals)))) + (gnus-update-format-specifications) + (setq mode-line-modified "--- ") + (setq major-mode 'gnus-summary-mode) + (setq mode-name "Summary") + (make-local-variable 'minor-mode-alist) + (or (assq 'gnus-show-threads minor-mode-alist) + (setq minor-mode-alist + (cons (list 'gnus-show-threads " Thread") minor-mode-alist))) + (gnus-set-mode-line 'summary) + (use-local-map gnus-summary-mode-map) + (buffer-disable-undo (current-buffer)) + (setq buffer-read-only t) ;Disable modification + (setq truncate-lines t) + (setq selective-display t) + (setq selective-display-ellipses t) ;Display `...' + (run-hooks 'gnus-summary-mode-hook)) + +(defun gnus-mouse-pick-article (e) + (interactive "e") + (mouse-set-point e) + (gnus-summary-next-page nil)) + +(defun gnus-summary-setup-buffer (group) + "Initialize Summary buffer." + (let ((buffer (concat "*Summary " group "*"))) + ;; Fix by Sudish Joseph + (setq gnus-summary-buffer (set-buffer (get-buffer-create buffer))) + (gnus-add-current-to-buffer-list) + (gnus-summary-mode))) + +(defun gnus-summary-insert-dummy-line (sformat subject number) + (if (not sformat) + (setq sformat gnus-summary-dummy-line-format-spec)) + (let (b) + (beginning-of-line) + (insert (eval sformat)) + (forward-char -1) + (setq b (point)) + (insert (format "%s Z %d 0" subject number)) + (set-text-properties b (point) '(invisible t)) + (forward-char 1))) + +(defun gnus-summary-insert-line + (sformat header level current unread replied expirable print-subject + &optional dummy) + (if (not sformat) + (setq sformat gnus-summary-line-format-spec)) + (let* ((thread-space (if (< level 1) "" (make-string (frame-width) ? ))) + (indentation + (make-string (* level gnus-thread-indent-level) ? )) + (lines (or (header-lines header) 0)) + (current (if current ?+ ? )) + (replied (if replied ?R ? )) + (expirable (if expirable ?X ? )) + (from (header-from header)) + (name-address (gnus-extract-address-components from)) + (address (cdr name-address)) + (name (car name-address)) + (number (header-number header)) + (subject (header-subject header)) + (subject-or-nil (if print-subject subject "")) + (buffer-read-only nil) + (closing-bracket (if dummy ?= ?\])) + (opening-bracket (if dummy ?= ?\[)) + b) + ;; Suggested by Brian Edmonds . + (if (not (numberp lines)) (setq lines 0)) + (beginning-of-line) + (insert (eval sformat)) + (forward-char -1) + (setq b (point)) + ;; Info format SUBJECT UNREAD NUMBER LEVEL + (insert (format "%s %c %d %d" (gnus-simplify-subject-re subject) + unread number level)) + (set-text-properties b (point) '(invisible t)) + (forward-char 1))) + +(defun gnus-summary-read-group (group &optional show-all no-article kill-buffer) + "Start reading news in newsgroup GROUP. +If SHOW-ALL is non-nil, already read articles are also listed. +If NO-ARTICLE is non-nil, no article is selected initially." + (message "Retrieving newsgroup: %s..." (gnus-group-real-name group)) + (gnus-summary-setup-buffer group) + (if (gnus-select-newsgroup group show-all) + (progn + ;; You can change the order of subjects in this hook. + (run-hooks 'gnus-select-group-hook) + (gnus-summary-prepare) + (let ((killed + (gnus-add-to-range + gnus-newsgroup-killed + (setq gnus-newsgroup-unreads + (sort gnus-newsgroup-unreads (function <))))) + (gnus-newsgroup-killed + (if gnus-kill-killed nil gnus-newsgroup-killed))) + (if (not (consp (car killed))) (setq killed (list killed))) + ;; Function `gnus-apply-kill-file' must be called in this hook. + (run-hooks 'gnus-apply-kill-hook) + (setq gnus-newsgroup-killed killed)) + (if (zerop (buffer-size)) + ;; This newsgroup is empty. + (progn + (gnus-summary-catchup-and-exit nil t) ;Without confirmations. + (message "No unread news")) + ;; Hide conversation thread subtrees. We cannot do this in + ;; gnus-summary-prepare-hook since kill processing may not + ;; work with hidden articles. + (and gnus-show-threads + gnus-thread-hide-subtree + (gnus-summary-hide-all-threads)) + ;; Show first unread article if requested. + (goto-char (point-min)) + (if (and (not no-article) + gnus-auto-select-first + (gnus-summary-first-unread-article)) + ;; Window is configured automatically. + ;; Current buffer may be changed as a result of hook + ;; evaluation, especially by gnus-summary-rmail-digest + ;; command, so we should adjust cursor point carefully. + (if (eq major-mode 'gnus-summary-mode) + (gnus-summary-position-cursor)) + (gnus-configure-windows 'summary) + (pop-to-buffer gnus-summary-buffer) + (gnus-set-mode-line 'summary) + (gnus-summary-position-cursor)) + (if (and kill-buffer + (get-buffer kill-buffer) + ;; Bug by Sudish Joseph + (buffer-name (get-buffer kill-buffer))) + (progn + (kill-buffer (get-buffer kill-buffer)))))) + ;; Cannot select newsgroup GROUP. + (message "Couldn't select newsgroup") + (gnus-summary-position-cursor))) + +(defun gnus-summary-prepare () + "Prepare summary list of current newsgroup in Summary buffer." + (let ((buffer-read-only nil)) + (erase-buffer) + (gnus-summary-prepare-threads + (if gnus-show-threads + (gnus-gather-threads (gnus-make-threads)) + gnus-newsgroup-headers) + 0) + (gnus-summary-delete-interesting) + ;; Erase header retrieval message. + (message "") + ;; Call hooks for modifying Summary buffer. + ;; Suggested by sven@tde.LTH.Se (Sven Mattisson). + (goto-char (point-min)) + (run-hooks 'gnus-summary-prepare-hook))) + +(defun gnus-summary-delete-interesting () + (let ((int gnus-newsgroup-interesting) + (buffer-read-only nil) + beg cur-level) + (while int + (if (gnus-summary-goto-subject (car int)) + (progn + (beginning-of-line) + (setq cur-level (gnus-summary-thread-level)) + (setq beg (point)) + (re-search-forward "[\n\r]") + (if (<= (gnus-summary-thread-level) cur-level) + ;; If the level of the next article is greater than the + ;; level of this article, then it has to be the child of this + ;; article, so we do not delete this article. + (progn + (setq gnus-newsgroup-interesting-subjects + (cons (cons (car int) (buffer-substring beg (point))) + gnus-newsgroup-interesting-subjects)) + (delete-region beg (point)))))) + (setq int (cdr int))))) + +(defun gnus-gather-threads (threads) + "Gather threads that have lost their roots." + (if (not gnus-gather-loose-threads) + threads + (let ((hashtb (gnus-make-hashtable 1023)) + (prev threads) + (result threads) + thread subject hthread) + (while threads + (setq subject (header-subject (car (car threads)))) + (if (setq hthread (gnus-gethash subject hashtb)) + (progn + (if (not (stringp (car (car hthread)))) + (setcar hthread (list subject (car hthread)))) + (setcar hthread + (append (car hthread) (cons (car threads) nil))) + (setcdr prev (cdr threads)) + (setq threads prev)) + (gnus-sethash subject threads hashtb)) + (setq prev threads) + (setq threads (cdr threads))) + result))) + +(defun gnus-make-threads () + ;; This function takes the dependencies already made by + ;; `gnus-get-newsgroup-headers' and builds the trees. First we go + ;; through the dependecies in the hash table and finds all the + ;; roots. Roots do not refer back to any valid articles. + (let (roots mroots) + (mapatoms + (lambda (refs) + (if (not (car (symbol-value refs))) + (setq mroots (nconc (cdr (symbol-value refs)) mroots)) + ;; Ok, these refer back to valid articles, but if + ;; `gnus-thread-ignore-subject' is nil, we have to check that + ;; the root has the same subject as its children. The clidren + ;; that do not are made into roots and remove from the list + ;; of children. + (or gnus-thread-ignore-subject + (let* ((prev (symbol-value refs)) + (subject (gnus-simplify-subject-re + (header-subject (car prev)))) + (headers (cdr prev))) + (while headers + (if (not (string= subject + (gnus-simplify-subject-re + (header-subject (car headers))))) + (progn + (setq mroots (cons (car headers) mroots)) + (setcdr prev (cdr headers)))) + (setq prev headers + headers (cdr headers))))))) + gnus-newsgroup-dependencies) + + ;; We sort the roots according to article number. (This has to be + ;; done because all sequencing information was lost when we built + ;; the dependecies hash table.) + (setq roots + (sort + mroots + (lambda (h1 h2) + (< (header-number h1) (header-number h2))))) + ;; Now we have all the roots, so we go through all them all and + ;; build the trees. + (mapcar (lambda (root) (gnus-make-sub-thread root)) roots))) + +(defun gnus-make-sub-thread (root) + ;; This function makes a sub-tree for a node in the tree. + (let ((children (nreverse (cdr (gnus-gethash (header-id root) + gnus-newsgroup-dependencies))))) + (if (not children) + (list root) + (cons root (mapcar + (lambda (top) (gnus-make-sub-thread top)) children))))) + +;; Basic ideas by Paul Dworkin +;; Subject bug fix by jbw@bigbird.bu.edu (Joe Wells) +(defun gnus-summary-prepare-threads (threads level &optional not-child) + "Prepare Summary buffer from THREADS and indentation LEVEL. +THREADS is either a list of `(PARENT [(CHILD1 [(GRANDCHILD ...]...) ...])' +or a straight list of headers." + (let ((old-subject "") + thread header number subject clevel) + (while threads + (setq thread (car threads)) + (setq threads (cdr threads)) + ;; If `thread' is a cons, hierarchical threads are used. If not, + ;; `thread' is the header. + (if (consp thread) + (setq header (car thread)) + (setq header thread)) + (if (stringp header) + ;; The header is a dummy root. + (progn + (cond ((eq gnus-summary-make-false-root 'dummy) + ;; We output a dummy root. + (gnus-summary-insert-dummy-line + nil header (header-number (car (car (cdr thread))))) + (setq clevel 1)) + ((eq gnus-summary-make-false-root 'adopt) + ;; We let the first article adopt the rest. + (gnus-summary-prepare-threads (list (car (cdr thread))) 0) + (setq thread (cdr (cdr thread))) + (while thread + (gnus-summary-prepare-threads (list (car thread)) 1 t) + (setq thread (cdr thread)))) + (t + ;; We do not make a root for the gathered + ;; sub-threads at all. + (setq clevel 0))) + ;; Print the sub-threads. + (and (consp thread) + (cdr thread) + (gnus-summary-prepare-threads + (cdr thread) clevel))) + ;; The header is a real article. + (setq number (header-number header)) + (setq subject (header-subject header)) + (gnus-summary-insert-line + nil header level nil + (cond ((memq number gnus-newsgroup-marked) ?-) + ((memq number gnus-newsgroup-interesting) ?I) + ((memq number gnus-newsgroup-unreads) ? ) + (t ?D)) + (memq number gnus-newsgroup-replied) + (memq number gnus-newsgroup-expirable) + (or (= level 0) + (and gnus-thread-ignore-subject + (not (string= (gnus-simplify-subject-re old-subject) + (gnus-simplify-subject-re subject))))) + not-child) + (setq old-subject subject) + ;; Recursively print subthreads. + (and (consp thread) + (cdr thread) + (gnus-summary-prepare-threads + (cdr thread) (1+ level))))))) + +(defun gnus-select-newsgroup (group &optional show-all) + "Select newsgroup GROUP. +If SHOW-ALL is non-nil, all articles in the group are selected." + (let* ((entry (gnus-gethash group gnus-newsrc-hashtb)) + (real-group (gnus-group-real-name group)) + (info (nth 2 entry)) + articles header-marks) + (if (eq (car entry) t) + (or (if (nth 4 info) + (gnus-activate-foreign-newsgroup info) + (gnus-activate-newsgroup (car info))) + (error "Couldn't request newsgroup %s" group))) + (setq gnus-current-select-method (or (nth 4 info) + gnus-select-method)) + (gnus-check-news-server (nth 4 info)) + (if (not (gnus-request-group group t)) + (error "Couldn't request newsgroup %s" group)) + (setq gnus-newsgroup-name group) + (setq gnus-newsgroup-unselected nil) + (setq gnus-newsgroup-unreads (gnus-list-of-unread-articles group)) + (cond (show-all + ;; Select all active articles. + (setq articles (gnus-uncompress-sequence + (gnus-gethash group gnus-active-hashtb)))) + (t + ;; Select unread articles only. + (setq articles gnus-newsgroup-unreads))) + ;; Require confirmation if selecting large newsgroup. + (if (not (numberp gnus-large-newsgroup)) + nil + (let ((number (length articles)) + selected break) + (if (> number gnus-large-newsgroup) + (progn + (condition-case () + (let ((input + (read-string + (format + "How many articles from %s (default %d): " + gnus-newsgroup-name number)))) + (setq selected + (if (string-equal input "") + number (string-to-int input)))) + (quit + (setq selected 0))) + (if (< (abs selected) number) + (progn + (cond + ((< selected 0) + ;; Select the N oldest articles. + (setq articles (copy-sequence articles)) + (setq break (nthcdr (1- (abs selected)) articles)) + (setq gnus-newsgroup-unselected + (gnus-intersection + (cdr break) + gnus-newsgroup-unreads)) + (setcdr break nil)) + ((> selected 0) + ;; Select the N most recent articles. + (setq gnus-newsgroup-unselected + (copy-sequence articles)) + (setq break (nthcdr (- number (1+ selected)) + gnus-newsgroup-unselected)) + (setq articles (cdr break)) + (setcdr break nil) + (setq gnus-newsgroup-unselected + (gnus-intersection + gnus-newsgroup-unselected + gnus-newsgroup-unreads))) + + (t + ;; Select no articles. + (setq gnus-newsgroup-unselected articles) + (setq articles nil))))))) + )) + (if (not articles) + nil + ;; Create the list of headers from the headers. + (setq gnus-newsgroup-headers + (if (eq (gnus-retrieve-headers articles gnus-newsgroup-name) 'nov) + (progn + (gnus-get-newsgroup-headers-xover articles)) + (gnus-get-newsgroup-headers))) + ;; Remove cancelled articles from the list of unread articles. + (setq gnus-newsgroup-unreads + (gnus-intersection gnus-newsgroup-unreads + (mapcar + (lambda (headers) + (header-number headers)) + gnus-newsgroup-headers))) + ;; Ticked articles must be a subset of unread articles. + (if info + (progn + (gnus-adjust-marked-articles info) + (setq gnus-newsgroup-marked (cdr (assq 'tick (nth 3 info)))) + (setq gnus-newsgroup-replied (cdr (assq 'reply (nth 3 info)))) + (setq gnus-newsgroup-expirable (cdr (assq 'expire (nth 3 info)))) + (setq gnus-newsgroup-killed (cdr (assq 'killed (nth 3 info)))) + (setq gnus-newsgroup-bookmarks (cdr (assq 'bookmark (nth 3 info)))) + (setq gnus-newsgroup-interesting (cdr (assq 'interesting (nth 3 info)))) + (setq gnus-newsgroup-processable nil))) + ;; Check whether auto-expire is to be done in this group. + (setq gnus-newsgroup-auto-expire + (and (stringp gnus-auto-expirable-newsgroups) + (string-match gnus-auto-expirable-newsgroups real-group))) + ;; First and last article in this newsgroup. + (setq gnus-newsgroup-begin + (if gnus-newsgroup-headers + (header-number (car gnus-newsgroup-headers)) + 0)) + (setq gnus-newsgroup-end + (if gnus-newsgroup-headers + (header-number (gnus-last-element gnus-newsgroup-headers)) + 0)) + ;; File name of the last saved article. + (setq gnus-newsgroup-last-rmail nil) + (setq gnus-newsgroup-last-mail nil) + (setq gnus-newsgroup-last-folder nil) + (setq gnus-newsgroup-last-file nil) + ;; Reset article pointers etc. + (setq gnus-current-article nil) + (setq gnus-current-headers nil) + (setq gnus-have-all-headers nil) + (setq gnus-last-article nil) + (setq gnus-xref-hashtb nil) + (setq gnus-reffed-article-number -1) + (setq gnus-newsgroup-headers-hashtb-by-number nil) + ;; Update the format specifiers. + (gnus-update-format-specifications) + ;; GROUP is successfully selected. + t))) + +(defun gnus-adjust-marked-articles (info) + "Remove all marked articles that are no longer legal." + (let ((marked-lists (nth 3 info)) + (active (gnus-gethash (car info) gnus-active-hashtb)) + marked m prev) + ;; There are four types of marked articles - ticked, replied, + ;; expirable and interesting. + (while marked-lists + (setq m (cdr (setq prev (car marked-lists)))) + (cond ((or (eq 'tick (car prev)) (eq 'interesting (car prev))) + ;; Make sure that all ticked articles are a subset of the + ;; unread/unselected articles. + (while m + (if (or (memq (car m) gnus-newsgroup-unreads) + (memq (car m) gnus-newsgroup-unselected)) + (setq prev m) + (setcdr prev (cdr m))) + (setq m (cdr m)))) + ((eq 'bookmark (car prev)) + ;; Bookmarks should be a subset of active articles. + (while m + (if (< (car (car m)) (car active)) + (setcdr prev (cdr m)) + (setq prev m)) + (setq m (cdr m)))) + ((eq 'killed (car prev)) + ;; Articles that have been through the kill process are + ;; to be a subset of active articles. + (while (and m (< (cdr (car m)) (car active))) + (setcdr prev (cdr m))) + (if (and m (< (car (car m)) (car active))) + (setcar (car m) (car active)))) + ((or (eq 'reply (car marked)) (eq 'expire (car marked))) + ;; The replied and expirable articles have to be articles + ;; that are active. + (while m + (if (< (car m) (car active)) + (setcdr prev (cdr m)) + (setq prev m)) + (setq m (cdr m))))) + (setq marked-lists (cdr marked-lists))) + ;; Remove all lists that are empty. + (setq marked-lists (nth 3 info)) + (if marked-lists + (progn + (while (= 1 (length (car marked-lists))) + (setq marked-lists (cdr marked-lists))) + (setq m (cdr (setq prev marked-lists))) + (while m + (if (= 1 (length (car m))) + (setcdr prev (cdr m)) + (setq prev m)) + (setq m (cdr m))) + (setcar (nthcdr 3 info) marked-lists))) + ;; Finally, if there are no marked lists at all left, and if there + ;; are no elements after the lists in the info list, we just chop + ;; the info list off before the marked lists. + (if (and (null marked-lists) (not (nthcdr 4 info))) + (setcdr (nthcdr 2 info) nil))) + info) + +(defun gnus-set-marked-articles + (info ticked replied expirable killed interesting bookmark) + "Enter the various lists of marked articles into the newsgroup info list." + (let (newmarked) + (if ticked + (setq newmarked (cons (cons 'tick ticked) nil))) + (if replied + (setq newmarked (cons (cons 'reply replied) newmarked))) + (if expirable + (setq newmarked (cons (cons 'expire expirable) newmarked))) + (if killed + (setq newmarked (cons (cons 'killed killed) newmarked))) + (if interesting + (setq newmarked (cons (cons 'interesting interesting) newmarked))) + (if bookmark + (setq newmarked (cons (cons 'bookmark bookmark) newmarked))) + (if (nthcdr 3 info) + (if newmarked + (setcar (nthcdr 3 info) newmarked) + (if (not (nthcdr 4 info)) + (setcdr (nthcdr 2 info) nil) + (setcar (nthcdr 3 info) nil))) + (if newmarked + (setcdr (nthcdr 2 info) (cons newmarked nil)))))) + +(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." + (if (memq where gnus-updated-mode-lines) + (let (mode-string) + (save-excursion + (set-buffer gnus-summary-buffer) + (let* ((mformat (if (eq where 'article) + gnus-article-mode-line-format-spec + gnus-summary-mode-line-format-spec)) + (group-name gnus-newsgroup-name) + (article-number (or gnus-current-article 0)) + (unread (length gnus-newsgroup-unreads)) + (unselected (length gnus-newsgroup-unselected)) + (unread-and-unselected + (cond ((and (zerop unread) (zerop unselected)) "") + ((zerop unselected) (format "{%d more}" unread)) + (t (format "{%d(+%d) more}" unread unselected)))) + (subject + (if gnus-current-headers + (header-subject gnus-current-headers) "")) + (max-len (if (eq where 'summary) 45 52))) + (setq mode-string (eval mformat)) + (if (> (length mode-string) max-len) + (setq mode-string + (concat (substring mode-string 0 (- max-len 4)) "..."))) + (setq mode-string (format (format "%%-%ds" max-len) mode-string)))) + (setq mode-line-buffer-identification mode-string) + (set-buffer-modified-p t)))) + +(defun gnus-create-xref-hashtb (from-newsgroup headers unreads) + "Go through the HEADERS list and add all Xrefs to a hash table. +The resulting hash table is returned, or nil if no Xrefs were found." + (let ((prefix (if (and + (string-match gnus-foreign-group-prefix from-newsgroup) + (not (eq 'nnvirtual (car gnus-current-select-method)))) + gnus-foreign-group-prefix)) + (xref-hashtb (make-vector 63 0)) + start group entry number xrefs header) + (while headers + (setq header (car headers)) + (if (and (setq xrefs (header-xref header)) + (not (memq (header-number header) unreads))) + (progn + (setq start 0) + (while (string-match "\\([^ :]+\\):\\([0-9]+\\)" xrefs start) + (setq start (match-end 0)) + (setq group (concat prefix (substring xrefs (match-beginning 1) + (match-end 1)))) + (setq number + (string-to-int (substring xrefs (match-beginning 2) + (match-end 2)))) + (if (setq entry (gnus-gethash group xref-hashtb)) + (setcdr entry (cons number (cdr entry))) + (gnus-sethash group (cons number nil) xref-hashtb))))) + (setq headers (cdr headers))) + (if start xref-hashtb nil))) + +(defun gnus-mark-xrefs-as-read (from-newsgroup headers unreads) + "Look through all the headers and mark the Xrefs as read." + (let (name entry read info xref-hashtb idlist active num range) + (set-buffer gnus-group-buffer) + (if (setq xref-hashtb + (gnus-create-xref-hashtb from-newsgroup headers unreads)) + (mapatoms + (lambda (group) + (if (string= from-newsgroup (setq name (symbol-name group))) + () + (setq idlist (symbol-value group)) + ;; Dead groups are not updated. + (if (and (setq entry (gnus-gethash name gnus-newsrc-hashtb)) + ;; Only do the xrefs if the group has the same + ;; select method as the group we have just read. + (or (and (not (nth 4 (setq info (nth 2 entry)))) + (eq gnus-current-select-method + gnus-select-method)) + (eq (car gnus-current-select-method) 'nnvirtual) + (equal (nth 4 info) + gnus-current-select-method))) + (progn + (setq num 0) + ;; Set the new list of read articles in this group. + (setcar (nthcdr 2 info) + (setq range + (gnus-add-to-range + (nth 2 info) + (setq idlist (sort idlist '<))))) + ;; Then we have to re-compute how many unread + ;; articles there are in this group. + (if (setq active (gnus-gethash name gnus-active-hashtb)) + (progn + (if (atom (car range)) + (progn + (setq num (- (cdr active) (- (1+ (cdr range)) + (car range)))) + (if (< num 0) (setq num 0))) + (while range + (setq num (+ num (- (1+ (cdr (car range))) + (car (car range))))) + (setq range (cdr range))) + (setq num (- (cdr active) num))) + ;; Update the number of unread articles. + (setcar entry num) + ;; Update the Newsgroup buffer. + (gnus-group-update-group name t))))))) + xref-hashtb)))) + +(defsubst gnus-header-value () + (buffer-substring (match-end 0) (save-excursion (end-of-line) (point)))) + +;; Felix Lee function with jwz rewrites (and some lmi rewrites to boot). +;; Goes through the newsgroups headers and returns a list of arrays: +(defun gnus-get-newsgroup-headers () + (setq gnus-article-internal-prepare-hook nil) + (save-excursion + (let ((cur nntp-server-buffer) + (dependencies (gnus-make-hashtable (length gnus-newsgroup-unreads))) + headers header subject from char c article unreads in-reply-to + references end-header id dep ref end) + (set-buffer nntp-server-buffer) + (goto-char 1) + (while (re-search-forward "^[23][0-9]+ \\([0-9]+\\)" nil t) + (setq from nil + subject nil + in-reply-to nil + references nil + ref nil + header (make-vector 9 nil) + c (following-char)) + (goto-char (match-beginning 1)) + (header-set-number + header (setq article (read cur))) + (setq end-header (save-excursion (search-forward "\n.\n" nil t))) + (while (re-search-forward "^\\(from\\|subject\\|message-id\\|date\\|lines\\|xref\\|references\\|in-reply-to\\): " + end-header t) + (beginning-of-line) + (setq char (downcase (following-char))) + (cond + ((eq char ?s) + (header-set-subject header + (setq subject (gnus-header-value)))) + ((eq char ?f) + (header-set-from header (setq from (gnus-header-value)))) + ((eq char ?x) + (header-set-xref header (gnus-header-value))) + ((eq char ?l) + (header-set-lines header + (string-to-int (gnus-header-value)))) + ((eq char ?d) + (header-set-date header (gnus-header-value))) + ((eq char ?m) + (header-set-id header (setq id (gnus-header-value)))) + ((eq char ?r) + (setq references (gnus-header-value)) + (setq end (match-end 0)) + (save-excursion + (setq ref + (buffer-substring + (progn + (end-of-line) + (search-backward ">" end t) + (1+ (point))) + (progn + (search-backward "<" end t) + (point)))))) + ((eq char ?i) + (setq in-reply-to (gnus-header-value)))) + (forward-line 1)) + (if references + (header-set-references header references) + (and in-reply-to + (string-match "<[^>]+>" in-reply-to) + (header-set-references + header + (substring in-reply-to (match-beginning 0) + (match-end 0))))) + (or subject (header-set-subject header "(none)")) + (or from (header-set-from header "(nobody)")) + ;; We build the thread tree. + (if (boundp (setq dep (intern id dependencies))) + (setcar (symbol-value dep) header) + (set dep (list header))) + (if (boundp (setq dep (intern (or ref "none") dependencies))) + (setcdr (symbol-value dep) + (cons header (cdr (symbol-value dep)))) + (set dep (list nil header))) + (setq headers (cons header headers)) + (forward-line -1) + (search-forward "\n.\n" nil t)) + (setq gnus-newsgroup-dependencies dependencies) + (nreverse headers)))) + +;; The following macros and functions were written by Felix Lee +;; . + +;; This is almost 4x faster than (string-to-int (buffer-substring ... )) +;; primarily because of garbage collection. -jwz +(defmacro gnus-read-integer (&optional point move-p) + (` ((, (if move-p 'progn 'save-excursion)) + (,@ (if point (list (list 'goto-char point)))) + (if (and (<= (following-char) ?9) + (>= (following-char) ?0)) + (read (current-buffer)) + 0)))) + +(defmacro gnus-nov-skip-field () + '(search-forward "\t" eol 'end)) + +(defmacro gnus-nov-field () + '(buffer-substring + (point) + (progn (gnus-nov-skip-field) (1- (point))))) + +;; Goes through the xover lines and returns a list of vectors +(defun gnus-get-newsgroup-headers-xover (sequence) + "Parse the news overview data in the server buffer, and return a +list of headers that match SEQUENCE (see `nntp-retrieve-headers')." + ;; Get the Xref when the users reads the articles since most/some + ;; NNTP servers do not include Xrefs when using XOVER. + (setq gnus-article-internal-prepare-hook '(gnus-article-get-xrefs)) + (save-excursion + (set-buffer nntp-server-buffer) + (let ((cur (current-buffer)) + (dependencies (gnus-make-hashtable (length gnus-newsgroup-unreads))) + number header headers eol header id ref dep) + (goto-char (point-min)) + (while (and sequence (not (eobp))) + (setq number (read cur)) + (while (and sequence (< (car sequence) number)) + (setq sequence (cdr sequence))) + (and sequence + (eq number (car sequence)) + (progn + (setq sequence (cdr sequence)) + (save-excursion + (end-of-line) + (setq eol (point))) + (forward-char) + ;; overview: [num subject from date id refs chars lines misc] + (setq header + (vector + number ; number + (gnus-nov-field) ; subject + (gnus-nov-field) ; from + (gnus-nov-field) ; date + (setq id (gnus-nov-field)) ; id + (progn + (save-excursion + (let ((beg (point))) + (search-forward "\t" eol) + (if (search-backward ">" beg t) + (setq ref (buffer-substring + (1+ (point)) + (progn + (search-backward "<" beg t) + (point)))) + (setq ref nil)))) + (gnus-nov-field)) ; refs + (read cur) ; chars + (read cur) ; lines + (if (/= (following-char) ?\t) + nil + (forward-char 1) + (gnus-nov-field)) ; misc + )) + ;; We build the thread tree. + (if (boundp (setq dep (intern id dependencies))) + (setcar (symbol-value dep) header) + (set dep (list header))) + (if (boundp (setq dep (intern (or ref "none") dependencies))) + (setcdr (symbol-value dep) + (cons header (cdr (symbol-value dep)))) + (set dep (list nil header))) + (setq headers (cons header headers)))) + (forward-line 1)) + (setq headers (nreverse headers)) + (setq gnus-newsgroup-dependencies dependencies) + headers))) + +(defun gnus-article-get-xrefs () + "Fill in the Xref value in `gnus-current-headers', if necessary. +This is meant to be called in `gnus-article-internal-prepare-hook'." + (or (not gnus-use-cross-reference) + (let ((case-fold-search t) + xref) + (save-restriction + (gnus-narrow-to-headers) + (goto-char (point-min)) + (if (or (and (eq (downcase (following-char)) ?x) + (looking-at "Xref:")) + (search-forward "\nXref:" nil t)) + (progn + (goto-char (1+ (match-end 0))) + (setq xref (buffer-substring (point) + (progn (end-of-line) (point)))) + (save-excursion + (set-buffer gnus-summary-buffer) + (header-set-xref gnus-current-headers xref)))))))) + +(defalias 'gnus-find-header-by-number 'gnus-get-header-by-number) +(make-obsolete 'gnus-find-header-by-number 'gnus-get-header-by-number) + +;; Return a header specified by a NUMBER. +(defun gnus-get-header-by-number (number) + (or gnus-newsgroup-headers-hashtb-by-number + (gnus-make-headers-hashtable-by-number)) + (gnus-gethash (int-to-string number) + gnus-newsgroup-headers-hashtb-by-number)) + +(defun gnus-make-headers-hashtable-by-number () + "Make hashtable for the variable gnus-newsgroup-headers by number." + (let ((header nil) + (headers gnus-newsgroup-headers)) + (setq gnus-newsgroup-headers-hashtb-by-number + (gnus-make-hashtable (length headers))) + (while headers + (setq header (car headers)) + (gnus-sethash (int-to-string (header-number header)) + header gnus-newsgroup-headers-hashtb-by-number) + (setq headers (cdr headers)) + ))) + +(defun gnus-more-header-backward () + "Find new header backward." + (let ((first (car (gnus-gethash gnus-newsgroup-name gnus-active-hashtb))) + (artnum gnus-newsgroup-begin) + (header nil)) + (while (and (not header) + (> artnum first)) + (setq artnum (1- artnum)) + (setq header (gnus-read-header artnum))) + header)) + +(defun gnus-more-header-forward () + "Find new header forward." + (let ((last (cdr (gnus-gethash gnus-newsgroup-name gnus-active-hashtb))) + (artnum gnus-newsgroup-end) + (header nil)) + (while (and (not header) + (< artnum last)) + (setq artnum (1+ artnum)) + (setq header (gnus-read-header artnum))) + header)) + +(defun gnus-extend-newsgroup (header &optional backward) + "Extend newsgroup selection with HEADER. +Optional argument BACKWARD means extend toward backward." + (if header + (let ((artnum (header-number header))) + (setq gnus-newsgroup-headers + (if backward + (cons header gnus-newsgroup-headers) + (nconc gnus-newsgroup-headers (list header)))) + (setq gnus-newsgroup-unselected + (delq artnum gnus-newsgroup-unselected)) + (setq gnus-newsgroup-begin (min gnus-newsgroup-begin artnum)) + (setq gnus-newsgroup-end (max gnus-newsgroup-end artnum))))) + + +(defun gnus-summary-search-group (&optional backward use-level) + "Search for next unread newsgroup. +If optional argument BACKWARD is non-nil, search backward instead." + (save-excursion + (set-buffer gnus-group-buffer) + (save-excursion + ;; We don't want to alter current point of Group mode buffer. + (if (gnus-group-search-forward + backward nil + (if use-level (gnus-group-group-level) nil)) + (gnus-group-group-name)) + ))) + +(defun gnus-summary-search-subject (&optional backward unread subject) + "Search for article forward. +If BACKWARD is non-nil, search backward. +If UNREAD is non-nil, only unread articles are selected. +If SUBJECT is non-nil, the article which has the same subject will be +searched for." + (let ((func + (if backward + (function re-search-backward) (function re-search-forward))) + ;; We have to take care of hidden lines. + (regexp + (if subject + (format "%s %s \\([-0-9 ]+\\) [0-9]+[\n\r]" + (regexp-quote (gnus-simplify-subject-re subject)) + (if unread " " ".")) + ;; Bug by Daniel Quinlan . + (if unread "^[- ]" "^.")))) + (if backward + (beginning-of-line) + (end-of-line)) + (prog1 + (if (funcall func regexp nil t) + (progn + (goto-char (match-beginning 0)) + (gnus-summary-article-number)) + nil) + ;; Adjust cursor point. + (gnus-summary-position-cursor)))) + +(defun gnus-summary-search-forward (&optional unread subject backward) + "Search for article forward. +If UNREAD is non-nil, only unread articles are selected. +If SUBJECT is non-nil, the article which has the same subject will be +searched for. +If BACKWARD is non-nil, the search will be performed backwards instead." + (gnus-summary-search-subject backward unread subject)) + +(defun gnus-summary-search-backward (&optional unread subject) + "Search for article backward. +If 1st optional argument UNREAD is non-nil, only unread article is selected. +If 2nd optional argument SUBJECT is non-nil, the article which has +the same subject will be searched for." + (gnus-summary-search-forward unread subject t)) + +(defun gnus-summary-article-number () + "The article number of the article on the current line. +If there isn's an article number here, then we return the current +article number." + (save-excursion + (beginning-of-line) + (if (re-search-forward " [-0-9]+ [0-9]+[\n\r]" nil t) + (progn + ;; jwz: this is faster than string-to-int/buffer-substring + (goto-char (match-beginning 0)) + (read (current-buffer))) + ;; We return the current if we couldn't find anything. + gnus-current-article))) + +(defun gnus-summary-thread-level () + "The thread level of the article on the current line." + (save-excursion + (beginning-of-line) + (if (re-search-forward " [0-9]+[\n\r]" nil t) + (progn + (goto-char (match-beginning 0)) + (read (current-buffer))) + ;; We return zero if we couldn't find anything. + 0))) + +(defun gnus-summary-article-mark () + "The mark on the current line." + (save-excursion + (beginning-of-line) + (if (re-search-forward ". [-0-9]+ [0-9]+[\n\r]" nil t) + (char-after (match-beginning 0))))) + +(defun gnus-summary-subject-string () + "Return current subject string or nil if nothing." + (save-excursion + (beginning-of-line) + (if (re-search-forward ". [-0-9]+ [0-9]+[\n\r]" nil t) + (let ((beg (previous-property-change (match-beginning 0))) + (end (1- (match-beginning 0))) + (buffer-read-only nil)) + (set-text-properties beg end nil) + (prog1 + (buffer-substring beg end) + (set-text-properties beg end '(invisible t)))) + nil))) + +(defun gnus-summary-recenter () + "Center point in Summary window." + ;; Scroll window so as to cursor comes center of Summary window + ;; only when article is displayed. + ;; Suggested by earle@mahendo.JPL.NASA.GOV (Greg Earle). + ;; Recenter only when requested. + ;; Subbested by popovich@park.cs.columbia.edu + (and gnus-auto-center-summary + (get-buffer-window gnus-article-buffer) + (< (/ (- (window-height) 1) 2) + (count-lines (point) (point-max))) + (recenter (/ (- (window-height) 2) 2)))) + +(defun gnus-summary-jump-to-group (newsgroup) + "Move point to NEWSGROUP in Group mode buffer." + ;; Keep update point of Group mode buffer if visible. + (if (eq (current-buffer) + (get-buffer gnus-group-buffer)) + (save-window-excursion + ;; Take care of tree window mode. + (if (get-buffer-window gnus-group-buffer) + (pop-to-buffer gnus-group-buffer)) + (gnus-group-jump-to-group newsgroup)) + (save-excursion + ;; Take care of tree window mode. + (if (get-buffer-window gnus-group-buffer) + (pop-to-buffer gnus-group-buffer) + (set-buffer gnus-group-buffer)) + (gnus-group-jump-to-group newsgroup)))) + +;; This function returns a list of article numbers based on the +;; difference between the ranges of read articles in this group and +;; the range of active articles. +(defun gnus-list-of-unread-articles (group) + (let* ((read (nth 2 (nth 2 (gnus-gethash group gnus-newsrc-hashtb)))) + (active (gnus-gethash group gnus-active-hashtb)) + (last (cdr active)) + unread first nlast unread) + ;; If none are read, then all are unread. + (if (not read) + (setq first (car active)) + ;; If the range of read articles is a single range, then the + ;; first unread article is the article after the last read + ;; article. Sounds logical, doesn't it? + (if (atom (car read)) + (setq first (1+ (cdr read))) + ;; `read' is a list of ranges. + (while read + (if first + (while (< first nlast) + (setq unread (cons first unread)) + (setq first (1+ first)))) + (setq first (1+ (cdr (car read)))) + (setq nlast (car (car (cdr read)))) + (setq read (cdr read))))) + ;; And add the last unread articles. + (while (<= first last) + (setq unread (cons first unread)) + (setq first (1+ first))) + ;; Return the list of unread articles. + (nreverse unread))) + + +;; Gnus Summary mode commands. + +;; Various summary commands + +(defun gnus-summary-catchup-and-exit (all &optional quietly) + "Mark all articles not marked as unread in this newsgroup as read, then exit. +If prefix argument ALL is non-nil, all articles are marked as read." + (interactive "P") + (if (or quietly + (not gnus-interactive-catchup) ;Without confirmation? + gnus-expert-user + (y-or-n-p + (if all + "Do you really want to mark everything as read? " + "Delete all articles not marked as unread? "))) + (let ((unmarked + (gnus-set-difference gnus-newsgroup-unreads + (if (not all) gnus-newsgroup-marked)))) + (message "") ;Erase "Yes or No" question. + (while unmarked + (gnus-mark-article-as-read (car unmarked)) + (setq unmarked (cdr unmarked))) + ;; Select next newsgroup or exit. + (cond ((eq gnus-auto-select-next 'quietly) + ;; Select next newsgroup quietly. + (gnus-summary-next-group nil)) + (t + (gnus-summary-exit))) + ))) + +(defun gnus-summary-catchup-all-and-exit (&optional quietly) + "Mark all articles in this newsgroup as read, and then exit." + (interactive) + (gnus-summary-catchup-and-exit t quietly)) + +(defun gnus-summary-toggle-truncation (arg) + "Toggle truncation of summary lines. +With arg, turn line truncation on iff arg is positive." + (interactive "P") + (setq truncate-lines + (if (null arg) (not truncate-lines) + (> (prefix-numeric-value arg) 0))) + (redraw-display)) + +(defun gnus-summary-reselect-current-group (show-all) + "Once exit and then reselect the current newsgroup. +Prefix argument SHOW-ALL means to select all articles." + (interactive "P") + (let ((current-subject (gnus-summary-article-number))) + (gnus-summary-exit t) + ;; We have to adjust the point of Group mode buffer because the + ;; current point was moved to the next unread newsgroup by + ;; exiting. + (gnus-summary-jump-to-group gnus-newsgroup-name) + (gnus-group-read-group show-all t) + (gnus-summary-goto-subject current-subject) + )) + +(defun gnus-summary-rescan-group (all) + "Exit the newsgroup, ask for new articles, and select the newsgroup." + (interactive "P") + (gnus-summary-exit t) + (gnus-summary-jump-to-group gnus-newsgroup-name) + (save-excursion + (set-buffer gnus-group-buffer) + (gnus-group-get-new-news-this-group 1)) + (gnus-summary-jump-to-group gnus-newsgroup-name) + (gnus-group-read-group all)) + +(defun gnus-summary-exit (&optional temporary) + "Exit reading current newsgroup, and then return to group selection mode. +gnus-exit-group-hook is called with no arguments if that value is non-nil." + (interactive) + (let ((group gnus-newsgroup-name) + (mode major-mode) + (buf (current-buffer))) + (let ((updated nil) + (headers gnus-newsgroup-headers) + (unreads gnus-newsgroup-unreads) + (unselected (setq gnus-newsgroup-unselected + (sort gnus-newsgroup-unselected '<))) + (ticked gnus-newsgroup-marked)) + ;; Important internal variables are saved, so we can reenter + ;; the Summary buffer even if the hook changes them. + (run-hooks 'gnus-exit-group-hook) + (gnus-update-read-articles group unreads unselected ticked + t gnus-newsgroup-replied + gnus-newsgroup-expirable + gnus-newsgroup-killed + gnus-newsgroup-interesting + gnus-newsgroup-bookmarks) + ;; T means ignore unsubscribed newsgroups. + (if gnus-use-cross-reference + (gnus-mark-xrefs-as-read group headers unreads)) + ;; Save the kill buffer (if it exists) + (gnus-kill-save-kill-buffer) + ;; Do not switch windows but change the buffer to work. + (set-buffer gnus-group-buffer) + (gnus-group-update-group group)) + ;; Make sure where I was, and go to next newsgroup. + (gnus-group-jump-to-group group) + (gnus-group-next-unread-group 1) + (if temporary + ;; If exiting temporary, caller should adjust Group mode + ;; buffer point by itself. + nil ;Nothing to do. + ;; Return to Group mode buffer. + (if (and (get-buffer buf) + (eq mode 'gnus-summary-mode)) + (kill-buffer buf)) + (if (get-buffer gnus-article-buffer) + (bury-buffer gnus-article-buffer)) + (setq gnus-current-select-method gnus-select-method) + (gnus-configure-windows 'newsgroups t) + (pop-to-buffer gnus-group-buffer)))) + +(defun gnus-summary-quit () + "Quit reading current newsgroup without updating read article info." + (interactive) + (if (y-or-n-p "Do you really wanna quit reading this group? ") + (progn + (message "") ;Erase "Yes or No" question. + ;; Return to Group selection mode. + (if (get-buffer gnus-summary-buffer) + (bury-buffer gnus-summary-buffer)) + (if (get-buffer gnus-article-buffer) + (bury-buffer gnus-article-buffer)) + (gnus-configure-windows 'newsgroups) + (pop-to-buffer gnus-group-buffer) + (gnus-group-jump-to-group gnus-newsgroup-name) ;Make sure where I was. + (gnus-group-next-group 1)))) + +;; Suggested by Per Abrahamsen . +(defun gnus-summary-describe-group () + "Describe the current newsgroup." + (interactive) + (gnus-group-describe-group gnus-newsgroup-name)) + +(defun gnus-summary-describe-briefly () + "Describe Summary mode commands briefly." + (interactive) + (message + (substitute-command-keys "\\[gnus-summary-next-page]:Select \\[gnus-summary-next-unread-article]:Forward \\[gnus-summary-prev-unread-article]:Backward \\[gnus-summary-exit]:Exit \\[gnus-info-find-node]:Run Info \\[gnus-summary-describe-briefly]:This help"))) + +;; Walking around Group mode buffer from Summary mode. + +(defun gnus-summary-next-group (no-article &optional group) + "Exit current newsgroup and then select next unread newsgroup. +If prefix argument NO-ARTICLE is non-nil, no article is selected initially." + (interactive "P") + ;; Make sure Group mode buffer point is on current newsgroup. + (gnus-summary-jump-to-group gnus-newsgroup-name) + (let ((group (or group (gnus-summary-search-group))) + (buf gnus-summary-buffer)) + (if (null group) + (progn + (message "Exiting %s..." gnus-newsgroup-name) + (gnus-summary-exit) + (message "")) + (message "Selecting %s..." group) + (gnus-summary-exit t) ;Exit Summary mode temporary. + ;; We are now in Group mode buffer. + ;; Make sure Group mode buffer point is on GROUP. + (gnus-summary-jump-to-group group) + (gnus-summary-read-group group nil no-article buf) + (or (eq (current-buffer) + (get-buffer gnus-summary-buffer)) + (eq gnus-auto-select-next t) + ;; Expected newsgroup has nothing to read since the articles + ;; are marked as read by cross-referencing. So, try next + ;; newsgroup. (Make sure we are in Group mode buffer now.) + (and (eq (current-buffer) + (get-buffer gnus-group-buffer)) + (gnus-group-group-name) + (gnus-summary-read-group + (gnus-group-group-name) nil no-article buf)))))) + +(defun gnus-summary-prev-group (no-article) + "Exit current newsgroup and then select previous unread newsgroup. +If prefix argument NO-ARTICLE is non-nil, no article is selected initially." + (interactive "P") + ;; Make sure Group mode buffer point is on current newsgroup. + (gnus-summary-jump-to-group gnus-newsgroup-name) + (let ((group (gnus-summary-search-group t))) + (if (null group) + (progn + (message "Exiting %s..." gnus-newsgroup-name) + (gnus-summary-exit) + (message "")) + (message "Selecting %s..." group) + (gnus-summary-exit t) ;Exit Summary mode temporary. + ;; We are now in Group mode buffer. + ;; We have to adjust point of Group mode buffer because current + ;; point is moved to next unread newsgroup by exiting. + (gnus-summary-jump-to-group group) + (gnus-summary-read-group group nil no-article) + (or (eq (current-buffer) + (get-buffer gnus-summary-buffer)) + (eq gnus-auto-select-next t) + ;; Expected newsgroup has nothing to read since the articles + ;; are marked as read by cross-referencing. So, try next + ;; newsgroup. (Make sure we are in Group mode buffer now.) + (and (eq (current-buffer) + (get-buffer gnus-group-buffer)) + (gnus-summary-search-group t) + (gnus-summary-read-group + (gnus-summary-search-group t) nil no-article)) + ) + ))) + +;; Walking around summary lines. + +(defun gnus-summary-next-subject (n &optional unread) + "Go to next N'th summary line. +If N is negative, go to the previous N'th subject line. +If UNREAD is non-nil, only unread articles are selected. +The difference between N and the actual number of steps taken is +returned." + (interactive "p") + (let ((backward (< n 0)) + (n (abs n))) + (while (and (> n 0) + (gnus-summary-search-forward unread nil backward)) + (setq n (1- n))) + (gnus-summary-recenter) + (if (/= 0 n) (message "No more%s articles" (if unread " unread" ""))) +; (gnus-summary-position-cursor) + n)) + +(defun gnus-summary-next-unread-subject (n) + "Go to next N'th unread summary line." + (interactive "p") + (gnus-summary-next-subject n t)) + +(defun gnus-summary-prev-subject (n &optional unread) + "Go to previous N'th summary line. +If optional argument UNREAD is non-nil, only unread article is selected." + (interactive "p") + (gnus-summary-next-subject (- n) unread)) + +(defun gnus-summary-prev-unread-subject (n) + "Go to previous N'th unread summary line." + (interactive "p") + (gnus-summary-next-subject (- n) t)) + +(defun gnus-summary-goto-subject (article) + "Go the subject line of ARTICLE." + (interactive + (list + (string-to-int + (completing-read "Article number: " + (mapcar + (lambda (headers) + (list + (int-to-string (header-number headers)))) + gnus-newsgroup-headers) + nil 'require-match)))) + (if (or (eq article (gnus-summary-article-number)) + (let ((org (point))) + (goto-char 1) + (if (re-search-forward (format "[^Z] %d [0-9]+[\n\r]" article) + nil t) + (goto-char (match-beginning 0)) + (goto-char org) + nil))) + (progn + (gnus-summary-position-cursor) + article))) + +;; Walking around summary lines with displaying articles. + +(defun gnus-summary-expand-window () + "Expand Summary window to show headers full window." + (interactive) + (gnus-configure-windows 'summary) + (pop-to-buffer gnus-summary-buffer)) + +(defun gnus-summary-display-article (article &optional all-header) + "Display ARTICLE in Article buffer." + (setq gnus-summary-buffer (current-buffer)) + (if (null article) + nil + (gnus-configure-windows 'article) + (pop-to-buffer gnus-summary-buffer) + (gnus-article-prepare article all-header) + (if (= (gnus-summary-article-mark) ?Z) + (progn + (forward-line 1) + (gnus-summary-position-cursor))) + (gnus-summary-recenter) + (gnus-set-mode-line 'summary) + (run-hooks 'gnus-select-article-hook) + ;; Successfully display article. + t)) + +(defun gnus-summary-select-article (&optional all-headers force) + "Select the current article. +Optional first argument ALL-HEADERS is non-nil, show all header fields. +Optional second argument FORCE is nil, the article is only selected +again when current header does not match with ALL-HEADERS option." + (let ((article (gnus-summary-article-number)) + (all-headers (not (not all-headers)))) ;Must be T or NIL. + (if (or (null gnus-current-article) + (null gnus-article-current) + (/= article (cdr gnus-article-current)) + (not (equal (car gnus-article-current) gnus-newsgroup-name)) + force) + ;; The requested article is different from the current article. + (gnus-summary-display-article article all-headers) + (if all-headers + (gnus-article-show-all-headers)) + (gnus-configure-windows 'article) + (pop-to-buffer gnus-summary-buffer)))) + +(defun gnus-summary-set-current-mark (&optional current-mark) + "Obsolete function." + nil) + +(defun gnus-summary-next-article (unread &optional subject) + "Select article after current one. +If argument UNREAD is non-nil, only unread article is selected." + (interactive "P") + (let ((header nil)) + (cond ((gnus-summary-display-article + (gnus-summary-search-forward unread subject))) + ((and subject + gnus-auto-select-same + (gnus-set-difference gnus-newsgroup-unreads + (append gnus-newsgroup-marked + gnus-newsgroup-interesting)) + (memq this-command + '(gnus-summary-next-unread-article + gnus-summary-next-page + gnus-summary-kill-same-subject-and-select + ;;gnus-summary-next-article + ;;gnus-summary-next-same-subject + ;;gnus-summary-next-unread-same-subject + ))) + ;; Wrap article pointer if there are unread articles. + ;; Hook function, such as gnus-summary-rmail-digest, may + ;; change current buffer, so need check. + (let ((buffer (current-buffer)) + (last-point (point))) + ;; No more articles with same subject, so jump to the first + ;; unread article. + (gnus-summary-first-unread-article) + ;;(and (eq buffer (current-buffer)) + ;; (= (point) last-point) + ;; ;; Ignore given SUBJECT, and try again. + ;; (gnus-summary-next-article unread nil)) + (and (eq buffer (current-buffer)) + (< (point) last-point) + (message "Wrapped")) + )) + ((and gnus-auto-extend-newsgroup + (not unread) ;Not unread only + (not subject) ;Only if subject is not specified. + (setq header (gnus-more-header-forward))) + ;; Extend to next article if possible. + ;; Basic ideas by himacdonald@watdragon.waterloo.edu + (gnus-extend-newsgroup header nil) + ;; Threads feature must be turned off. + (let ((buffer-read-only nil)) + (goto-char (point-max)) + (gnus-summary-prepare-threads (list header) 0)) + (gnus-summary-goto-article gnus-newsgroup-end)) + (t + ;; Select next newsgroup automatically if requested. + (let ((cmd (aref (this-command-keys) 0)) + (group (gnus-summary-search-group nil gnus-keep-same-level)) + (auto-select + (and gnus-auto-select-next + ;;(null (gnus-set-difference gnus-newsgroup-unreads + ;; gnus-newsgroup-marked)) + (memq this-command + '(gnus-summary-next-unread-article + gnus-summary-next-article + gnus-summary-next-page + gnus-summary-next-same-subject + gnus-summary-next-unread-same-subject + gnus-summary-kill-same-subject + gnus-summary-kill-same-subject-and-select + )) + ;; Ignore characters typed ahead. + (not (input-pending-p)) + ))) + ;; Keep just the event type of CMD. + (if (listp cmd) + (setq cmd (car cmd))) + (message "No more%s articles%s" + (if unread " unread" "") + (if (and auto-select + (not (eq gnus-auto-select-next 'quietly))) + (if group + (format " (Type %s for %s [%s])" + (single-key-description cmd) + group + (car (gnus-gethash + group gnus-newsrc-hashtb))) + (format " (Type %s to exit %s)" + (single-key-description cmd) + gnus-newsgroup-name)) + "")) + ;; Select next unread newsgroup automagically. + (cond ((and auto-select + (eq gnus-auto-select-next 'quietly)) + ;; Select quietly. + (gnus-summary-next-group nil group)) + (auto-select + ;; Confirm auto selection. + (let* ((event (read-event)) + (type + (if (listp event) + (car event) + event))) + (if (and (eq event type) (eq event cmd)) + (gnus-summary-next-group nil group) + (setq unread-command-events (list event))))) + ) + )) + ))) + +(defun gnus-summary-next-unread-article () + "Select unread article after current one." + (interactive) + (gnus-summary-next-article t (and gnus-auto-select-same + (gnus-summary-subject-string))) + (gnus-summary-position-cursor)) + +(defun gnus-summary-prev-article (unread &optional subject) + "Select article before current one. +If argument UNREAD is non-nil, only unread article is selected." + (interactive "P") + (let ((header nil)) + (cond ((gnus-summary-display-article + (gnus-summary-search-backward unread subject))) + ((and subject + gnus-auto-select-same + (gnus-set-difference gnus-newsgroup-unreads + (append gnus-newsgroup-marked + gnus-newsgroup-interesting)) + (memq this-command + '(gnus-summary-prev-unread-article + ;;gnus-summary-prev-page + ;;gnus-summary-prev-article + ;;gnus-summary-prev-same-subject + ;;gnus-summary-prev-unread-same-subject + ))) + ;; Ignore given SUBJECT, and try again. + (gnus-summary-prev-article unread nil)) + (unread + (message "No more unread articles")) + ((and gnus-auto-extend-newsgroup + (not subject) ;Only if subject is not specified. + (setq header (gnus-more-header-backward))) + ;; Extend to previous article if possible. + ;; Basic ideas by himacdonald@watdragon.waterloo.edu + (gnus-extend-newsgroup header t) + (let ((buffer-read-only nil)) + (goto-char (point-min)) + (gnus-summary-prepare-threads (list header) 0)) + (gnus-summary-goto-article gnus-newsgroup-begin) + (gnus-summary-position-cursor)) + (t + (message "No more articles")) + ))) + +(defun gnus-summary-prev-unread-article () + "Select unred article before current one." + (interactive) + (gnus-summary-prev-article t (and gnus-auto-select-same + (gnus-summary-subject-string)))) + +(defun gnus-summary-next-page (lines) + "Show next page of selected article. +If end of article, select next article. +Argument LINES specifies lines to be scrolled up." + (interactive "P") + (setq gnus-summary-buffer (current-buffer)) + (let ((article (gnus-summary-article-number)) + (endp nil)) + (if (or (null gnus-current-article) + (null gnus-article-current) + (/= article (cdr gnus-article-current)) + (not (equal (car gnus-article-current) gnus-newsgroup-name))) + ;; Selected subject is different from current article's. + (gnus-summary-display-article article) + (gnus-configure-windows 'article) + (pop-to-buffer gnus-summary-buffer) + (gnus-eval-in-buffer-window gnus-article-buffer + (setq endp (gnus-article-next-page lines))) + (cond ((and endp lines) + (message "End of message")) + ((and endp (null lines)) + (gnus-summary-next-unread-article))) + (gnus-summary-position-cursor)))) + +(defun gnus-summary-prev-page (lines) + "Show previous page of selected article. +Argument LINES specifies lines to be scrolled down." + (interactive "P") + (let ((article (gnus-summary-article-number))) + (if (or (null gnus-current-article) + (null gnus-article-current) + (/= article (cdr gnus-article-current)) + (not (equal (car gnus-article-current) gnus-newsgroup-name))) + ;; Selected subject is different from current article's. + (gnus-summary-display-article article) + (gnus-configure-windows 'article) + (pop-to-buffer gnus-summary-buffer) + (gnus-eval-in-buffer-window gnus-article-buffer + (gnus-article-prev-page lines)) + (gnus-summary-position-cursor)))) + +(defun gnus-summary-scroll-up (lines) + "Scroll up (or down) one line current article. +Argument LINES specifies lines to be scrolled up (or down if negative)." + (interactive "p") + (gnus-summary-select-article) + (gnus-eval-in-buffer-window gnus-article-buffer + (cond ((> lines 0) + (if (gnus-article-next-page lines) + (message "End of message"))) + ((< lines 0) + (gnus-article-prev-page (- 0 lines)))) + )) + +(defun gnus-summary-next-same-subject () + "Select next article which has the same subject as current one." + (interactive) + (gnus-summary-next-article nil (gnus-summary-subject-string))) + +(defun gnus-summary-prev-same-subject () + "Select previous article which has the same subject as current one." + (interactive) + (gnus-summary-prev-article nil (gnus-summary-subject-string))) + +(defun gnus-summary-next-unread-same-subject () + "Select next unread article which has the same subject as current one." + (interactive) + (gnus-summary-next-article t (gnus-summary-subject-string))) + +(defun gnus-summary-prev-unread-same-subject () + "Select previous unread article which has the same subject as current one." + (interactive) + (gnus-summary-prev-article t (gnus-summary-subject-string))) + +(defun gnus-summary-first-unread-article () + "Select the first unread article. +Return nil if there are no unread articles." + (interactive) + (let ((begin (point))) + (goto-char 1) + (if (re-search-forward " [-0-9]+ [0-9]+[\n\r]" nil t) + (progn + (forward-char -1) + ;; Fix by Per Abrahamsen . + (gnus-summary-position-cursor) + (gnus-summary-display-article (gnus-summary-article-number))) + ;; If there is no unread articles, stay where you are. + (goto-char begin) + (message "No more unread articles") + nil))) + +(defun gnus-summary-goto-article (article &optional all-headers) + "Fetch ARTICLE and display it if it exists. +If ALL-HEADERS is non-nil, no header lines are hidden." + (interactive + (list + (string-to-int + (completing-read "Article number: " + (mapcar + (lambda (headers) + (list + (int-to-string (header-number headers)))) + gnus-newsgroup-headers) + nil 'require-match)))) + (if (gnus-summary-goto-subject article) + (gnus-summary-display-article article all-headers))) + +(defun gnus-summary-goto-last-article () + "Go to last subject line." + (interactive) + (if gnus-last-article + (gnus-summary-goto-article gnus-last-article))) + + +;; Summary article oriented commands + +(defun gnus-summary-refer-parent-article () + "Refer parent article of current article." + (interactive) + (let ((ref (header-references gnus-current-headers)) + parent) + (if (or (not ref) (equal ref "")) + (error "No references in this article")) + (and (string-match "<[^<>]*>[ \t]*$" ref) + (setq parent + (substring ref (match-beginning 0) (match-end 0)))) + (if (stringp parent) + (gnus-summary-refer-article parent) + (error "Possibly malformed references")))) + +(defun gnus-summary-refer-article (message-id) + "Refer article specified by MESSAGE-ID. +NOTE: This command only works with newsgroup that use NNTP." + (interactive "sMessage-ID: ") + ;; Make sure that this command depends on the fact that article + ;; related information is not updated when an article is retrieved + ;; by Message-ID. + (gnus-summary-select-article t) ;Request all headers. + (if (and (stringp message-id) + (> (length message-id) 0)) + (let ((current (header-id gnus-current-headers))) + (gnus-eval-in-buffer-window + gnus-article-buffer + ;; Construct the correct Message-ID if necessary. + ;; Suggested by tale@pawl.rpi.edu. + (or (string-match "^<" message-id) + (setq message-id (concat "<" message-id))) + (or (string-match ">$" message-id) + (setq message-id (concat message-id ">")))))) + (if (and (stringp message-id) + (gnus-article-prepare message-id nil (gnus-read-header message-id))) + (progn + (gnus-summary-insert-line + nil gnus-current-headers 0 nil ?D nil nil t) + (forward-line -1) + (gnus-summary-position-cursor) + message-id) + (error "No such references"))) + +(defun gnus-summary-next-digest (nth) + "Move to head of NTH next digested message." + (interactive "p") + (gnus-summary-select-article) + (gnus-eval-in-buffer-window gnus-article-buffer + (gnus-article-next-digest (or nth 1)) + )) + +(defun gnus-summary-prev-digest (nth) + "Move to head of NTH previous digested message." + (interactive "p") + (gnus-summary-select-article) + (gnus-eval-in-buffer-window gnus-article-buffer + (gnus-article-prev-digest (or nth 1)) + )) + +(defun gnus-summary-rmail-digest () + "Run RMAIL on current digest article. +gnus-select-digest-hook will be called with no arguments, if that +value is non-nil. It is possible to modify the article so that Rmail +can work with it. +gnus-rmail-digest-hook will be called with no arguments, if that value +is non-nil. The hook is intended to customize Rmail mode." + (interactive) + (gnus-summary-select-article) + (require 'rmail) + (let ((artbuf gnus-article-buffer) + (digbuf (get-buffer-create gnus-digest-buffer)) + (mail-header-separator "")) + (set-buffer digbuf) + (gnus-add-current-to-buffer-list) + (buffer-disable-undo (current-buffer)) + (setq buffer-read-only nil) + (erase-buffer) + (insert-buffer-substring artbuf) + (run-hooks 'gnus-select-digest-hook) + (gnus-convert-article-to-rmail) + (goto-char (point-min)) + ;; Rmail initializations. + (rmail-insert-rmail-file-header) + (rmail-mode) + (rmail-set-message-counters) + (rmail-show-message) + (condition-case () + (progn + (undigestify-rmail-message) + (rmail-expunge) ;Delete original message. + ;; File name is meaningless but `save-buffer' requires it. + (setq buffer-file-name "Gnus Digest") + (setq mode-line-buffer-identification + (concat "Digest: " + (header-subject gnus-current-headers))) + ;; There is no need to write this buffer to a file. + (make-local-variable 'write-file-hooks) + (setq write-file-hooks + (list (lambda () + (set-buffer-modified-p nil) + (message "(No changes need to be saved)") + 'no-need-to-write-this-buffer))) + ;; Default file name saving digest messages. + (setq rmail-default-rmail-file + (funcall gnus-rmail-save-name gnus-newsgroup-name + gnus-current-headers gnus-newsgroup-last-rmail)) + (setq rmail-default-file + (funcall gnus-mail-save-name gnus-newsgroup-name + gnus-current-headers gnus-newsgroup-last-mail)) + ;; Prevent generating new buffer named *** each time. + (setq rmail-summary-buffer + (get-buffer-create gnus-digest-summary-buffer)) + (run-hooks 'gnus-rmail-digest-hook) + ;; Take all windows safely. + (gnus-configure-windows '(1 0 0)) + (pop-to-buffer gnus-group-buffer) + ;; Use Summary Article windows for Digest summary and + ;; Digest buffers. + (if gnus-digest-show-summary + (let ((gnus-summary-buffer gnus-digest-summary-buffer) + (gnus-article-buffer gnus-digest-buffer)) + (gnus-configure-windows 'article) + (pop-to-buffer gnus-digest-buffer) + (rmail-summary) + (pop-to-buffer gnus-digest-summary-buffer) + (message (substitute-command-keys + "Type \\[rmail-summary-quit] to return to Gnus"))) + (let ((gnus-summary-buffer gnus-digest-buffer)) + (gnus-configure-windows 'summary) + (pop-to-buffer gnus-digest-buffer) + (message (substitute-command-keys + "Type \\[rmail-quit] to return to Gnus"))) + ) + ;; Move the buffers to the end of buffer list. + (bury-buffer gnus-article-buffer) + (bury-buffer gnus-group-buffer) + (bury-buffer gnus-digest-summary-buffer) + (bury-buffer gnus-digest-buffer)) + (error (set-buffer-modified-p nil) + (kill-buffer digbuf) + ;; This command should not signal an error because the + ;; command is called from hooks. + (ding) (message "Article is not a digest"))) + )) + +(defun gnus-summary-isearch-article () + "Do incremental search forward on current article." + (interactive) + (gnus-summary-select-article) + (gnus-eval-in-buffer-window gnus-article-buffer + (isearch-forward))) + +(defun gnus-summary-search-article-forward (regexp) + "Search for an article containing REGEXP forward. +gnus-select-article-hook is not called during the search." + (interactive + (list (read-string + (concat "Search forward (regexp): " + (if gnus-last-search-regexp + (concat "(default " gnus-last-search-regexp ") ")))))) + (if (string-equal regexp "") + (setq regexp (or gnus-last-search-regexp "")) + (setq gnus-last-search-regexp regexp)) + (if (gnus-summary-search-article regexp nil) + (gnus-eval-in-buffer-window gnus-article-buffer + (recenter 0) + ;;(sit-for 1) + ) + (error "Search failed: \"%s\"" regexp) + )) + +(defun gnus-summary-search-article-backward (regexp) + "Search for an article containing REGEXP backward. +gnus-select-article-hook is not called during the search." + (interactive + (list (read-string + (concat "Search backward (regexp): " + (if gnus-last-search-regexp + (concat "(default " gnus-last-search-regexp ") ")))))) + (if (string-equal regexp "") + (setq regexp (or gnus-last-search-regexp "")) + (setq gnus-last-search-regexp regexp)) + (if (gnus-summary-search-article regexp t) + (gnus-eval-in-buffer-window gnus-article-buffer + (recenter 0) + ;;(sit-for 1) + ) + (error "Search failed: \"%s\"" regexp) + )) + +(defun gnus-summary-search-article (regexp &optional backward) + "Search for an article containing REGEXP. +Optional argument BACKWARD means do search for backward. +gnus-select-article-hook is not called during the search." + (let ((gnus-select-article-hook nil) ;Disable hook. + (gnus-mark-article-hook nil) ;Inhibit marking as read. + (re-search + (if backward + (function re-search-backward) (function re-search-forward))) + (found nil) + (last nil)) + ;; Hidden thread subtrees must be searched for ,too. + (gnus-summary-show-all-threads) + ;; First of all, search current article. + ;; We don't want to read article again from NNTP server nor reset + ;; current point. + (gnus-summary-select-article) + (message "Searching article: %d..." gnus-current-article) + (setq last gnus-current-article) + (gnus-eval-in-buffer-window gnus-article-buffer + (save-restriction + (widen) + ;; Begin search from current point. + (setq found (funcall re-search regexp nil t)))) + ;; Then search next articles. + (while (and (not found) + (gnus-summary-display-article + (gnus-summary-search-subject backward nil nil))) + (message "Searching article: %d..." gnus-current-article) + (gnus-eval-in-buffer-window gnus-article-buffer + (save-restriction + (widen) + (goto-char (if backward (point-max) (point-min))) + (setq found (funcall re-search regexp nil t))) + )) + (message "") + ;; Adjust article pointer. + (or (eq last gnus-current-article) + (setq gnus-last-article last)) + ;; Return T if found such article. + found + )) + +(defun gnus-summary-execute-command (field regexp command &optional backward) + "If FIELD of article header matches REGEXP, execute a COMMAND string. +If FIELD is an empty string (or nil), entire article body is searched for. +If optional (prefix) argument BACKWARD is non-nil, do backward instead." + (interactive + (list (let ((completion-ignore-case t)) + (completing-read "Field name: " + '(("Number")("Subject")("From") + ("Lines")("Date")("Id") + ("Xref")("References")) + nil 'require-match)) + (read-string "Regexp: ") + (read-key-sequence "Command: ") + current-prefix-arg)) + ;; Hidden thread subtrees must be searched for ,too. + (gnus-summary-show-all-threads) + ;; We don't want to change current point nor window configuration. + (save-excursion + (save-window-excursion + (message "Executing %s..." (key-description command)) + ;; We'd like to execute COMMAND interactively so as to give arguments. + (gnus-execute field regexp + (` (lambda () + (call-interactively '(, (key-binding command))))) + backward) + (message "Executing %s... done" (key-description command))))) + +(defun gnus-summary-beginning-of-article () + "Scroll the article back to the beginning." + (interactive) + (gnus-summary-select-article) + (gnus-eval-in-buffer-window gnus-article-buffer + (widen) + (goto-char (point-min)) + (if gnus-break-pages + (gnus-narrow-to-page)) + )) + +(defun gnus-summary-end-of-article () + "Scroll to the end of the article." + (interactive) + (gnus-summary-select-article) + (gnus-eval-in-buffer-window gnus-article-buffer + (widen) + (goto-char (point-max)) + (if gnus-break-pages + (gnus-narrow-to-page)) + )) + +(defun gnus-summary-show-article () + "Force re-fetching of the current article." + (interactive) + (gnus-summary-select-article gnus-have-all-headers t)) + +(defun gnus-summary-toggle-header (arg) + "Show the headers if they are hidden, or hide them if they are shown. +If ARG is a positive number, show the entire header. +If ARG is a negative number, hide the unwanted header lines." + (interactive "P") + (save-excursion + (set-buffer gnus-article-buffer) + (let ((buffer-read-only nil)) + (if (numberp arg) + (if (> arg 0) (remove-text-properties 1 (point-max) '(invisible t)) + (if (< arg 0) (run-hooks 'gnus-article-display-hook))) + (if (text-property-any 1 (point-max) 'invisible t) + (remove-text-properties 1 (point-max) '(invisible t)) + (run-hooks 'gnus-article-display-hook)))))) + +(defun gnus-summary-show-all-headers () + "Make all header lines visible." + (interactive) + (gnus-article-show-all-headers)) + +(defun gnus-summary-toggle-mime (arg) + "Toggle MIME processing. +If ARG is a positive number, turn MIME processing on." + (interactive "P") + (setq gnus-show-mime + (if (null arg) (not gnus-show-mime) + (> (prefix-numeric-value arg) 0))) + (gnus-summary-select-article t 'force)) + +(defun gnus-summary-caesar-message (rotnum) + "Caesar rotates all letters of current message by 13/47 places. +With prefix arg, specifies the number of places to rotate each letter forward. +Caesar rotates Japanese letters by 47 places in any case." + (interactive "P") + (gnus-summary-select-article) + (gnus-overload-functions) + (gnus-eval-in-buffer-window gnus-article-buffer + (save-restriction + (widen) + ;; We don't want to jump to the beginning of the message. + ;; `save-excursion' does not do its job. + (move-to-window-line 0) + (let ((last (point))) + (news-caesar-buffer-body rotnum) + (goto-char last) + (recenter 0) + )) + )) + +(defun gnus-summary-stop-page-breaking () + "Stop page breaking in the current article." + (interactive) + (gnus-summary-select-article) + (gnus-eval-in-buffer-window gnus-article-buffer (widen))) + +;; Suggested by Brian Edmonds . + +(defun gnus-summary-move-article (n &optional to-newsgroup select-method) + "Move the current article to a different newsgroup. +If N is a positive number, move the N next articles. +If N is a negative number, move the N previous articles. +If N is nil and any articles have been marked with the process mark, +move those articles instead. +If TO-NEWSGROUP is string, do not prompt for a newsgroup to move to. +If SELECT-METHOD is symbol, do not move to a specific newsgroup, but +re-spool using this method. +For this function to work, both the current newsgroup and the +newsgroup that you want to move to have to support the `request-move' +and `request-accept' functions. (Ie. mail newsgroups at present.)" + (interactive "P") + (or (gnus-check-backend-function 'request-move-article gnus-newsgroup-name) + (error "The current newsgroup does not support article moving")) + (let (articles art-group) + (if (and n (numberp n)) + (let ((backward (< n 0)) + (n (abs n))) + (save-excursion + (while (and (> n 0) + (setq articles (cons (gnus-summary-article-number) + articles)) + (gnus-summary-search-forward nil nil backward)) + (setq n (1- n)))) + (setq articles (sort articles (function <)))) + (setq articles (or (setq gnus-newsgroup-processable + (sort gnus-newsgroup-processable (function <))) + (list (gnus-summary-article-number))))) + (if (and (not to-newsgroup) (not select-method)) + (setq to-newsgroup + (completing-read + (format "Where do you want to move %s? " + (if (> (length articles) 1) + (format "these %d articles" (length articles)) + "this article")) + gnus-active-hashtb nil t))) + (or (gnus-check-backend-function 'request-accept-article + (or select-method to-newsgroup)) + (error "%s does not support article moving" to-newsgroup)) + (message "Moving to %s: %s..." (or select-method to-newsgroup) articles) + (while articles + (if (setq art-group + (gnus-request-move-article + (car articles) + gnus-newsgroup-name (nth 1 gnus-current-select-method) + (list 'gnus-request-accept-article + (or select-method to-newsgroup)))) + (let* ((buffer-read-only nil) + (entry (or + (gnus-gethash (car art-group) gnus-newsrc-hashtb) + (gnus-gethash (concat gnus-foreign-group-prefix + (car art-group) ) + gnus-newsrc-hashtb))) + (info (nth 2 entry)) + (article (car articles)) + (marked (nth 3 info))) + (gnus-summary-goto-subject article) + (delete-region (progn (beginning-of-line) (point)) + (progn (forward-line 1) (point))) + (if (not (memq article gnus-newsgroup-unreads)) + (setcar (cdr (cdr info)) + (gnus-add-to-range (nth 2 info) + (list (cdr art-group))))) + ;; !!! Here one should copy all the marks over to the new + ;; newsgroup, but I couldn't be bothered. nth on that! + ) + (message "Couldn't move article %s" (car articles))) + (setq articles (cdr articles))))) + +(defun gnus-summary-respool-article (n &optional respool-method) + "Respool the current article. +The article will be squeezed through the mail spooling process again, +which means that it will be put in some mail newsgroup or other +depending on `nnmail-split-methods'. +If N is a positive number, respool the N next articles. +If N is a negative number, respool the N previous articles. +If N is nil and any articles have been marked with the process mark, +respool those articles instead. +For this function to work, both the current newsgroup and the +newsgroup that you want to move to have to support the `request-move' +and `request-accept' functions. (Ie. mail newsgroups at present.)" + (interactive "P") + (or respool-method + (setq respool-method + (completing-read + "What method do you want to use when respooling? " + (gnus-methods-using 'respool) nil t))) + (gnus-summary-move-article n nil respool-method)) + + +;; Summary marking commands. + +(defun gnus-summary-kill-same-subject-and-select (unmark) + "Mark articles which has the same subject as read, and then select the next. +If UNMARK is positive, remove any kind of mark. +If UNMARK is negative, tick articles." + (interactive "P") + (if unmark + (setq unmark (prefix-numeric-value unmark))) + (let ((count + (gnus-summary-mark-same-subject + (gnus-summary-subject-string) unmark))) + ;; Select next unread article. If auto-select-same mode, should + ;; select the first unread article. + (gnus-summary-next-article t (and gnus-auto-select-same + (gnus-summary-subject-string))) + (message "%d articles are marked as %s" + count (if unmark "unread" "read")) + )) + +(defun gnus-summary-kill-same-subject (unmark) + "Mark articles which has the same subject as read. +If UNMARK is positive, remove any kind of mark. +If UNMARK is negative, tick articles." + (interactive "P") + (if unmark + (setq unmark (prefix-numeric-value unmark))) + (let ((count + (gnus-summary-mark-same-subject + (gnus-summary-subject-string) unmark))) + ;; If marked as read, go to next unread subject. + (if (null unmark) + ;; Go to next unread subject. + (gnus-summary-next-subject 1 t)) + (message "%d articles are marked as %s" + count (if unmark "unread" "read")) + )) + +(defun gnus-summary-mark-same-subject (subject &optional unmark) + "Mark articles with same SUBJECT as read, and return marked number. +If optional argument UNMARK is positive, remove any kinds of marks. +If optional argument UNMARK is negative, mark articles as unread instead." + (let ((count 1)) + (save-excursion + (cond ((null unmark) + (gnus-summary-mark-as-read nil "K")) + ((> unmark 0) + (gnus-summary-tick-article nil t)) + (t + (gnus-summary-tick-article))) + (while (and subject + (gnus-summary-search-forward nil subject)) + (cond ((null unmark) + (gnus-summary-mark-as-read nil "K")) + ((> unmark 0) + (gnus-summary-tick-article nil t)) + (t + (gnus-summary-tick-article))) + (setq count (1+ count)) + )) + ;; Hide killed thread subtrees. Does not work properly always. + ;;(and (null unmark) + ;; gnus-thread-hide-killed + ;; (gnus-summary-hide-thread)) + ;; Return number of articles marked as read. + count + )) + +(defun gnus-summary-mark-as-processable (n &optional unmark) + "Set the process mark on the next N articles. +If N is negative, mark backward instead. If UNMARK is non-nil, remove +the process mark instead. The difference between N and the actual +number of articles marked is returned." + (interactive "p") + (let ((backward (< n 0)) + (n (abs n))) + (while (and (> n 0) + (if unmark + (gnus-summary-remove-process-mark + (gnus-summary-article-number)) + (gnus-summary-set-process-mark + (gnus-summary-article-number))) + (= 0 (gnus-summary-next-subject (if backward -1 1)))) + (setq n (1- n))) + (if (/= 0 n) (message "No more articles")) + n)) + +(defun gnus-summary-unmark-as-processable (n) + "Remove the process mark from the next N articles. +If N is negative, mark backward instead. The difference between N and +the actual number of articles marked is returned." + (interactive "p") + (gnus-summary-mark-as-processable n t)) + +(defun gnus-summary-unmark-all-processable () + "Remove the process mark from all articles." + (interactive) + (save-excursion + (while gnus-newsgroup-processable + (gnus-summary-remove-process-mark (car gnus-newsgroup-processable)))) + (gnus-summary-position-cursor)) + +(defun gnus-summary-mark-as-expirable (n &optional unmark) + "Mark N articles forward as expirable. +If N is negative, mark backward instead. If UNMARK is non-nil, remove +the expirably mark instead. The difference between N and the actual +number of articles marked is returned." + (interactive "p") + (let ((backward (< n 0)) + (n (abs n))) + (while (and (> n 0) + (if unmark + (gnus-summary-remove-expirable-mark + (gnus-summary-article-number)) + (gnus-summary-set-expirable-mark + (gnus-summary-article-number))) + (= 0 (gnus-summary-next-subject (if backward -1 1)))) + (setq n (1- n))) + (if (/= 0 n) (message "No more articles")) + n)) + +(defun gnus-summary-unmark-as-expirable (n) + "Mark N articles forward as expirable. +If N is negative, mark backward instead. The difference between N and +the actual number of articles marked is returned." + (interactive "p") + (gnus-summary-mark-as-expirable n t)) + +(defun gnus-summary-set-expirable-mark (article) + "Mark the current article as expirable and update the Summary line." + (setq gnus-newsgroup-expirable (cons article gnus-newsgroup-expirable)) + (let ((buffer-read-only nil)) + (if (gnus-summary-goto-subject article) + (progn + (if (= (gnus-summary-article-mark) ?Z) (forward-line 1)) + (beginning-of-line) + (forward-char 2) + (delete-char 1) + (insert "X") + t)))) + +(defun gnus-summary-remove-expirable-mark (article) + "Remove the expirable mark from ARTICLE as expirable and update the Summary line." + (setq gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable)) + (let ((buffer-read-only nil)) + (if (gnus-summary-goto-subject article) + (progn + (if (= (gnus-summary-article-mark) ?Z) (forward-line 1)) + (beginning-of-line) + (forward-char 2) + (delete-char 1) + (insert + (if (memq article gnus-newsgroup-processable) ?# ? )) + t)))) + +(defun gnus-summary-expire-articles () + "Expire all articles that are marked as expirable in the current group." + (interactive) + (if (and gnus-newsgroup-expirable + (gnus-check-backend-function + 'gnus-request-expire-articles gnus-newsgroup-name)) + (setq gnus-newsgroup-expirable + (gnus-request-expire-articles gnus-newsgroup-expirable + gnus-newsgroup-name)))) + +(defun gnus-summary-mark-article-as-replied (article) + "Mark ARTICLE replied and update the Summary line." + (setq gnus-newsgroup-replied (cons article gnus-newsgroup-replied)) + (let ((buffer-read-only nil)) + (if (gnus-summary-goto-subject article) + (progn + (beginning-of-line) + (forward-char 1) + (delete-char 1) + (insert "R") + t)))) + +(defun gnus-summary-set-bookmark (article) + "Set a bookmark in current article." + (interactive (list (gnus-summary-article-number))) + (if (or (not (get-buffer gnus-article-buffer)) + (not gnus-current-article) + (not gnus-article-current) + (not (equal gnus-newsgroup-name (car gnus-article-current)))) + (error "No current article selected")) + ;; Remove old bookmark, if one exists. + (let ((old (assq article gnus-newsgroup-bookmarks))) + (if old (setq gnus-newsgroup-bookmarks + (delq old gnus-newsgroup-bookmarks)))) + ;; Set the new bookmark, which is on the form + ;; (article-number . line-number-in-body). + (setq gnus-newsgroup-bookmarks + (cons + (cons article + (save-excursion + (set-buffer gnus-article-buffer) + (count-lines + (min (point) + (save-excursion + (goto-char 1) + (search-forward "\n\n" nil t) + (point))) + (point)))) + gnus-newsgroup-bookmarks)) + (message "A bookmark has been added to the current article.")) + +(defun gnus-summary-remove-bookmark (article) + "Remove the bookmark from the current article." + (interactive (list (gnus-summary-article-number))) + ;; Remove old bookmark, if one exists. + (let ((old (assq article gnus-newsgroup-bookmarks))) + (if old + (progn + (setq gnus-newsgroup-bookmarks + (delq old gnus-newsgroup-bookmarks)) + (message "Removed bookmark.")) + (message "No bookmark in current article.")))) + +;; Suggested by Daniel Quinlan . +(defun gnus-summary-mark-as-interesting (n) + "Mark N articles forward as interesting. +If N is negative, mark backward instead. The difference between N and +the actual number of articles marked is returned." + (interactive "p") + (gnus-summary-mark-forward n "I")) + +(defun gnus-summary-set-process-mark (article) + "Set the process mark on ARTICLE and update the Summary line." + (setq gnus-newsgroup-processable (cons article gnus-newsgroup-processable)) + (let ((buffer-read-only nil)) + (if (gnus-summary-goto-subject article) + (progn + (if (= (gnus-summary-article-mark) ?Z) (forward-line 1)) + (beginning-of-line) + (forward-char 2) + (delete-char 1) + (insert "#") + t)))) + +(defun gnus-summary-remove-process-mark (article) + "Remove the process mark from ARTICLE and update the Summary line." + (setq gnus-newsgroup-processable (delq article gnus-newsgroup-processable)) + (let ((buffer-read-only nil)) + (if (gnus-summary-goto-subject article) + (progn + (if (= (gnus-summary-article-mark) ?Z) (forward-line 1)) + (beginning-of-line) + (forward-char 2) + (delete-char 1) + (insert + (if (memq article gnus-newsgroup-expirable) ?X ? )) + t)))) + +(defun gnus-summary-mark-forward (n &optional unread) + "Mark N articles as read forwards. +If N is negative, mark backwards instead. +If UNREAD is non-nil, mark articles as unread. In that case, UNREAD +must either be \" \", \"-\" or \"I\". +The difference between N and the actual number of articles marked is +returned." + (interactive "p") + (let ((backward (< n 0)) + (n (abs n))) + (while (and (> n 0) + (gnus-summary-mark-article nil unread) + (= 0 (gnus-summary-next-subject (if backward -1 1) + (not unread)))) + (setq n (1- n))) + (if (/= 0 n) (message "No more %sarticles" (if unread "" "unread "))) + (gnus-set-mode-line 'summary) + n)) + +(defun gnus-summary-mark-article (&optional article mark) + "Mark ARTICLE with MARK. +MARK can be any string (but it should just be one character long). +Four MARK strings are reserved: \" \" (unread), +\"-\" (ticked), \"I\" (interesting), \"D\" (read). +If MARK is nil, then the default string \"D\" is used. +If ARTICLE is nil, then the article on the current line will be +marked." + (let* ((buffer-read-only nil) + (mark (or mark "D")) + (article (or article (gnus-summary-article-number)))) + (if (numberp mark) (setq mark (format "%c" mark))) + (prog1 + (if (gnus-summary-goto-subject article) + (progn + (gnus-summary-show-thread) + (beginning-of-line) + (if (= (gnus-summary-article-mark) ?Z) (forward-line 1)) + ;; Fix the invisible mark. + (re-search-forward ". [-0-9]+ [0-9]+[\n\r]") + (goto-char (match-beginning 0)) + (delete-char 1) + (insert mark) + (set-text-properties (1- (point)) (point) '(invisible t)) + ;; Fix the visible mark. + (beginning-of-line) + (delete-char 1) + (insert mark) + t)) + ;; Bug by Brian Edmonds + (if (or (string= mark " ") (string= mark "-") (string= mark "I")) + (gnus-mark-article-as-unread article mark) + (gnus-mark-article-as-read article))))) + +(defun gnus-mark-article-as-read (article) + "Remember that ARTICLE is marked as read." + ;; Make the article expirable. + (if gnus-newsgroup-auto-expire + (gnus-summary-set-expirable-mark article)) + ;; Remove from unread and marked list. + (setq gnus-newsgroup-unreads + (delq article gnus-newsgroup-unreads)) + (setq gnus-newsgroup-marked + (delq article gnus-newsgroup-marked)) + (setq gnus-newsgroup-interesting + (delq article gnus-newsgroup-interesting))) + +(defun gnus-mark-article-as-unread (article &optional mark) + "Remember that ARTICLE is marked as unread. +MARK is the mark type: \" \", \"-\" or \"I\"." + ;; Add to unread list. + (or (memq article gnus-newsgroup-unreads) + (setq gnus-newsgroup-unreads + (cons article gnus-newsgroup-unreads))) + ;; Update the expired list. + (gnus-summary-remove-expirable-mark article) + ;; If CLEAR-MARK is non-nil, the article must be removed from marked + ;; list. Otherwise, it must be added to the list. + (setq gnus-newsgroup-marked + (delq article gnus-newsgroup-marked)) + (setq gnus-newsgroup-interesting + (delq article gnus-newsgroup-interesting)) + (if (equal mark "-") + (setq gnus-newsgroup-marked + (cons article gnus-newsgroup-marked))) + (if (equal mark "I") + (setq gnus-newsgroup-interesting + (cons article gnus-newsgroup-interesting)))) + +(defalias 'gnus-summary-mark-as-unread-forward + 'gnus-summary-tick-article-forward) +(make-obsolete 'gnus-summary-mark-as-unread-forward + 'gnus-summary-tick-article--forward) +(defun gnus-summary-tick-article-forward (n) + "Tick N articles forwards. +If N is negative, tick backwards instead. +The difference between N and the number of articles ticked is returned." + (interactive "p") + (gnus-summary-mark-forward n "-")) + +(defalias 'gnus-summary-mark-as-unread-backward 'gnus-summary-tick-article-backward) +(make-obsolete 'gnus-summary-mark-as-unread-backward 'gnus-summary-tick-article-backward) +(defun gnus-summary-tick-article-backward (n) + "Tick N articles backwards. +The difference between N and the number of articles ticked is returned." + (interactive "p") + (gnus-summary-mark-forward (- n) "-")) + +(defalias 'gnus-summary-mark-as-unread 'gnus-summary-tick-article) +(make-obsolete 'gnus-summary-mark-as-unread 'gnus-summary-tick-article) +(defun gnus-summary-tick-article (&optional article clear-mark) + "Mark current article as unread. +Optional 1st argument ARTICLE specifies article number to be marked as unread. +Optional 2nd argument CLEAR-MARK remove any kinds of mark." + (gnus-summary-mark-article article (if clear-mark " " "-"))) + +(defun gnus-summary-mark-as-read-forward (n) + "Mark N articles as read forwards. +If N is negative, mark backwards instead. +The difference between N and the actual number of articles marked is +returned." + (interactive "p") + (gnus-summary-mark-forward n)) + +(defun gnus-summary-mark-as-read-backward (n) + "Mark the N articles as read backwards. +The difference between N and the actual number of articles marked is +returned." + (interactive "p") + (gnus-summary-mark-forward (- n))) + +(defun gnus-summary-mark-as-read (&optional article mark) + "Mark current article as read. +ARTICLE specifies the article to be marked as read. +MARK specifies a string to be inserted at the beginning of the line. +Any kind of string (length 1) except for a space and `-' is ok." + (gnus-summary-mark-article article mark)) + +(defun gnus-summary-clear-mark-forward (n) + "Clear marks from N articles forward. +If N is negative, clear backward instead. +The difference between N and the number of marks cleared is returned." + (interactive "p") + (gnus-summary-mark-forward n " ")) + +(defun gnus-summary-clear-mark-backward (n) + "Clear marks from N articles backward. +The difference between N and the number of marks cleared is returned." + (interactive "p") + (gnus-summary-mark-forward (- n) " ")) + +(defun gnus-summary-delete-marked-as-read () + "Delete lines that are marked as read." + (interactive) + (if gnus-newsgroup-unreads + (let ((buffer-read-only nil)) + (save-excursion + (goto-char (point-min)) + ;; Fix by Jim Sisolak . + (delete-matching-lines "^[DK]")) + ;; Adjust point. + (if (eobp) + (gnus-summary-prev-subject 1) + (gnus-summary-position-cursor))) + ;; It is not so good idea to make the buffer empty. + (message "All articles are marked as read"))) + +(defun gnus-summary-delete-marked-with (marks) + "Delete lines that are marked with MARKS (e.g. \"DK\")." + (interactive "sMarks: ") + (let ((buffer-read-only nil)) + (save-excursion + (goto-char (point-min)) + (delete-matching-lines (concat "^[" marks "]"))) + ;; Adjust point. + (or (zerop (buffer-size)) + (if (eobp) + (gnus-summary-prev-subject 1) + (gnus-summary-position-cursor))))) + +(defun gnus-summary-show-all-interesting () + "Display all the hidden articles that are marked as interesting." + (interactive) + (let ((int gnus-newsgroup-interesting-subjects) + (buffer-read-only nil)) + (if (not int) + (error "No interesting articles hidden.")) + (goto-char (point-min)) + (save-excursion + (while int + (insert (cdr (car int))) + (setq int (cdr int)))) + (gnus-summary-position-cursor) + (setq gnus-newsgroup-interesting-subjects nil))) + +(defun gnus-summary-catchup (all &optional quietly) + "Mark all articles not marked as unread in this newsgroup as read. +If prefix argument ALL is non-nil, all articles are marked as read." + (interactive "P") + (if (or quietly + (not gnus-interactive-catchup) ;Without confirmation? + gnus-expert-user + (y-or-n-p + (if all + "Do you really want to mark everything as read? " + "Delete all articles not marked as unread? "))) + (let ((unmarked + (gnus-set-difference gnus-newsgroup-unreads + (if (not all) gnus-newsgroup-marked)))) + (message "") ;Erase "Yes or No" question. + ;; Hidden thread subtrees must be searched for, too. + (gnus-summary-show-all-threads) + (while unmarked + (gnus-summary-mark-as-read (car unmarked) "C") + (setq unmarked (cdr unmarked)) + )) + )) + +(defun gnus-summary-catchup-to-here () + "Mark all unticked articles before the current one as read." + (interactive) + (beginning-of-line) + (let ((current (gnus-summary-article-number))) + (goto-char (point-min)) + (while (not (= (gnus-summary-article-number) current)) + (beginning-of-line) + (if (/= ?- (following-char)) + (gnus-summary-mark-as-read)) + (gnus-summary-next-subject 1)))) + +(defun gnus-summary-catchup-all (&optional quietly) + "Mark all articles in this newsgroup as read." + (interactive) + (gnus-summary-catchup t quietly)) + +;; Thread-based commands. + +(defun gnus-summary-toggle-threads (arg) + "Toggle showing conversation threads. +If ARG is positive number, turn showing conversation threads on." + (interactive "P") + (let ((current (gnus-summary-article-number))) + (setq gnus-show-threads + (if (null arg) (not gnus-show-threads) + (> (prefix-numeric-value arg) 0))) + (gnus-summary-prepare) + (gnus-summary-goto-subject current))) + +(defun gnus-summary-show-all-threads () + "Show all threads." + (interactive) + (if gnus-show-threads + (save-excursion + (let ((buffer-read-only nil)) + (subst-char-in-region (point-min) (point-max) ?\^M ?\n t))))) + +(defun gnus-summary-show-thread () + "Show thread subtrees." + (interactive) + (if gnus-show-threads + (save-excursion + (let ((buffer-read-only nil)) + (subst-char-in-region + (progn (beginning-of-line) (point)) + (progn (end-of-line) (point)) ?\^M ?\n t))))) + +(defun gnus-summary-hide-all-threads () + "Hide all thread subtrees." + (interactive) + (if gnus-show-threads + (save-excursion + (goto-char (point-min)) + (gnus-summary-hide-thread) + (while (gnus-summary-search-forward) + (gnus-summary-hide-thread))))) + +(defun gnus-summary-hide-thread () + "Hide thread subtrees." + (interactive) + (if gnus-show-threads + (save-excursion + (let ((buffer-read-only nil) + (start (point)) + (level (gnus-summary-thread-level)) + (end (point))) + ;; Go forward until either the buffer ends or the subthread + ;; ends. + (while (and (= 0 (forward-line 1)) + (> (gnus-summary-thread-level) level)) + (setq end (point))) + (subst-char-in-region start end ?\n ?\^M t))))) + +(defun gnus-summary-go-to-next-thread (&optional previous) + "Go to the same level (or less) next thread. +If PREVIOUS is non-nil, go to previous thread instead." + (let ((level (gnus-summary-thread-level)) + (start (point)) + beg end) + (if previous + (progn + (re-search-backward " 0[\n\r]" nil t) + (setq end (point)) + (if (not + (and (re-search-backward " 0[\n\r]" nil t) + (re-search-forward (format " %s[\n\r]" level) end t))) + (goto-char start))) + (if (not (and (re-search-forward " 0[\n\r]" nil t) + (setq beg (point)) + (re-search-forward " 0[\n\r]" nil t) + (setq end (point)) + (goto-char beg) + (re-search-forward (format " %s[\n\r]" level) nil t))) + (goto-char start))) + (/= (point) start))) + +(defun gnus-summary-next-thread (n) + "Go to the same level next N'th thread. +If N is negative, search backward instead. +Returns the difference between N and the number of skips actually +done." + (interactive "p") + (let ((backward (< n 0)) + (n (abs n))) + (while (and (> n 0) + (gnus-summary-go-to-next-thread backward)) + (setq n (1- n))) + (gnus-summary-position-cursor) + (if (/= 0 n) (message "No more threads" )) + n)) + +(defun gnus-summary-prev-thread (n) + "Go to the same level previous N'th thread. +Returns the difference between N and the number of skips actually +done." + (interactive "p") + (gnus-summary-next-thread (- n))) + +(defun gnus-summary-go-down-thread (&optional up same) + "Go down one level in the current thread. +If UP is non-nil, go up instead. +If SAME is non-nil, also move to articles of the same level." + (let ((level (gnus-summary-thread-level)) + (start (point)) + (level-diff (if up -1 1)) + l) + (if (not (and (= 0 (forward-line level-diff)) + (or (= (+ level level-diff) + (setq l (gnus-summary-thread-level))) + (and same (= level l))))) + (goto-char start)) + (/= start (point)))) + +(defun gnus-summary-down-thread (n) + "Go down thread N steps. +If N is negative, go up instead. +Returns the difference between N and how many steps down that were +taken." + (interactive "p") + (let ((up (< n 0)) + (n (abs n))) + (while (and (> n 0) + (gnus-summary-go-down-thread up)) + (setq n (1- n))) + (gnus-summary-position-cursor) + (if (/= 0 n) (message "Can't go further" )) + n)) + +(defun gnus-summary-up-thread (n) + "Go up thread N steps. +If N is negative, go up instead. +Returns the difference between N and how many steps down that were +taken." + (interactive "p") + (gnus-summary-down-thread (- n))) + +(defun gnus-summary-kill-thread (unmark) + "Mark articles under current thread as read. +If the prefix argument is positive, remove any kinds of marks. +If the prefix argument is negative, tick articles instead." + (interactive "P") + (if unmark + (setq unmark (prefix-numeric-value unmark))) + (let ((killing t) + (level (gnus-summary-thread-level))) + (save-excursion + (while killing + ;; Mark the article... + (cond ((null unmark) (gnus-summary-mark-as-read nil "K")) + ((> unmark 0) (gnus-summary-tick-article nil t)) + (t (gnus-summary-tick-article))) + ;; ...and go forward until either the buffer ends or the subtree + ;; ends. + (if (not (and (= 0 (forward-line 1)) + (> (gnus-summary-thread-level) level))) + (setq killing nil)))) + ;; Hide killed subtrees. + (and (null unmark) + gnus-thread-hide-killed + (gnus-summary-hide-thread)) + ;; If marked as read, go to next unread subject. + (if (null unmark) + ;; Go to next unread subject. + (gnus-summary-next-subject 1 t))) + (gnus-set-mode-line 'summary)) + +;; Summary sorting commands + +(defun gnus-summary-sort-by-number (reverse) + "Sort Summary buffer by article number. +Argument REVERSE means reverse order." + (interactive "P") + (gnus-summary-keysort-summary + (function <) + (lambda (a) + (header-number a)) + reverse + )) + +(defun gnus-summary-sort-by-author (reverse) + "Sort Summary buffer by author name alphabetically. +If case-fold-search is non-nil, case of letters is ignored. +Argument REVERSE means reverse order." + (interactive "P") + (gnus-summary-keysort-summary + (function string-lessp) + (lambda (a) + (if case-fold-search + (downcase (header-from a)) + (header-from a))) + reverse + )) + +(defun gnus-summary-sort-by-subject (reverse) + "Sort Summary buffer by subject alphabetically. `Re:'s are ignored. +If case-fold-search is non-nil, case of letters is ignored. +Argument REVERSE means reverse order." + (interactive "P") + (gnus-summary-keysort-summary + (function string-lessp) + (lambda (a) + (if case-fold-search + (downcase (gnus-simplify-subject (header-subject a) 're-only)) + (gnus-simplify-subject (header-subject a) 're-only))) + reverse + )) + +(defun gnus-summary-sort-by-date (reverse) + "Sort Summary buffer by date. +Argument REVERSE means reverse order." + (interactive "P") + (gnus-summary-keysort-summary + (function string-lessp) + (lambda (a) + (gnus-sortable-date (header-date a))) + reverse + )) + +(defun gnus-summary-keysort-summary (predicate key &optional reverse) + "Sort Summary buffer by PREDICATE using a value passed by KEY. +Optional argument REVERSE means reverse order." + (let ((current (gnus-summary-article-number))) + (gnus-keysort-headers predicate key reverse) + (gnus-summary-prepare) + (gnus-summary-goto-subject current) + )) + +(defun gnus-summary-sort-summary (predicate &optional reverse) + "Sort Summary buffer by PREDICATE. +Optional argument REVERSE means reverse order." + (let ((current (gnus-summary-article-number))) + (gnus-sort-headers predicate reverse) + (gnus-summary-prepare) + (gnus-summary-goto-subject current) + )) + +;; Basic ideas by flee@cs.psu.edu (Felix Lee) + +(defun gnus-keysort-headers (predicate key &optional reverse) + "Sort current headers by PREDICATE using a value passed by KEY safely. +*Safely* means C-g quitting is disabled during sort. +Optional argument REVERSE means reverse order." + (let ((inhibit-quit t)) + (setq gnus-newsgroup-headers + (if reverse + (nreverse + (gnus-keysort (nreverse gnus-newsgroup-headers) predicate key)) + (gnus-keysort gnus-newsgroup-headers predicate key))) + )) + +(defun gnus-keysort (list predicate key) + "Sort LIST by PREDICATE using a value passed by KEY." + (mapcar (function cdr) + (sort (mapcar (lambda (a) (cons (funcall key a) a)) list) + (lambda (a b) + (funcall predicate (car a) (car b)))))) + +(defun gnus-sort-headers (predicate &optional reverse) + "Sort current headers by PREDICATE safely. +*Safely* means C-g quitting is disabled during sort. +Optional argument REVERSE means reverse order." + (let ((inhibit-quit t)) + (setq gnus-newsgroup-headers + (if reverse + (nreverse (sort (nreverse gnus-newsgroup-headers) predicate)) + (sort gnus-newsgroup-headers predicate))) + )) + +(defun gnus-string-lessp (a b) + "Return T if first arg string is less than second in lexicographic order. +If case-fold-search is non-nil, case of letters is ignored." + (if case-fold-search + (string-lessp (downcase a) (downcase b)) + (string-lessp a b))) + +(defun gnus-date-lessp (date1 date2) + "Return T if DATE1 is earlyer than DATE2." + (string-lessp (gnus-sortable-date date1) + (gnus-sortable-date date2))) + +(defun gnus-sortable-date (date) + "Make sortable string by string-lessp from DATE. +Timezone package is used." + (let* ((date (timezone-fix-time date nil nil)) ;[Y M D H M S] + (year (aref date 0)) + (month (aref date 1)) + (day (aref date 2))) + (timezone-make-sortable-date year month day + (timezone-make-time-string + (aref date 3) (aref date 4) (aref date 5))) + )) + + +;; Summary saving commands. + +(defun gnus-summary-save-article (n) + "Save the current article using the default saver function. +If N is a positive number, save the N next articles. +If N is a negative number, save the N previous articles. +If N is nil and any articles have been marked with the process mark, +save those articles instead. +The variable `gnus-default-article-saver' specifies the saver function." + (interactive "P") + (let (articles process) + (if (and n (numberp n)) + (let ((backward (< n 0)) + (n (abs n))) + (save-excursion + (while (and (> n 0) + (setq articles (cons (gnus-summary-article-number) + articles)) + (gnus-summary-search-forward nil nil backward)) + (setq n (1- n)))) + (setq articles (sort articles (function <)))) + (if gnus-newsgroup-processable + (progn + (setq articles (setq gnus-newsgroup-processable + (nreverse gnus-newsgroup-processable))) + (setq process t)) + (setq articles (list (gnus-summary-article-number))))) + (while articles + (gnus-summary-display-article (car articles) t) + (if (not gnus-save-all-headers) + (gnus-article-hide-headers t)) + (if gnus-default-article-saver + (funcall gnus-default-article-saver) + (error "No default saver is defined.")) + (if process + (gnus-summary-remove-process-mark (car articles))) + (setq articles (cdr articles))) + (if process (setq gnus-newsgroup-processable + (nreverse gnus-newsgroup-processable))) + n)) + +(defun gnus-summary-pipe-output (arg) + "Pipe the current article to a subprocess. +If N is a positive number, pipe the N next articles. +If N is a negative number, pipe the N previous articles. +If N is nil and any articles have been marked with the process mark, +pipe those articles instead." + (interactive "P") + (let ((gnus-default-article-saver 'gnus-summary-save-in-pipe)) + (gnus-summary-save-article arg))) + +(defun gnus-summary-save-article-rmail (arg) + "Append the current article to an Rmail file. +If N is a positive number, save the N next articles. +If N is a negative number, save the N previous articles. +If N is nil and any articles have been marked with the process mark, +save those articles instead." + (interactive "P") + (let ((gnus-default-article-saver 'gnus-summary-save-in-rmail)) + (gnus-summary-save-article arg))) + +(defun gnus-summary-save-in-rmail (&optional filename) + "Append this article to Rmail file. +Optional argument FILENAME specifies file name. +Directory to save to is default to `gnus-article-save-directory' which +is initialized from the SAVEDIR environment variable." + (interactive) + (let ((default-name + (funcall gnus-rmail-save-name gnus-newsgroup-name + gnus-current-headers gnus-newsgroup-last-rmail))) + (or filename + (setq filename + (read-file-name + (concat "Save article in rmail file: (default " + (file-name-nondirectory default-name) ") ") + (file-name-directory default-name) + default-name))) + (gnus-make-directory (file-name-directory filename)) + (gnus-eval-in-buffer-window + gnus-article-buffer + (save-excursion + (save-restriction + (widen) + (gnus-output-to-rmail filename)))) + ;; Remember the directory name to save articles. + (setq gnus-newsgroup-last-rmail filename))) + +(defun gnus-summary-save-in-mail (&optional filename) + "Append this article to Unix mail file. +Optional argument FILENAME specifies file name. +Directory to save to is default to `gnus-article-save-directory' which +is initialized from the SAVEDIR environment variable." + (let ((default-name + (funcall gnus-mail-save-name gnus-newsgroup-name + gnus-current-headers gnus-newsgroup-last-mail))) + (or filename + (setq filename + (read-file-name + (concat "Save article in Unix mail file: (default " + (file-name-nondirectory default-name) ") ") + (file-name-directory default-name) + default-name))) + (setq filename + (expand-file-name filename + (and default-name + (file-name-directory default-name)))) + (gnus-make-directory (file-name-directory filename)) + (gnus-eval-in-buffer-window + gnus-article-buffer + (save-excursion + (save-restriction + (widen) + (if (and (file-readable-p filename) (rmail-file-p filename)) + (gnus-output-to-rmail filename) + (rmail-output filename 1 t t))))) + ;; Remember the directory name to save articles. + (setq gnus-newsgroup-last-mail filename))) + +(defun gnus-summary-save-in-file (&optional filename) + "Append this article to file. +Optional argument FILENAME specifies file name. +Directory to save to is default to `gnus-article-save-directory' which +is initialized from the SAVEDIR environment variable." + (let ((default-name + (funcall gnus-file-save-name gnus-newsgroup-name + gnus-current-headers gnus-newsgroup-last-file))) + (or filename + (setq filename + (read-file-name + (concat "Save article in file: (default " + (file-name-nondirectory default-name) ") ") + (file-name-directory default-name) + default-name))) + (gnus-make-directory (file-name-directory filename)) + (gnus-eval-in-buffer-window + gnus-article-buffer + (save-excursion + (save-restriction + (widen) + (gnus-output-to-file filename)))) + ;; Remember the directory name to save articles. + (setq gnus-newsgroup-last-file filename))) + +(defun gnus-summary-save-in-pipe (&optional command) + "Pipe this article to subprocess." + (let ((command (read-string "Shell command on article: " + gnus-last-shell-command))) + (if (string-equal command "") + (setq command gnus-last-shell-command)) + (gnus-eval-in-buffer-window + gnus-article-buffer + (save-restriction + (widen) + (shell-command-on-region (point-min) (point-max) command nil))) + (setq gnus-last-shell-command command))) + +;; Summary killfile commands + +(defun gnus-summary-edit-global-kill () + "Edit a global KILL file." + (interactive) + (setq gnus-current-kill-article (gnus-summary-article-number)) + (gnus-kill-file-edit-file nil) ;Nil stands for global KILL file. + (message + (substitute-command-keys + "Editing a global KILL file (Type \\[gnus-kill-file-exit] to exit)"))) + +(defun gnus-summary-edit-local-kill () + "Edit a local KILL file applied to the current newsgroup." + (interactive) + (setq gnus-current-kill-article (gnus-summary-article-number)) + (gnus-kill-file-edit-file gnus-newsgroup-name) + (message + (substitute-command-keys + "Editing a local KILL file (Type \\[gnus-kill-file-exit] to exit)"))) + + + +;;; +;;; Gnus Article Mode +;;; + +(if gnus-article-mode-map + nil + (setq gnus-article-mode-map (make-keymap)) + (suppress-keymap gnus-article-mode-map) + (define-key gnus-article-mode-map " " 'gnus-article-next-page) + (define-key gnus-article-mode-map "\177" 'gnus-article-prev-page) + (define-key gnus-article-mode-map "r" 'gnus-article-refer-article) + (define-key gnus-article-mode-map "h" 'gnus-article-show-summary) + (define-key gnus-article-mode-map "s" 'gnus-article-show-summary) + (define-key gnus-article-mode-map "m" 'gnus-article-mail) + (define-key gnus-article-mode-map "M" 'gnus-article-mail-with-original) + (define-key gnus-article-mode-map "?" 'gnus-article-describe-briefly) + (define-key gnus-article-mode-map "\C-c\C-i" 'gnus-info-find-node)) + +(defun gnus-article-mode () + "Major mode for browsing through an article. +All normal editing commands are switched off. +The following commands are available: + +\\ +\\[gnus-article-next-page]\t Scroll the article one page forwards +\\[gnus-article-prev-page]\t Scroll the article one page backwards +\\[gnus-article-refer-article]\t Go to the article referred to by an article id near point +\\[gnus-article-show-summary]\t Display the Summary buffer +\\[gnus-article-mail]\t Send a reply to the address near point +\\[gnus-article-mail-with-original]\t Send a reply to the address near point; include the original article +\\[gnus-article-describe-briefly]\t Describe the current mode briefly +\\[gnus-info-find-node]\t Go to the Gnus info node + +" + (interactive) + (kill-all-local-variables) + (setq mode-line-modified "--- ") + (setq major-mode 'gnus-article-mode) + (setq mode-name "Article") + (make-local-variable 'minor-mode-alist) + (or (assq 'gnus-show-mime minor-mode-alist) + (setq minor-mode-alist + (cons (list 'gnus-show-mime " MIME") minor-mode-alist))) + (use-local-map gnus-article-mode-map) + (make-local-variable 'page-delimiter) + (setq page-delimiter gnus-page-delimiter) + (make-local-variable 'mail-header-separator) + (setq mail-header-separator "") ;For caesar function. + (buffer-disable-undo (current-buffer)) + (setq buffer-read-only t) ;Disable modification + (run-hooks 'gnus-article-mode-hook)) + +(defun gnus-article-setup-buffer () + "Initialize Article mode buffer." + (or (get-buffer gnus-article-buffer) + (save-excursion + (set-buffer (get-buffer-create gnus-article-buffer)) + (gnus-add-current-to-buffer-list) + (gnus-article-mode)) + )) + +(defun gnus-request-article-this-buffer (article &optional group) + "Get an article and insert it into this buffer." + ;; Using `gnus-request-article' directly will insert the article into + ;; `nntp-server-buffer' - so we'll save some time by not having to + ;; copy it from the server buffer into the article buffer. + + ;; We only request an article by message-id when we do not have the + ;; headers for it, so we'll have to get those. + (if (stringp article) (gnus-read-header article)) + ;; If the article number is negative, that means that this article + ;; doesn't belong in this newsgroup (possibly), so we find its + ;; message-id and request it by id instead of number. + (if (and (numberp article) (< article 0)) + (save-excursion + (set-buffer gnus-summary-buffer) + (setq article + (header-id + (gnus-gethash (int-to-string article) + gnus-newsgroup-headers-hashtb-by-number))))) + ;; Get the article and into the article buffer. + (gnus-request-article article group (current-buffer))) + +(defun gnus-read-header (id) + "Read the headers of article ID and enter them into the Gnus system." + (or gnus-newsgroup-headers-hashtb-by-number + (gnus-make-headers-hashtable-by-number)) + (let (header) + (if (not (setq header + (car (if (let ((nntp-xover-is-evil t)) + (gnus-retrieve-headers (list id) + gnus-newsgroup-name)) + (gnus-get-newsgroup-headers))))) + nil + (if (stringp id) + (header-set-number header gnus-reffed-article-number)) + (setq gnus-newsgroup-headers (cons header gnus-newsgroup-headers)) + (gnus-sethash (int-to-string (header-number header)) header + gnus-newsgroup-headers-hashtb-by-number) + (if (stringp id) + (setq gnus-reffed-article-number (1- gnus-reffed-article-number))) + (setq gnus-current-headers header) + header))) + +(defun gnus-article-prepare (article &optional all-headers header) + "Prepare ARTICLE in Article mode buffer. +ARTICLE can be either a article number or Message-ID. +If ARTICLE is an id, HEADER should be the article headers. +If ALL-HEADERS is non-nil, no headers are hidden." + (save-excursion + ;; Make sure we start are in a Summary buffer. + (if (eq major-mode 'gnus-summary-mode) + (setq gnus-summary-buffer (current-buffer)) + (set-buffer gnus-summary-buffer)) + ;; Make sure the connection to the server is alive. + (if (not (gnus-server-opened gnus-current-select-method)) + (progn + (gnus-check-news-server gnus-current-select-method) + (gnus-request-group gnus-newsgroup-name t))) + (or gnus-newsgroup-headers-hashtb-by-number + (gnus-make-headers-hashtable-by-number)) + (let* ((article (if header (header-number header) article)) + (summary-buffer (current-buffer)) + (internal-hook gnus-article-internal-prepare-hook) + (bookmark (cdr (assq article gnus-newsgroup-bookmarks))) + (group gnus-newsgroup-name)) + (save-excursion + (set-buffer gnus-article-buffer) + (let ((buffer-read-only nil)) + (erase-buffer) + (prog1 + (if (gnus-request-article-this-buffer article group) + (progn + ;; gnus-have-all-headers must be either T or NIL. + (setq gnus-have-all-headers + (not (not (or all-headers gnus-show-all-headers)))) + (if (and (numberp article) + (not (eq article gnus-current-article))) + ;; Seems like a new article has been selected. + (progn + ;; `gnus-current-article' must be an article number. + (save-excursion + (set-buffer summary-buffer) + (setq gnus-last-article gnus-current-article) + (setq gnus-current-article article) + (setq gnus-current-headers + (gnus-get-header-by-number + gnus-current-article)) + (setq gnus-article-current + (cons gnus-newsgroup-name + (header-number gnus-current-headers))) + (run-hooks 'gnus-mark-article-hook) + ;; Set the global newsgroup variables here. + ;; Suggested by Jim Sisolak + ;; . + (gnus-set-global-variables)))) + ;; Hooks for getting information from the article. + ;; This hook must be called before being narrowed. + (run-hooks 'internal-hook) + (run-hooks 'gnus-article-prepare-hook) + ;; Decode MIME message. + (if (and gnus-show-mime + (gnus-fetch-field "Mime-Version")) + (funcall gnus-show-mime-method)) + ;; Perform the article display hooks. + (let ((buffer-read-only nil)) + (run-hooks 'gnus-article-display-hook)) + ;; Do page break. + (goto-char (point-min)) + (if gnus-break-pages + (gnus-narrow-to-page)) + (gnus-set-mode-line 'article) + t) + ;; There is no such article. + (if (numberp article) + (gnus-summary-mark-as-read article)) + (ding) + (message "No such article (may be canceled)") + nil) + (goto-char 1) + (if bookmark + (progn + (message "Moved to bookmark.") + (search-forward "\n\n" nil t) + (forward-line bookmark))) + (set-window-start + (get-buffer-window gnus-article-buffer) (point)))))))) + +(defun gnus-set-global-variables () + ;; Set the global equivalents of the Summary buffer-local variables + ;; to the latest values they had. These reflect the Summary buffer + ;; that was in action when the last article was fetched. + (let ((name gnus-newsgroup-name) + (marked gnus-newsgroup-marked) + (unread gnus-newsgroup-unreads) + (headers gnus-current-headers)) + (save-excursion + (set-buffer gnus-group-buffer) + (setq gnus-newsgroup-name name) + (setq gnus-newsgroup-marked marked) + (setq gnus-newsgroup-unreads unread) + (setq gnus-current-headers headers)))) + +(defun gnus-article-show-all-headers () + "Show all article headers in Article mode buffer." + (save-excursion + (setq gnus-have-all-headers t) + (gnus-article-setup-buffer) + (set-buffer gnus-article-buffer) + (let ((buffer-read-only nil)) + (remove-text-properties 1 (point-max) '(invisible t))))) + +(defun gnus-article-hide-headers-if-wanted () + "Hide unwanted headers if `gnus-have-all-headers' is nil. +Provided for backwards compatability." + (or gnus-have-all-headers + (gnus-article-hide-headers))) + +(defun gnus-article-hide-headers (&optional delete) + "Hide unwanted headers and possibly sort them as well." + (save-excursion + (save-restriction + (let ((sorted gnus-sorted-header-list) + (buffer-read-only nil) + want want-list beg want-l) + ;; First we narrow to just the headers. + (widen) + (goto-char 1) + (narrow-to-region + 1 (progn (search-forward "\n\n" nil t) (forward-line -1) (point))) + ;; Then we use the two regular expressions + ;; `gnus-ignored-headers' and `gnus-visible-headers' to + ;; select which header lines is to remain visible in the + ;; article buffer. + (goto-char 1) + (while (re-search-forward "^[^ \t]*:" nil t) + (beginning-of-line) + ;; We add the headers we want to keep to a list and delete + ;; them from the buffer. + (if (or (and (stringp gnus-visible-headers) + (looking-at gnus-visible-headers)) + (and (not (stringp gnus-visible-headers)) + (stringp gnus-ignored-headers) + (not (looking-at gnus-ignored-headers)))) + (progn + (setq beg (point)) + (forward-line 1) + ;; Be sure to get multi-line headers... + (re-search-forward "^[^ \t]*:" nil t) + (beginning-of-line) + (setq want-list + (cons (buffer-substring beg (point)) want-list)) + (delete-region beg (point)) + (goto-char beg)) + (forward-line 1))) + ;; Next we perform the sorting by looking at + ;; `gnus-sorted-header-list'. + (goto-char 1) + (while (and sorted want-list) + (setq want-l want-list) + (while (and want-l + (not (string-match (car sorted) (car want-l)))) + (setq want-l (cdr want-l))) + (if want-l + (progn + (insert (car want-l)) + (setq want-list (delq (car want-l) want-list)))) + (setq sorted (cdr sorted))) + ;; Any headers that were not matched by the sorted list we + ;; just tack on the end of the visible header list. + (while want-list + (insert (car want-list)) + (setq want-list (cdr want-list))) + ;; And finally we make the unwanted headers invisible. + (if delete + (delete-region (point) (point-max)) + (set-text-properties (point) (point-max) '(invisible t))))))) + +(defun gnus-article-hide-signature () + "Hides the signature in an article. +It does this by hiding everyting after "^-- *$", which is what all +signatures should be preceded by. Note that this may mean that parts +of an article may disappear if the article has such a line in the +middle of the text." + (save-excursion + (goto-char (point-max)) + (if (re-search-backward "^-- *$" nil t) + (progn + (add-text-properties (point) (point-max) '(invisible t)))))) + +(defun gnus-article-hide-citation () + "Hide all cited text. +This function uses the famous, extremely intelligent \"shoot in foot\" +algorithm - which is simply deleting all lines that start with +\">\". Your mileage may vary. If you come up with anything better, +please do mail it to me." + (save-excursion + (goto-char 1) + (search-forward "\n\n" nil t) + (while (not (eobp)) + (if (looking-at ">") + (add-text-properties + (point) (save-excursion (forward-line 1) (point)) + '(invisible t))) + (forward-line 1)))) + +;; Article savers. + +(defun gnus-output-to-rmail (file-name) + "Append the current article to an Rmail file named FILE-NAME." + (require 'rmail) + ;; Most of these codes are borrowed from rmailout.el. + (setq file-name (expand-file-name file-name)) + (setq rmail-default-rmail-file file-name) + (let ((artbuf (current-buffer)) + (tmpbuf (get-buffer-create " *Gnus-output*"))) + (save-excursion + (or (get-file-buffer file-name) + (file-exists-p file-name) + (if (yes-or-no-p + (concat "\"" file-name "\" does not exist, create it? ")) + (let ((file-buffer (create-file-buffer file-name))) + (save-excursion + (set-buffer file-buffer) + (rmail-insert-rmail-file-header) + (let ((require-final-newline nil)) + (write-region (point-min) (point-max) file-name t 1))) + (kill-buffer file-buffer)) + (error "Output file does not exist"))) + (set-buffer tmpbuf) + (buffer-disable-undo (current-buffer)) + (erase-buffer) + (insert-buffer-substring artbuf) + (gnus-convert-article-to-rmail) + ;; Decide whether to append to a file or to an Emacs buffer. + (let ((outbuf (get-file-buffer file-name))) + (if (not outbuf) + (append-to-file (point-min) (point-max) file-name) + ;; File has been visited, in buffer OUTBUF. + (set-buffer outbuf) + (let ((buffer-read-only nil) + (msg (and (boundp 'rmail-current-message) + rmail-current-message))) + ;; If MSG is non-nil, buffer is in RMAIL mode. + (if msg + (progn (widen) + (narrow-to-region (point-max) (point-max)))) + (insert-buffer-substring tmpbuf) + (if msg + (progn + (goto-char (point-min)) + (widen) + (search-backward "\^_") + (narrow-to-region (point) (point-max)) + (goto-char (1+ (point-min))) + (rmail-count-new-messages t) + (rmail-show-message msg)))))) + ) + (kill-buffer tmpbuf) + )) + +(defun gnus-output-to-file (file-name) + "Append the current article to a file named FILE-NAME." + (setq file-name (expand-file-name file-name)) + (let ((artbuf (current-buffer)) + (tmpbuf (get-buffer-create " *Gnus-output*"))) + (save-excursion + (set-buffer tmpbuf) + (buffer-disable-undo (current-buffer)) + (erase-buffer) + (insert-buffer-substring artbuf) + ;; Append newline at end of the buffer as separator, and then + ;; save it to file. + (goto-char (point-max)) + (insert "\n") + (append-to-file (point-min) (point-max) file-name)) + (kill-buffer tmpbuf) + )) + +(defun gnus-convert-article-to-rmail () + "Convert article in current buffer to Rmail message format." + (let ((buffer-read-only nil)) + ;; Convert article directly into Babyl format. + ;; Suggested by Rob Austein + (goto-char (point-min)) + (insert "\^L\n0, unseen,,\n*** EOOH ***\n") + (while (search-forward "\n\^_" nil t) ;single char + (replace-match "\n^_")) ;2 chars: "^" and "_" + (goto-char (point-max)) + (insert "\^_"))) + +(defun gnus-narrow-to-page (&optional arg) + "Make text outside current page invisible except for page delimiter. +A numeric arg specifies to move forward or backward by that many pages, +thus showing a page other than the one point was originally in." + (interactive "P") + (setq arg (if arg (prefix-numeric-value arg) 0)) + (save-excursion + (forward-page -1) ;Beginning of current page. + (widen) + (if (> arg 0) + (forward-page arg) + (if (< arg 0) + (forward-page (1- arg)))) + ;; Find the end of the page. + (forward-page) + ;; If we stopped due to end of buffer, stay there. + ;; If we stopped after a page delimiter, put end of restriction + ;; at the beginning of that line. + ;; These are commented out. + ;; (if (save-excursion (beginning-of-line) + ;; (looking-at page-delimiter)) + ;; (beginning-of-line)) + (narrow-to-region (point) + (progn + ;; Find the top of the page. + (forward-page -1) + ;; If we found beginning of buffer, stay there. + ;; If extra text follows page delimiter on same line, + ;; include it. + ;; Otherwise, show text starting with following line. + (if (and (eolp) (not (bobp))) + (forward-line 1)) + (point))) + )) + +(defun gnus-gmt-to-local () + "Rewrite Date: field described in GMT to local in current buffer. +The variable gnus-local-timezone is used for local time zone. +Intended to be used with gnus-article-prepare-hook." + (save-excursion + (save-restriction + (widen) + (goto-char (point-min)) + (narrow-to-region (point-min) + (progn (search-forward "\n\n" nil 'move) (point))) + (goto-char (point-min)) + (if (re-search-forward "^Date:[ \t]\\(.*\\)$" nil t) + (let ((buffer-read-only nil) + (date (buffer-substring (match-beginning 1) (match-end 1)))) + (delete-region (match-beginning 1) (match-end 1)) + (insert + (timezone-make-date-arpa-standard date nil gnus-local-timezone)) + )) + ))) + + +;; Article mode commands + +(defun gnus-article-next-page (lines) + "Show next page of current article. +If end of article, return non-nil. Otherwise return nil. +Argument LINES specifies lines to be scrolled up." + (interactive "P") + (move-to-window-line -1) + ;; Fixed by enami@ptgd.sony.co.jp (enami tsugutomo) + (if (save-excursion + (end-of-line) + (and (pos-visible-in-window-p) ;Not continuation line. + (eobp))) + ;; Nothing in this page. + (if (or (not gnus-break-pages) + (save-excursion + (save-restriction + (widen) (forward-line 1) (eobp)))) ;Real end-of-buffer? + t ;Nothing more. + (gnus-narrow-to-page 1) ;Go to next page. + nil + ) + ;; More in this page. + (condition-case () + (scroll-up lines) + (end-of-buffer + ;; Long lines may cause an end-of-buffer error. + (goto-char (point-max)))) + nil + )) + +(defun gnus-article-prev-page (lines) + "Show previous page of current article. +Argument LINES specifies lines to be scrolled down." + (interactive "P") + (move-to-window-line 0) + (if (and gnus-break-pages + (bobp) + (not (save-restriction (widen) (bobp)))) ;Real beginning-of-buffer? + (progn + (gnus-narrow-to-page -1) ;Go to previous page. + (goto-char (point-max)) + (recenter -1)) + (scroll-down lines))) + +(defun gnus-article-next-digest (nth) + "Move to head of NTH next digested message. +Set mark at end of digested message." + ;; Stop page breaking in digest mode. + (widen) + (end-of-line) + ;; Skip NTH - 1 digest. + ;; Suggested by Khalid Sattar . + ;; Digest separator is customizable. + ;; Suggested by Skip Montanaro . + (while (and (> nth 1) + (re-search-forward gnus-digest-separator nil 'move)) + (setq nth (1- nth))) + (if (re-search-forward gnus-digest-separator nil t) + (let ((begin (point))) + ;; Search for end of this message. + (end-of-line) + (if (re-search-forward gnus-digest-separator nil t) + (progn + (search-backward "\n\n") ;This may be incorrect. + (forward-line 1)) + (goto-char (point-max))) + (push-mark) ;Set mark at end of digested message. + (goto-char begin) + (beginning-of-line) + ;; Show From: and Subject: fields. + (recenter 1)) + (message "End of message") + )) + +(defun gnus-article-prev-digest (nth) + "Move to head of NTH previous digested message." + ;; Stop page breaking in digest mode. + (widen) + (beginning-of-line) + ;; Skip NTH - 1 digest. + ;; Suggested by Khalid Sattar . + ;; Digest separator is customizable. + ;; Suggested by Skip Montanaro . + (while (and (> nth 1) + (re-search-backward gnus-digest-separator nil 'move)) + (setq nth (1- nth))) + (if (re-search-backward gnus-digest-separator nil t) + (let ((begin (point))) + ;; Search for end of this message. + (end-of-line) + (if (re-search-forward gnus-digest-separator nil t) + (progn + (search-backward "\n\n") ;This may be incorrect. + (forward-line 1)) + (goto-char (point-max))) + (push-mark) ;Set mark at end of digested message. + (goto-char begin) + ;; Show From: and Subject: fields. + (recenter 1)) + (goto-char (point-min)) + (message "Top of message") + )) + +(defun gnus-article-refer-article () + "Read article specified by message-id around point." + (interactive) + (save-window-excursion + (save-excursion + (re-search-forward ">" nil t) ;Move point to end of "<....>". + (if (re-search-backward "\\(<[^<> \t\n]+>\\)" nil t) + (let ((message-id + (buffer-substring (match-beginning 1) (match-end 1)))) + (set-buffer gnus-summary-buffer) + (gnus-summary-refer-article message-id)) + (error "No references around point")) + ))) + +(defun gnus-article-mail (yank) + "Send a reply to the address near point. +If YANK is non-nil, include the original article." + (interactive "P") + (let ((address + (buffer-substring + (save-excursion (re-search-backward "[ \t\n]" nil t) (1+ (point))) + (save-excursion (re-search-forward "[ \t\n]" nil t) (1- (point)))))) + (and address + (progn + (switch-to-buffer gnus-summary-buffer) + (funcall gnus-mail-reply-method yank address))))) + +(defun gnus-article-mail-with-original () + "Send a reply to the address near point and include the original article." + (interactive) + (gnus-article-mail 'yank)) + +(defun gnus-article-show-summary () + "Reconfigure windows to show Summary buffer." + (interactive) + (gnus-configure-windows 'article) + (pop-to-buffer gnus-summary-buffer) + (gnus-summary-goto-subject gnus-current-article)) + +(defun gnus-article-describe-briefly () + "Describe Article mode commands briefly." + (interactive) + (message + (substitute-command-keys "\\[gnus-article-next-page]:Next page \\[gnus-article-prev-page]:Prev page \\[gnus-article-show-summary]:Show Summary \\[gnus-info-find-node]:Run Info \\[gnus-article-describe-briefly]:This help"))) + +;; caesar-region written by phr@prep.ai.mit.edu Nov 86 +;; Modified by tower@prep Nov 86 +;; Modified by umerin@flab.flab.Fujitsu.JUNET for ROT47. + +(defun gnus-caesar-region (&optional n) + "Caesar rotation of region by N, default 13, for decrypting netnews. +ROT47 will be performed for Japanese text in any case." + (interactive (if current-prefix-arg ; Was there a prefix arg? + (list (prefix-numeric-value current-prefix-arg)) + (list nil))) + (cond ((not (numberp n)) (setq n 13)) + (t (setq n (mod n 26)))) ;canonicalize N + (if (not (zerop n)) ; no action needed for a rot of 0 + (progn + (if (or (not (boundp 'caesar-translate-table)) + (not caesar-translate-table) + (/= (aref caesar-translate-table ?a) (+ ?a n))) + (let ((i 0) (lower "abcdefghijklmnopqrstuvwxyz") upper) + (message "Building caesar-translate-table...") + (setq caesar-translate-table (make-vector 256 0)) + (while (< i 256) + (aset caesar-translate-table i i) + (setq i (1+ i))) + (setq lower (concat lower lower) upper (upcase lower) i 0) + (while (< i 26) + (aset caesar-translate-table (+ ?a i) (aref lower (+ i n))) + (aset caesar-translate-table (+ ?A i) (aref upper (+ i n))) + (setq i (1+ i))) + ;; ROT47 for Japanese text. + ;; Thanks to ichikawa@flab.fujitsu.junet. + (setq i 161) + (let ((t1 (logior ?O 128)) + (t2 (logior ?! 128)) + (t3 (logior ?~ 128))) + (while (< i 256) + (aset caesar-translate-table i + (let ((v (aref caesar-translate-table i))) + (if (<= v t1) (if (< v t2) v (+ v 47)) + (if (<= v t3) (- v 47) v)))) + (setq i (1+ i)))) + (message "Building caesar-translate-table... done"))) + (let ((from (region-beginning)) + (to (region-end)) + (i 0) str len) + (setq str (buffer-substring from to)) + (setq len (length str)) + (while (< i len) + (aset str i (aref caesar-translate-table (aref str i))) + (setq i (1+ i))) + (goto-char from) + (delete-region from to) + (insert str))))) + + +;;; +;;; Gnus KILL-File Mode +;;; + +(if gnus-kill-file-mode-map + nil + (setq gnus-kill-file-mode-map (copy-keymap emacs-lisp-mode-map)) + (define-key gnus-kill-file-mode-map "\C-c\C-k\C-s" 'gnus-kill-file-kill-by-subject) + (define-key gnus-kill-file-mode-map "\C-c\C-k\C-a" 'gnus-kill-file-kill-by-author) + (define-key gnus-kill-file-mode-map "\C-c\C-a" 'gnus-kill-file-apply-buffer) + (define-key gnus-kill-file-mode-map "\C-c\C-e" 'gnus-kill-file-apply-last-sexp) + (define-key gnus-kill-file-mode-map "\C-c\C-c" 'gnus-kill-file-exit) + (define-key gnus-kill-file-mode-map "\C-c\C-i" 'gnus-info-find-node)) + +(defun gnus-kill-file-mode () + "Major mode for editing KILL file. + +In addition to Emacs-Lisp Mode, the following commands are available: + +\\[gnus-kill-file-kill-by-subject] Insert KILL command for current subject. +\\[gnus-kill-file-kill-by-author] Insert KILL command for current author. +\\[gnus-kill-file-apply-buffer] Apply current buffer to selected newsgroup. +\\[gnus-kill-file-apply-last-sexp] Apply sexp before point to selected newsgroup. +\\[gnus-kill-file-exit] Save file and exit editing KILL file. +\\[gnus-info-find-node] Read Info about KILL file. + + A KILL file contains Lisp expressions to be applied to a selected +newsgroup. The purpose is to mark articles as read on the basis of +some set of regexps. A global KILL file is applied to every newsgroup, +and a local KILL file is applied to a specified newsgroup. Since a +global KILL file is applied to every newsgroup, for better performance +use a local one. + + A KILL file can contain any kind of Emacs Lisp expressions expected +to be evaluated in the Summary buffer. Writing Lisp programs for this +purpose is not so easy because the internal working of Gnus must be +well-known. For this reason, Gnus provides a general function which +does this easily for non-Lisp programmers. + + The `gnus-kill' function executes commands available in Summary Mode +by their key sequences. `gnus-kill' should be called with FIELD, +REGEXP and optional COMMAND and ALL. FIELD is a string representing +the header field or an empty string. If FIELD is an empty string, the +entire article body is searched for. REGEXP is a string which is +compared with FIELD value. COMMAND is a string representing a valid +key sequence in Summary mode or Lisp expression. COMMAND defaults to +'(gnus-summary-mark-as-read nil \"X\"). Make sure that COMMAND is +executed in the Summary buffer. If the second optional argument ALL +is non-nil, the COMMAND is applied to articles which are already +marked as read or unread. Articles which are marked are skipped over +by default. + + For example, if you want to mark articles of which subjects contain +the string `AI' as read, a possible KILL file may look like: + + (gnus-kill \"Subject\" \"AI\") + + If you want to mark articles with `D' instead of `X', you can use +the following expression: + + (gnus-kill \"Subject\" \"AI\" \"d\") + +In this example it is assumed that the command +`gnus-summary-mark-as-read-forward' is assigned to `d' in Summary Mode. + + It is possible to delete unnecessary headers which are marked with +`X' in a KILL file as follows: + + (gnus-expunge \"X\") + + If the Summary buffer is empty after applying KILL files, Gnus will +exit the selected newsgroup normally. If headers which are marked +with `D' are deleted in a KILL file, it is impossible to read articles +which are marked as read in the previous Gnus sessions. Marks other +than `D' should be used for articles which should really be deleted. + +Entry to this mode calls emacs-lisp-mode-hook and +gnus-kill-file-mode-hook with no arguments, if that value is non-nil." + (interactive) + (kill-all-local-variables) + (use-local-map gnus-kill-file-mode-map) + (set-syntax-table emacs-lisp-mode-syntax-table) + (setq major-mode 'gnus-kill-file-mode) + (setq mode-name "KILL-File") + (lisp-mode-variables nil) + (run-hooks 'emacs-lisp-mode-hook 'gnus-kill-file-mode-hook)) + +(defun gnus-kill-file-edit-file (newsgroup) + "Begin editing a KILL file of NEWSGROUP. +If NEWSGROUP is nil, the global KILL file is selected." + (interactive "sNewsgroup: ") + (let ((file (gnus-newsgroup-kill-file newsgroup))) + (gnus-make-directory (file-name-directory file)) + ;; Save current window configuration if this is first invocation. + (or (and (get-file-buffer file) + (get-buffer-window (get-file-buffer file))) + (setq gnus-winconf-kill-file (current-window-configuration))) + ;; Hack windows. + (let ((buffer (find-file-noselect file))) + (cond ((get-buffer-window buffer) + (pop-to-buffer buffer)) + ((eq major-mode 'gnus-group-mode) + (gnus-configure-windows '(1 0 0)) ;Take all windows. + (pop-to-buffer gnus-group-buffer) + (let ((gnus-summary-buffer buffer)) + (gnus-configure-windows '(1 1 0)) ;Split into two. + (pop-to-buffer buffer))) + ((eq major-mode 'gnus-summary-mode) + (gnus-configure-windows 'article) + (pop-to-buffer gnus-article-buffer) + (bury-buffer gnus-article-buffer) + (switch-to-buffer buffer)) + (t ;No good rules. + (find-file-other-window file)) + )) + (gnus-kill-file-mode) + )) + +(defun gnus-kill-set-kill-buffer () + (let ((file (gnus-newsgroup-kill-file gnus-newsgroup-name))) + (if (get-buffer file) + (set-buffer (get-buffer file)) + (set-buffer (find-file-noselect file))))) + +(defun gnus-kill-save-kill-buffer () + (let ((file (gnus-newsgroup-kill-file gnus-newsgroup-name))) + (if (get-buffer file) + (save-excursion + (set-buffer (get-buffer file)) + (save-buffer) + (kill-buffer (current-buffer)))))) + +(defun gnus-article-fetch-field (field) + (save-excursion + (set-buffer gnus-article-buffer) + (save-restriction + (widen) + (goto-char 1) + (narrow-to-region 1 (save-excursion + (search-forward "\n\n" nil t) (point))) + (goto-char 1) + (prog1 + (mail-fetch-field field) + (widen))))) + +(defun gnus-kill-file-enter-kill (field regexp) + (save-excursion + (gnus-kill-set-kill-buffer) + (insert (format "(gnus-kill \"%s\" \"%s\") ; ttl=5\n" + field regexp)))) + +(defun gnus-kill-file-kill-by-subject () + "Insert KILL command for current subject." + (interactive) + (gnus-kill-file-enter-kill + "Subject" (regexp-quote (header-subject gnus-current-headers)))) + +(defun gnus-kill-file-kill-by-author () + "Insert KILL command for current author." + (interactive) + (gnus-kill-file-enter-kill + "From" (regexp-quote (header-from gnus-current-headers)))) + +(defun gnus-kill-file-kill-by-thread () + "Insert KILL command for current thread." + (interactive) + (gnus-kill-file-enter-kill + "References" (concat ".*" (regexp-quote + (header-id gnus-current-headers))))) + +(defun gnus-kill-file-kill-by-xref () + "Insert KILL command for current xref." + (interactive) + (let ((xref (header-xref gnus-current-headers)) + (start 0) + (string "") + group) + (if xref + (progn + (while (string-match " \\([a-zA-Z\.]\\):" xref start) + (if (not (string= (setq group (substring (match-beginning 1) + (match-end 1))) + gnus-newsgroup-name)) + (setq string (concat string ".*" (regexp-quote group)))) + (setq start (match-end 0))) + (gnus-kill-file-enter-kill + "Xref" string))))) + +(defun gnus-kill-file-apply-buffer () + "Apply current buffer to current newsgroup." + (interactive) + (if (and gnus-current-kill-article + (get-buffer gnus-summary-buffer)) + ;; Assume newsgroup is selected. + (let ((string (concat "(progn \n" (buffer-string) "\n)" ))) + (save-excursion + (save-window-excursion + (pop-to-buffer gnus-summary-buffer) + (eval (car (read-from-string string)))))) + (ding) (message "No newsgroup is selected."))) + +(defun gnus-kill-file-apply-last-sexp () + "Apply sexp before point in current buffer to current newsgroup." + (interactive) + (if (and gnus-current-kill-article + (get-buffer gnus-summary-buffer)) + ;; Assume newsgroup is selected. + (let ((string + (buffer-substring + (save-excursion (forward-sexp -1) (point)) (point)))) + (save-excursion + (save-window-excursion + (pop-to-buffer gnus-summary-buffer) + (eval (car (read-from-string string)))))) + (ding) (message "No newsgroup is selected."))) + +(defun gnus-kill-file-exit () + "Save a KILL file, then return to the previous buffer." + (interactive) + (save-buffer) + (let ((killbuf (current-buffer))) + ;; We don't want to return to Article buffer. + (and (get-buffer gnus-article-buffer) + (bury-buffer (get-buffer gnus-article-buffer))) + ;; Delete the KILL file windows. + (delete-windows-on killbuf) + ;; Restore last window configuration if available. + (and gnus-winconf-kill-file + (set-window-configuration gnus-winconf-kill-file)) + (setq gnus-winconf-kill-file nil) + ;; Kill the KILL file buffer. Suggested by tale@pawl.rpi.edu. + (kill-buffer killbuf))) + +;; Basic ideas by emv@math.lsa.umich.edu (Edward Vielmetti) + +(defun gnus-batch-kill () + "Run batched KILL. +Usage: emacs -batch -l gnus -f gnus-batch-kill NEWSGROUP ..." + (if (not noninteractive) + (error "gnus-batch-kill is to be used only with -batch")) + (let* ((group nil) + (subscribed nil) + (newsrc nil) + (yes-and-no + (gnus-parse-n-options + (apply (function concat) + (mapcar (lambda (g) (concat g " ")) + command-line-args-left)))) + (yes (car yes-and-no)) + (no (cdr yes-and-no)) + ;; Disable verbose message. + (gnus-novice-user nil) + (gnus-large-newsgroup nil)) + ;; Eat all arguments. + (setq command-line-args-left nil) + ;; Startup Gnus. + (gnus) + ;; Apply kills to specified newsgroups in command line arguments. + (setq newsrc (copy-sequence gnus-newsrc-assoc)) + (while newsrc + (setq group (car (car newsrc))) + (setq subscribed (nth 1 (car newsrc))) + (setq newsrc (cdr newsrc)) + (if (and subscribed + (not (zerop (car (gnus-gethash group gnus-newsrc-hashtb)))) + (if yes + (string-match yes group) t) + (or (null no) + (not (string-match no group)))) + (progn + (gnus-summary-read-group group nil t) + (if (eq (current-buffer) (get-buffer gnus-summary-buffer)) + (gnus-summary-exit t)) + )) + ) + ;; Finally, exit Emacs. + (set-buffer gnus-group-buffer) + (gnus-group-exit) + )) + +;; For KILL files + +(defun gnus-apply-kill-file () + "Apply KILL file to the current newsgroup." + ;; Apply the global KILL file. + (load (gnus-newsgroup-kill-file nil) t nil t) + ;; And then apply the local KILL file. + (load (gnus-newsgroup-kill-file gnus-newsgroup-name) t nil t)) + +(defun gnus-Newsgroup-kill-file (newsgroup) + "Return the name of a KILL file of NEWSGROUP. +If NEWSGROUP is nil, return the global KILL file instead." + (cond ((or (null newsgroup) + (string-equal newsgroup "")) + ;; The global KILL file is placed at top of the directory. + (expand-file-name gnus-kill-file-name + (or gnus-kill-files-directory "~/News"))) + (gnus-use-long-file-name + ;; Append ".KILL" to capitalized newsgroup name. + (expand-file-name (concat (gnus-capitalize-newsgroup newsgroup) + "." gnus-kill-file-name) + (or gnus-kill-files-directory "~/News"))) + (t + ;; Place "KILL" under the hierarchical directory. + (expand-file-name (concat (gnus-newsgroup-directory-form newsgroup) + "/" gnus-kill-file-name) + (or gnus-kill-files-directory "~/News"))) + )) + +(defun gnus-newsgroup-kill-file (newsgroup) + "Return the name of a KILL file of NEWSGROUP. +If NEWSGROUP is nil, return the global KILL file instead." + (cond ((or (null newsgroup) + (string-equal newsgroup "")) + ;; The global KILL file is placed at top of the directory. + (expand-file-name gnus-kill-file-name + (or gnus-kill-files-directory "~/News"))) + (gnus-use-long-file-name + ;; Append ".KILL" to newsgroup name. + (expand-file-name (concat newsgroup "." gnus-kill-file-name) + (or gnus-kill-files-directory "~/News"))) + (t + ;; Place "KILL" under the hierarchical directory. + (expand-file-name (concat (gnus-newsgroup-directory-form newsgroup) + "/" gnus-kill-file-name) + (or gnus-kill-files-directory "~/News"))) + )) + + +(defalias 'gnus-expunge 'gnus-summary-delete-marked-with) + +(defun gnus-kill (field regexp &optional command all) + "If FIELD of an article matches REGEXP, execute COMMAND. +Optional 1st argument COMMAND is default to + (gnus-summary-mark-as-read nil \"X\"). +If optional 2nd argument ALL is non-nil, articles marked are also applied to. +If FIELD is an empty string (or nil), entire article body is searched for. +COMMAND must be a lisp expression or a string representing a key sequence." + ;; We don't want to change current point nor window configuration. + (save-excursion + (save-window-excursion + ;; Selected window must be Summary buffer to execute keyboard + ;; macros correctly. See command_loop_1. + (switch-to-buffer gnus-summary-buffer 'norecord) + (goto-char (point-min)) ;From the beginning. + (if (null command) + (setq command '(gnus-summary-mark-as-read nil "X"))) + (gnus-execute field regexp command nil (not all)) + ))) + +(defun gnus-execute (field regexp form &optional backward ignore-marked) + "If FIELD of article header matches REGEXP, execute lisp FORM (or a string). +If FIELD is an empty string (or nil), entire article body is searched for. +If optional 1st argument BACKWARD is non-nil, do backward instead. +If optional 2nd argument IGNORE-MARKED is non-nil, articles which are +marked as read or ticked are ignored." + (let ((function nil) + (header nil) + (article nil)) + (if (string-equal field "") + (setq field nil)) + (if (null field) + nil + (or (stringp field) + (setq field (symbol-name field))) + ;; Get access function of header filed. + (setq function (intern-soft (concat "gnus-header-" (downcase field)))) + (if (and function (fboundp function)) + (setq function (symbol-function function)) + (error "Unknown header field: \"%s\"" field))) + ;; Make FORM funcallable. + (if (and (listp form) (not (eq (car form) 'lambda))) + (setq form (list 'lambda nil form))) + ;; Starting from the current article. + (while (gnus-summary-search-subject backward ignore-marked nil) + (setq article (gnus-summary-article-number)) + (or (gnus-member-of-range article gnus-newsgroup-killed) + (and ignore-marked + ;; Articles marked as read, ticked and interesting + ;; should be ignored. + (or (not (memq article gnus-newsgroup-unreads)) + (memq article gnus-newsgroup-marked) + (memq article gnus-newsgroup-interesting))) + (gnus-execute-1 function regexp form))))) + +(defun gnus-execute-1 (function regexp form) + (save-excursion + ;; The point of Summary buffer must be saved during execution. + (let ((article (gnus-summary-article-number))) + (if (null article) + nil ;Nothing to do. + (if function + ;; Compare with header field. + (let ((header (gnus-get-header-by-number article)) + (value nil)) + (and header + (progn + (setq value (funcall function header)) + ;; Number (Lines:) or symbol must be converted to string. + (or (stringp value) + (setq value (prin1-to-string value))) + (string-match regexp value)) + (if (stringp form) ;Keyboard macro. + (execute-kbd-macro form) + (funcall form)))) + ;; Search article body. + (let ((gnus-current-article nil) ;Save article pointer. + (gnus-last-article nil) + (gnus-break-pages nil) ;No need to break pages. + (gnus-mark-article-hook nil)) ;Inhibit marking as read. + (message "Searching for article: %d..." article) + (gnus-article-setup-buffer) + (gnus-article-prepare article t) + (if (save-excursion + (set-buffer gnus-article-buffer) + (goto-char (point-min)) + (re-search-forward regexp nil t)) + (if (stringp form) ;Keyboard macro. + (execute-kbd-macro form) + (funcall form)))) + )) + ))) + + + +;;; +;;; Gnus Posting Functions +;;; + +(defvar gnus-organization-file "/usr/lib/news/organization" + "*Local news organization file.") + +(defvar gnus-post-news-buffer "*post-news*") +(defvar gnus-winconf-post-news nil) + +(autoload 'news-reply-mode "rnewspost") + +;;; Post news commands of Gnus Group Mode and Summary Mode + +(defun gnus-group-post-news () + "Post an article." + (interactive) + ;; Save window configuration. + (setq gnus-winconf-post-news (current-window-configuration)) + ;; Fix by Sudish Joseph . + (or gnus-newsgroup-name (setq gnus-newsgroup-name (gnus-group-group-name))) + (unwind-protect + (gnus-post-news 'post nil) + (or (and (eq (current-buffer) (get-buffer gnus-post-news-buffer)) + (not (zerop (buffer-size)))) + ;; Restore last window configuration. + (set-window-configuration gnus-winconf-post-news))) + ;; We don't want to return to Summary buffer nor Article buffer later. + (if (get-buffer gnus-summary-buffer) + (bury-buffer gnus-summary-buffer)) + (if (get-buffer gnus-article-buffer) + (bury-buffer gnus-article-buffer))) + +(defun gnus-summary-post-news () + "Post an article." + (interactive) + ;; Save window configuration. + (setq gnus-winconf-post-news (current-window-configuration)) + (unwind-protect + (gnus-post-news 'post gnus-newsgroup-name) + (or (and (eq (current-buffer) (get-buffer gnus-post-news-buffer)) + (not (zerop (buffer-size)))) + ;; Restore last window configuration. + (set-window-configuration gnus-winconf-post-news))) + ;; We don't want to return to Article buffer later. + (if (get-buffer gnus-article-buffer) + (bury-buffer gnus-article-buffer))) + +(defun gnus-summary-followup (yank) + "Compose a followup to an article. +If prefix argument YANK is non-nil, original article is yanked automatically." + (interactive "P") + (gnus-summary-select-article t) + (let ((headers gnus-current-headers) + (gnus-newsgroup-name gnus-newsgroup-name)) + ;; Check Followup-To: poster. + (set-buffer gnus-article-buffer) + (if (and gnus-use-followup-to + (string-equal "poster" (gnus-fetch-field "followup-to")) + (or (not (eq gnus-use-followup-to t)) + (not (y-or-n-p + "Do you want to ignore `Followup-To: poster'? ")))) + ;; Mail to the poster. Gnus is now RFC1036 compliant. + (gnus-summary-reply yank) + ;; Save window configuration. + (setq gnus-winconf-post-news (current-window-configuration)) + (unwind-protect + (gnus-post-news 'followup headers gnus-article-buffer yank) + (or (and (eq (current-buffer) (get-buffer gnus-post-news-buffer)) + (not (zerop (buffer-size)))) + ;; Restore last window configuration. + (set-window-configuration gnus-winconf-post-news))) + ;; We don't want to return to Article buffer later. + (bury-buffer gnus-article-buffer)))) + +(defun gnus-summary-followup-with-original () + "Compose a followup to an article and include the original article." + (interactive) + (gnus-summary-followup t)) + +(defun gnus-summary-cancel-article () + "Cancel an article you posted." + (interactive) + (gnus-summary-select-article t) + (gnus-eval-in-buffer-window gnus-article-buffer + (gnus-cancel-news))) + +(defun gnus-summary-supersede-article () + "Compose an article that will supersede a previous article. +This is done simply by taking the old article and adding a Supersedes +header line with the old Message-ID." + (interactive) + (if (not + (string-equal + (downcase (mail-strip-quoted-names + (header-from gnus-current-headers))) + (downcase (mail-strip-quoted-names (gnus-inews-user-name))))) + (error "This article is not yours.")) + (gnus-summary-select-article t) + (save-excursion + (set-buffer gnus-article-buffer) + (let ((buffer-read-only nil)) + (goto-char (point-min)) + (search-forward "\n\n" nil t) + (if (not (re-search-backward "^Message-ID: " nil t)) + (error "No Message-ID in this article")))) + (if (gnus-post-news 'post gnus-newsgroup-name) + (progn + (erase-buffer) + (insert-buffer gnus-article-buffer) + (goto-char (point-min)) + (search-forward "\n\n" nil t) + (if (not (re-search-backward "^Message-ID: " nil t)) + (error "No Message-ID in this article") + (replace-match "Supersedes: ")) + (search-forward "\n\n") + (forward-line -1) + (insert mail-header-separator)))) + + +;;; Post a News using NNTP + +;;;###autoload +(fset 'sendnews 'gnus-post-news) + +;;;###autoload +(fset 'postnews 'gnus-post-news) + +(defun gnus-post-news (method &optional header article-buffer yank) + "Begin editing a new USENET news article to be posted. +Type \\[describe-mode] in the buffer to get a list of commands." + (interactive) + (if (or (not gnus-novice-user) + gnus-expert-user + (not (eq 'post + (nth 1 (assoc + (format "%s" (car gnus-current-select-method)) + gnus-valid-select-methods)))) + (y-or-n-p "Are you sure you want to post to all of USENET? ")) + (let ((sumart (if (eq method 'followup) + (save-excursion + (set-buffer gnus-summary-buffer) + (cons (current-buffer) gnus-current-article)))) + post-buf) + (if (and gnus-interactive-post + (not gnus-expert-user) + (eq method 'post) + (not header)) + (setq header + (completing-read "Newsgroup: " gnus-active-hashtb nil t))) + (setq mail-reply-buffer article-buffer) + (setq gnus-post-news-buffer + (setq post-buf + (gnus-request-post-buffer method header article-buffer))) + (if (eq method 'post) + (progn + (delete-other-windows) + (switch-to-buffer post-buf)) + (delete-other-windows) + (if (not yank) + (progn + (switch-to-buffer article-buffer) + (pop-to-buffer post-buf)) + (switch-to-buffer post-buf))) + (gnus-overload-functions) + (make-local-variable 'gnus-article-reply) + (setq gnus-article-reply sumart) + ;; Handle author copy using FCC field. + (if gnus-author-copy + (progn + (mail-position-on-field "FCC") + (insert gnus-author-copy))) + (goto-char (point-min)) + (if (and (eq method 'post) (not header)) + (end-of-line) + (search-forward (concat "\n" mail-header-separator "\n")) + (if yank + (progn + (run-hooks 'news-reply-header-hook) + (mail-yank-original nil))) + (if gnus-post-prepare-function + (funcall gnus-post-prepare-function + (if (stringp header) header gnus-newsgroup-name)))))) + (message "") + t) + +(defun gnus-inews-news () + "Send a news message." + (interactive) + (let* ((case-fold-search nil) + (server-running (gnus-server-opened gnus-select-method)) + (reply gnus-article-reply)) + (save-excursion + ;; Connect to default NNTP server if necessary. + ;; Suggested by yuki@flab.fujitsu.junet. + (gnus-start-news-server) ;Use default server. + ;; NNTP server must be opened before current buffer is modified. + (widen) + (goto-char (point-min)) + (run-hooks 'news-inews-hook) + (save-restriction + (narrow-to-region + (point-min) + (progn + (goto-char (point-min)) + (search-forward (concat "\n" mail-header-separator "\n")) + (point))) + + ;; Correct newsgroups field: change sequence of spaces to comma and + ;; eliminate spaces around commas. Eliminate imbedded line breaks. + (goto-char (point-min)) + (if (search-forward-regexp "^Newsgroups: +" nil t) + (save-restriction + (narrow-to-region + (point) + (if (re-search-forward "^[^ \t]" nil 'end) + (match-beginning 0) + (point-max))) + (goto-char (point-min)) + (replace-regexp "\n[ \t]+" " ") ;No line breaks (too confusing) + (goto-char (point-min)) + (replace-regexp "[ \t\n]*,[ \t\n]*\\|[ \t]+" ",") + )) + + ;; Mail the message too if To: or Cc: exists. + (if (or (mail-fetch-field "to" nil t) + (mail-fetch-field "cc" nil t)) + (if gnus-mail-send-method + (progn + (message "Sending via mail...") + (widen) + (funcall gnus-mail-send-method) + (message "Sending via mail... done")) + (ding) + (message "No mailer defined. To: and/or Cc: fields ignored.") + (sit-for 1)))) + + ;; Send to NNTP server. + (message "Posting to USENET...") + (if (gnus-inews-article) + (progn + (message "Posting to USENET... done") + (if (and reply + (get-buffer (car reply)) + (buffer-name (car reply))) + (progn + (save-excursion + (set-buffer gnus-summary-buffer) + (gnus-summary-mark-article-as-replied + (cdr reply)))))) + ;; We cannot signal an error. + (ding) (message "Article rejected: %s" + (gnus-status-message gnus-select-method))) + (set-buffer-modified-p nil)) + ;; If NNTP server is opened by gnus-inews-news, close it by myself. + (or server-running + (gnus-close-server gnus-current-select-method)) + (and (fboundp 'bury-buffer) (bury-buffer)) + ;; Restore last window configuration. + (and gnus-winconf-post-news + (set-window-configuration gnus-winconf-post-news)) + (setq gnus-winconf-post-news nil) + )) + +(defun gnus-cancel-news () + "Cancel an article you posted." + (interactive) + (if (yes-or-no-p "Do you really want to cancel this article? ") + (let ((from nil) + (newsgroups nil) + (message-id nil) + (distribution nil)) + (save-excursion + ;; Get header info. from original article. + (save-restriction + (gnus-article-show-all-headers) + (goto-char (point-min)) + (search-forward "\n\n" nil 'move) + (narrow-to-region (point-min) (point)) + (setq from (mail-fetch-field "from")) + (setq newsgroups (mail-fetch-field "newsgroups")) + (setq message-id (mail-fetch-field "message-id")) + (setq distribution (mail-fetch-field "distribution"))) + ;; Verify if the article is absolutely user's by comparing + ;; user id with value of its From: field. + (if (not + (string-equal + (downcase (mail-strip-quoted-names from)) + (downcase (mail-strip-quoted-names (gnus-inews-user-name))))) + (progn + (ding) (message "This article is not yours.")) + ;; Make control article. + (set-buffer (get-buffer-create " *Gnus-canceling*")) + (buffer-disable-undo (current-buffer)) + (erase-buffer) + (insert "Newsgroups: " newsgroups "\n" + "Subject: cancel " message-id "\n" + "Control: cancel " message-id "\n" + mail-header-separator "\n" + ) + ;; Send the control article to NNTP server. + (message "Canceling your article...") + (if (gnus-inews-article) + (message "Canceling your article... done") + (ding) (message "Failed to cancel your article")) + ;; Kill the article buffer. + (kill-buffer (current-buffer)) + ))) + )) + + +;;; Lowlevel inews interface + +(defun gnus-inews-article () + "Post an article in current buffer using NNTP protocol." + (let ((artbuf (current-buffer)) + (tmpbuf (get-buffer-create " *Gnus-posting*"))) + (widen) + (goto-char (point-max)) + ;; require a newline at the end for inews to append .signature to + (or (= (preceding-char) ?\n) + (insert ?\n)) + ;; Prepare article headers. All message body such as signature + ;; must be inserted before Lines: field is prepared. + (save-restriction + (goto-char (point-min)) + (narrow-to-region + (point-min) + (save-excursion + (search-forward (concat "\n" mail-header-separator "\n")) + (forward-line -1) + (point))) + (gnus-inews-insert-headers) + (widen)) + (save-excursion + (set-buffer tmpbuf) + (buffer-disable-undo (current-buffer)) + (erase-buffer) + (insert-buffer-substring artbuf) + ;; Remove the header separator. + (goto-char (point-min)) + (search-forward (concat "\n" mail-header-separator "\n")) + (replace-match "\n\n") + ;; This hook may insert a signature. + (run-hooks 'gnus-prepare-article-hook) + ;; Run final inews hooks. This hook may do FCC. + ;; The article must be saved before being posted because + ;; `gnus-request-post' modifies the buffer. + (run-hooks 'gnus-inews-article-hook) + ;; Post an article to NNTP server. + ;; Return NIL if post failed. + (prog1 + (gnus-request-post gnus-current-select-method) + (kill-buffer (current-buffer))) + ))) + +(defun gnus-inews-insert-headers () + "Prepare article headers. +Fields already prepared in the buffer are not modified. +Fields in `gnus-required-headers' will be generated." + (save-excursion + (let ((date (gnus-inews-date)) + (message-id (gnus-inews-message-id)) + (organization (gnus-inews-organization))) + (goto-char (point-min)) + (and (memq 'Path gnus-required-headers) + (or (mail-fetch-field "path") + (gnus-insert-end "Path: " (gnus-inews-path) "\n"))) + (and (memq 'From gnus-required-headers) + (or (mail-fetch-field "from") + (gnus-insert-end "From: " (gnus-inews-user-name) "\n"))) + ;; If there is no subject, make Subject: field. + (and (memq 'Subject gnus-required-headers) + (or (mail-fetch-field "subject") + (gnus-insert-end "Subject: \n"))) + ;; If there is no newsgroups, make Newsgroups: field. + (and (memq 'Newsgroups gnus-required-headers) + (or (mail-fetch-field "newsgroups") + (gnus-insert-end "Newsgroups: \n"))) + (and message-id + (memq 'Message-ID gnus-required-headers) + (progn + (if (mail-fetch-field "message-id") + (progn + (goto-char (point-min)) + (re-search-forward "^Message-ID" nil t) + (delete-region (progn (beginning-of-line) (point)) + (progn (forward-line 1) (point))))) + (gnus-insert-end "Message-ID: " message-id "\n"))) + (and date + (memq 'Date gnus-required-headers) + (or (mail-fetch-field "date") + (gnus-insert-end "Date: " date "\n"))) + ;; Optional fields in RFC977 and RFC1036 + (and organization + (memq 'Organization gnus-required-headers) + (or (mail-fetch-field "organization") + (let ((begin (point-max)) + (fill-column 79) + (fill-prefix "\t")) + (gnus-insert-end "Organization: " organization "\n") + (fill-region-as-paragraph begin (point-max))))) + (and (memq 'Distribution gnus-required-headers) + (or (mail-fetch-field "distribution") + (gnus-insert-end "Distribution: \n"))) + (and (memq 'Lines gnus-required-headers) + (or (mail-fetch-field "lines") + (gnus-insert-end "Lines: " (gnus-inews-lines) "\n"))) + (and (memq 'X-Newsreader gnus-required-headers) + (or (mail-fetch-field "x-newsreader") + (gnus-insert-end "X-Newsreader: " gnus-version "\n"))) + ))) + + +(defun gnus-insert-end (&rest args) + (save-excursion + (goto-char (point-max)) + (apply 'insert args))) + +(defun gnus-inews-insert-signature () + "Insert signature file in current article buffer. +If there is a file named .signature-DISTRIBUTION. Set the variable to +nil to prevent appending the signature file automatically. +Signature file is specified by the variable gnus-signature-file." + (save-excursion + (save-restriction + (let ((signature + (if gnus-signature-file + (expand-file-name gnus-signature-file nil))) + distribution) + (goto-char (point-min)) + (search-forward "\n\n") + (narrow-to-region (point-min) (point)) + (setq distribution (mail-fetch-field "distribution")) + (widen) + (if signature + (progn + ;; Insert signature. + (if (file-exists-p signature) + (progn + (goto-char (point-max)) + (insert "--\n") + (insert-file-contents signature))) + )))))) + +(defun gnus-inews-do-fcc () + "Process FCC: fields in current article buffer. +Unless the first character of the field is `|', the article is saved +to the specified file using the function specified by the variable +gnus-author-copy-saver. The default function rmail-output saves in +Unix mailbox format. +If the first character is `|', the contents of the article is send to +a program specified by the rest of the value." + (let ((fcc-list nil) + (fcc-file nil) + (case-fold-search t)) ;Should ignore case. + (save-excursion + (save-restriction + (goto-char (point-min)) + (search-forward "\n\n") + (narrow-to-region (point-min) (point)) + (goto-char (point-min)) + (while (re-search-forward "^FCC:[ \t]*" nil t) + (setq fcc-list + (cons (buffer-substring + (point) + (progn + (end-of-line) + (skip-chars-backward " \t") + (point))) + fcc-list)) + (delete-region (match-beginning 0) + (progn (forward-line 1) (point)))) + ;; Process FCC operations. + (widen) + (while fcc-list + (setq fcc-file (car fcc-list)) + (setq fcc-list (cdr fcc-list)) + (cond ((string-match "^[ \t]*|[ \t]*\\(.*\\)[ \t]*$" fcc-file) + (let ((program (substring fcc-file + (match-beginning 1) (match-end 1)))) + ;; Suggested by yuki@flab.fujitsu.junet. + ;; Send article to named program. + (call-process-region (point-min) (point-max) shell-file-name + nil nil nil "-c" program) + )) + (t + ;; Suggested by hyoko@flab.fujitsu.junet. + ;; Save article in Unix mail format by default. + (if (and gnus-author-copy-saver + (not (eq gnus-author-copy-saver 'rmail-output))) + (funcall gnus-author-copy-saver fcc-file) + (if (and (file-readable-p fcc-file) (rmail-file-p fcc-file)) + (gnus-output-to-rmail fcc-file) + (rmail-output fcc-file 1 t t))) + )) + ) + )) + )) + +(defun gnus-inews-path () + "Return uucp path." + (let ((login-name (gnus-inews-login-name))) + (cond ((null gnus-use-generic-path) + (concat (nth 1 gnus-select-method) "!" login-name)) + ((stringp gnus-use-generic-path) + ;; Support GENERICPATH. Suggested by vixie@decwrl.dec.com. + (concat gnus-use-generic-path "!" login-name)) + (t login-name)) + )) + +(defun gnus-inews-user-name () + "Return user's network address as `NAME@DOMAIN (FULLNAME)'." + (let ((full-name (gnus-inews-full-name))) + (concat (or user-mail-address + (if (or gnus-user-login-name gnus-use-generic-from + gnus-local-domain (getenv "DOMAINNAME")) + (concat (gnus-inews-login-name) "@" + (gnus-inews-domain-name gnus-use-generic-from)) + user-mail-address)) + ;; User's full name. + (cond ((string-equal full-name "") "") + ((string-equal full-name "&") ;Unix hack. + (concat " (" (user-login-name) ")")) + (t + (concat " (" full-name ")"))) + ))) + +(defun gnus-inews-login-name () + "Return user login name. +Got from the variable `gnus-user-login-name' and the function +`user-login-name'." + (or gnus-user-login-name (user-login-name))) + +(defun gnus-inews-full-name () + "Return user full name. +Got from the variable `gnus-user-full-name', the environment variable +NAME, and the function `user-full-name'." + (or gnus-user-full-name + (getenv "NAME") (user-full-name))) + +(defun gnus-inews-domain-name (&optional genericfrom) + "Return user's domain name. +If optional argument GENERICFROM is a string, use it as the domain +name; if it is non-nil, strip of local host name from the domain name. +If the function `system-name' returns full internet name and the +domain is undefined, the domain name is got from it." + (if (or genericfrom gnus-local-domain (getenv "DOMAINNAME")) + (let ((domain (or (if (stringp genericfrom) genericfrom) + (getenv "DOMAINNAME") + gnus-local-domain + ;; Function `system-name' may return full internet name. + ;; Suggested by Mike DeCorte . + (if (string-match "\\." (system-name)) + (substring (system-name) (match-end 0))) + (read-string "Domain name (no host): "))) + (host (or (if (string-match "\\." (system-name)) + (substring (system-name) 0 (match-beginning 0))) + (system-name)))) + (if (string-equal "." (substring domain 0 1)) + (setq domain (substring domain 1))) + ;; Support GENERICFROM as same as standard Bnews system. + ;; Suggested by ohm@kaba.junet and vixie@decwrl.dec.com. + (cond ((null genericfrom) + (concat host "." domain)) + ;;((stringp genericfrom) genericfrom) + (t domain))) + (substring user-mail-address (1+ (string-match "@" user-mail-address))))) + +(defun gnus-inews-message-id () + "Generate unique Message-ID for user." + ;; Message-ID should not contain a slash and should be terminated by + ;; a number. I don't know the reason why it is so. + (concat "<" (gnus-inews-unique-id) "@" (gnus-inews-domain-name) ">")) + +(defun gnus-inews-unique-id () + "Generate unique ID from user name and current time." + (let ((date (current-time-string)) + (name (gnus-inews-login-name))) + (if (string-match "^[^ ]+ \\([^ ]+\\)[ ]+\\([0-9]+\\) \\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\) [0-9][0-9]\\([0-9][0-9]\\)" + date) + (concat (upcase name) "." + (substring date (match-beginning 6) (match-end 6)) ;Year + (substring date (match-beginning 1) (match-end 1)) ;Month + (substring date (match-beginning 2) (match-end 2)) ;Day + (substring date (match-beginning 3) (match-end 3)) ;Hour + (substring date (match-beginning 4) (match-end 4)) ;Minute + (substring date (match-beginning 5) (match-end 5)) ;Second + ) + (error "Cannot understand current-time-string: %s." date)) + )) + +(defun gnus-current-time-zone (time) + "The local time zone in effect at TIME, or nil if not known." + (let ((z (and (fboundp 'current-time-zone) (current-time-zone time)))) + (if (and z (car z)) z gnus-local-timezone))) + +(defun gnus-inews-date () + "Date string of today. +If `current-time-zone' works, or if `gnus-local-timezone' is set correctly, +this yields a date that conforms to RFC 822. Otherwise a buggy date will +be generated; this might work with some older news servers." + (let* ((now (and (fboundp 'current-time) (current-time))) + (zone (gnus-current-time-zone now))) + (if zone + (gnus-inews-valid-date now zone) + ;; No timezone info. + (gnus-inews-buggy-date now)))) + +(defun gnus-inews-valid-date (&optional time zone) + "A date string that represents TIME and conforms to the Usenet standard. +TIME is optional and defaults to the current time. +Some older versions of Emacs always act as if TIME is nil. +The optional argument ZONE specifies the local time zone (default GMT)." + (timezone-make-date-arpa-standard + (if (fboundp 'current-time) + (current-time-string time) + (current-time-string)) + zone "GMT")) + +(defun gnus-inews-buggy-date (&optional time) + "A buggy date string that represents TIME. +TIME is optional and defaults to the current time. +Some older versions of Emacs always act as if TIME is nil." + (let ((date (if (fboundp 'current-time) + (current-time-string time) + (current-time-string)))) + (if (string-match "^[^ ]+ \\([^ ]+\\)[ ]+\\([0-9]+\\) \\([0-9:]+\\) [0-9][0-9]\\([0-9][0-9]\\)" + date) + (concat (substring date (match-beginning 2) (match-end 2)) ;Day + " " + (substring date (match-beginning 1) (match-end 1)) ;Month + " " + (substring date (match-beginning 4) (match-end 4)) ;Year + " " + (substring date (match-beginning 3) (match-end 3))) ;Time + (error "Cannot understand current-time-string: %s." date)) + )) + +(defun gnus-inews-organization () + "Return user's organization. +The ORGANIZATION environment variable is used if defined. +If not, the variable gnus-local-organization is used instead. +If the value begins with a slash, it is taken as the name of a file +containing the organization." + ;; The organization must be got in this order since the ORGANIZATION + ;; environment variable is intended for user specific while + ;; gnus-local-organization is for machine or organization specific. + + (let* ((private-file (expand-file-name "~/.organization" nil)) + (organization (or (getenv "ORGANIZATION") + gnus-local-organization + private-file))) + (and (stringp organization) + (> (length organization) 0) + (string-equal (substring organization 0 1) "/") + ;; Get it from the user and system file. + ;; Suggested by roland@wheaties.ai.mit.edu (Roland McGrath). + (let ((dist (mail-fetch-field "distribution"))) + (setq organization + (cond ((file-exists-p (concat organization "-" dist)) + (concat organization "-" dist)) + ((file-exists-p organization) organization) + ((file-exists-p gnus-organization-file) + gnus-organization-file) + (t organization))) + )) + (cond ((not (stringp organization)) nil) + ((and (string-equal (substring organization 0 1) "/") + (file-exists-p organization)) + ;; If the first character is `/', assume it is the name of + ;; a file containing the organization. + (save-excursion + (let ((tmpbuf (get-buffer-create " *Gnus organization*"))) + (set-buffer tmpbuf) + (erase-buffer) + (insert-file-contents organization) + (prog1 (buffer-string) + (kill-buffer tmpbuf)) + ))) + ((string-equal organization private-file) nil) ;No such file + (t organization)) + )) + +(defun gnus-inews-lines () + "Count the number of lines and return numeric string." + (save-excursion + (save-restriction + (widen) + (goto-char (point-min)) + (search-forward "\n\n" nil 'move) + (int-to-string (count-lines (point) (point-max)))))) + + +;;; +;;; Gnus Mail Functions +;;; + +(autoload 'news-mail-reply "rnewspost") +(autoload 'news-mail-other-window "rnewspost") + +;;; Mail reply commands of Gnus Summary Mode + +(defun gnus-summary-reply (yank) + "Reply mail to news author. +If prefix argument YANK is non-nil, original article is yanked automatically. +Customize the variable gnus-mail-reply-method to use another mailer." + (interactive "P") + ;; Bug fix by jbw@bigbird.bu.edu (Joe Wells) + ;; Stripping headers should be specified with mail-yank-ignored-headers. + (gnus-summary-select-article t) + (setq gnus-winconf-post-news (current-window-configuration)) + (let ((gnus-newsgroup-name gnus-newsgroup-name)) + (bury-buffer gnus-article-buffer) + (funcall gnus-mail-reply-method yank))) + +(defun gnus-summary-reply-with-original () + "Reply mail to news author with original article. +Customize the variable gnus-mail-reply-method to use another mailer." + (interactive) + (gnus-summary-reply t)) + +(defun gnus-summary-mail-forward () + "Forward the current message to another user. +Customize the variable gnus-mail-forward-method to use another mailer." + (interactive) + (gnus-summary-select-article) + (switch-to-buffer gnus-article-buffer) + (widen) + (delete-other-windows) + (bury-buffer gnus-article-buffer) + (funcall gnus-mail-forward-method)) + +(defun gnus-summary-mail-other-window () + "Compose mail in other window. +Customize the variable gnus-mail-other-window-method to use another mailer." + (interactive) + (gnus-summary-select-article) + (switch-to-buffer gnus-article-buffer) + (widen) + (delete-other-windows) + (bury-buffer gnus-article-buffer) + (funcall gnus-mail-other-window-method)) + +(defun gnus-mail-reply-using-mail (&optional yank to-address) + (save-excursion + (set-buffer gnus-summary-buffer) + (let ((info (nth 2 (gnus-gethash gnus-newsgroup-name gnus-newsrc-hashtb))) + (group (gnus-group-real-name gnus-newsgroup-name)) + (cur (cons (current-buffer) gnus-current-article)) + from subject date to reply-to message-of + references message-id sender follow-to) + (set-buffer (get-buffer-create "*mail*")) + (mail-mode) + (make-local-variable 'gnus-article-reply) + (setq gnus-article-reply cur) + (local-set-key "\C-c\C-c" 'gnus-mail-send-and-exit) + (local-set-key "\C-c\C-y" 'gnus-mail-yank-original) + (if (and (buffer-modified-p) + (> (buffer-size) 0) + (not (y-or-n-p "Unsent article being composed; erase it? "))) + () + (erase-buffer) + (save-excursion + (set-buffer gnus-article-buffer) + (goto-char (point-min)) + (narrow-to-region (point-min) + (progn (search-forward "\n\n") (point))) + (set-text-properties (point-min) (point-max) nil) + (if (and (boundp 'gnus-reply-to-function) + gnus-reply-to-function) + (save-excursion + (save-restriction + (gnus-narrow-to-headers) + (setq follow-to (funcall gnus-reply-to-function group))))) + (setq from (mail-fetch-field "from")) + (setq date (mail-fetch-field "date")) + (and from + (let ((stop-pos + (string-match " *at \\| *@ \\| *(\\| *<" from))) + (setq message-of + (concat (if stop-pos (substring from 0 stop-pos) from) + "'s message of " date)))) + (setq sender (mail-fetch-field "sender")) + (setq subject (or (mail-fetch-field "subject") + "Re: none")) + (or (string-match "^[Rr][Ee]:" subject) + (setq subject (concat "Re: " subject))) + (setq reply-to (mail-fetch-field "reply-to")) + (setq references (mail-fetch-field "references")) + (setq message-id (mail-fetch-field "message-id")) + (widen)) + (setq news-reply-yank-from from) + (setq news-reply-yank-message-id message-id) + (mail-setup (or to-address follow-to reply-to from sender) + subject message-of nil gnus-article-buffer nil) + ;; Fold long references line to follow RFC1036. + (mail-position-on-field "References") + (let ((begin (- (point) (length "References: "))) + (fill-column 78) + (fill-prefix "\t")) + (if references (insert references)) + (if (and references message-id) (insert " ")) + (if message-id (insert message-id)) + ;; The region must end with a newline to fill the region + ;; without inserting extra newline. + (fill-region-as-paragraph begin (1+ (point)))) + (goto-char (point-min)) + (search-forward (concat "\n" mail-header-separator "\n")) + (if yank + (let ((last (point))) + (run-hooks 'news-reply-header-hook) + (mail-yank-original nil) + (goto-char last)))) + (if (not yank) + (let ((mail (current-buffer))) + (switch-to-buffer gnus-article-buffer) + (delete-other-windows) + (switch-to-buffer-other-window mail)) + (delete-other-windows) + (switch-to-buffer (current-buffer)))))) + +(defun gnus-mail-yank-original () + (interactive) + (run-hooks 'news-reply-header-hook) + (mail-yank-original nil)) + +(defun gnus-mail-send-and-exit () + (interactive) + (let ((reply gnus-article-reply)) + (mail-send-and-exit nil) + (if (and reply + (get-buffer (car reply)) + (buffer-name (car reply))) + (progn + (set-buffer (car reply)) + (gnus-summary-mark-article-as-replied + (cdr reply))))) + (if gnus-winconf-post-news + (set-window-configuration gnus-winconf-post-news))) + +(defun gnus-mail-forward-using-mail () + "Forward the current message to another user using mail." + ;; This is almost a carbon copy of rmail-forward in rmail.el. + (let ((forward-buffer (current-buffer)) + (subject + (concat "[" gnus-newsgroup-name "] " + ;;(mail-strip-quoted-names (gnus-fetch-field "From")) ": " + (or (gnus-fetch-field "Subject") "")))) + ;; If only one window, use it for the mail buffer. + ;; Otherwise, use another window for the mail buffer + ;; so that the Rmail buffer remains visible + ;; and sending the mail will get back to it. + (if (if (one-window-p t) + (mail nil nil subject) + (mail-other-window nil nil subject)) + (save-excursion + (goto-char (point-max)) + (insert "------- Start of forwarded message -------\n") + (insert-buffer forward-buffer) + (goto-char (point-max)) + (insert "------- End of forwarded message -------\n") + ;; You have a chance to arrange the message. + (run-hooks 'gnus-mail-forward-hook) + )))) + +(defun gnus-mail-other-window-using-mail () + "Compose mail other window using mail." + (news-mail-other-window) + (gnus-overload-functions)) + + +;;; +;;; Dribble file +;;; + +(defvar gnus-dribble-ignore nil) + +(defun gnus-dribble-file-name () + (concat gnus-startup-file "-dribble")) + +(defun gnus-dribble-open () + (save-excursion + (set-buffer + (setq gnus-dribble-buffer (find-file-noselect (gnus-dribble-file-name)))) + (buffer-disable-undo (current-buffer)) + (bury-buffer gnus-dribble-buffer) + (auto-save-mode t) + (goto-char (point-max)))) + +(defun gnus-dribble-enter (string) + (if (not gnus-dribble-ignore) + (let ((obuf (current-buffer))) + (set-buffer gnus-dribble-buffer) + (insert string "\n") + (set-window-point (get-buffer-window (current-buffer)) (point-max)) + (set-buffer obuf)))) + +(defun gnus-dribble-read-file () + (let ((dribble-file (gnus-dribble-file-name))) + (save-excursion + (set-buffer (setq gnus-dribble-buffer + (get-buffer-create + (file-name-nondirectory dribble-file)))) + (gnus-add-current-to-buffer-list) + (erase-buffer) + (set-visited-file-name dribble-file) + (buffer-disable-undo (current-buffer)) + (bury-buffer (current-buffer)) + (set-buffer-modified-p nil) + (let ((auto (make-auto-save-file-name)) + (gnus-dribble-ignore t)) + (if (or (file-exists-p auto) (file-exists-p dribble-file)) + (progn + (if (file-newer-than-file-p auto dribble-file) + (setq dribble-file auto)) + (insert-file-contents dribble-file) + (if (not (zerop (buffer-size))) + (set-buffer-modified-p t)) + (if (y-or-n-p "Auto-save file exists. Do you want to read it? ") + (progn + (message "Reading %s..." dribble-file) + (eval-current-buffer) + (message "Reading %s...done" dribble-file))))))))) + +(defun gnus-dribble-delete-file () + (save-excursion + (set-buffer gnus-dribble-buffer) + (let ((auto (make-auto-save-file-name))) + (if (file-exists-p auto) + (delete-file auto)) + (if (file-exists-p (gnus-dribble-file-name)) + (delete-file (gnus-dribble-file-name))) + (erase-buffer) + (set-buffer-modified-p nil)))) + +(defun gnus-dribble-save () + ;; Bug by Evan Welsh . + (if (and gnus-dribble-buffer + (buffer-name gnus-dribble-buffer)) + (save-excursion + (set-buffer gnus-dribble-buffer) + (save-buffer)))) + +(defun gnus-dribble-clear () + (save-excursion + (if (and gnus-dribble-buffer + (get-buffer gnus-dribble-buffer) + (buffer-name (get-buffer gnus-dribble-buffer))) + (progn + (set-buffer gnus-dribble-buffer) + (erase-buffer) + (set-buffer-modified-p nil) + (setq buffer-saved-size (buffer-size)))))) + +;;; +;;; Server Communication +;;; + +(defun gnus-start-news-server (&optional confirm) + "Open a method for getting news. +If CONFIRM is non-nil, the user will be asked for an NNTP server." + (let (how where) + (if gnus-current-select-method + ;; 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: " + (cons (list gnus-nntp-server) + gnus-secondary-servers) + nil nil gnus-nntp-server)) + (setq gnus-select-method + (list 'nntp gnus-nntp-server))) + +; (debug) + (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 'mhspool gnus-nntp-server)) + (t + (list 'nntp gnus-nntp-server)))))) + + (setq how (car gnus-select-method)) + (setq where (car (cdr gnus-select-method))) + (cond ((eq how 'nnspool) + (require 'nnspool) + (message "Looking up local news spool...")) + ((eq how 'mhspool) + (require 'mhspool) + (message "Looking up private directory...")) + (t + (require 'nntp))) + (setq gnus-current-select-method gnus-select-method) + (run-hooks 'gnus-open-server-hook) + (or + ;; gnus-open-server-hook might have opened it + (gnus-server-opened gnus-select-method) + (gnus-open-server gnus-select-method) + (error "%s" (gnus-nntp-message + (format "Cannot open NNTP server on %s" + where)))) + gnus-select-method))) + +(defun gnus-check-news-server (method) + "If the news server is down, start it up again." + (let ((method (if method method gnus-select-method))) + (if (gnus-server-opened method) + ;; Stream is already opened. + t + ;; Open NNTP server. + (message "Opening server %s on %s..." (car method) (nth 1 method)) + (run-hooks 'gnus-open-server-hook) + (message "") + (or (gnus-server-opened method) + (gnus-open-server method))))) + +(defun gnus-nntp-message (&optional message) + "Check the status of the NNTP server. +If the status of the server is clear and MESSAGE is non-nil, MESSAGE +is returned insted of the status string." + (let ((status (gnus-status-message gnus-current-select-method)) + (message (or message ""))) + (if (and (stringp status) (> (length status) 0)) + status message))) + +(defun gnus-get-function (method function) + (let ((func (intern (format "%s-%s" (car method) function)))) + (if (not (fboundp func)) + (progn + (require (car method)) + (if (not (fboundp func)) + (error "No such function: %s" func)))) + func)) + +;; Specifying port number suggested by Stephane Laveau . +(defun gnus-open-server (method) + (apply (gnus-get-function method 'open-server) (cdr method))) + +(defun gnus-close-server (method) + (funcall (gnus-get-function method 'close-server) (nth 1 method))) + +(defun gnus-request-list (method) + (funcall (gnus-get-function method 'request-list) (nth 1 method))) + +(defun gnus-request-list-newsgroups (method) + (funcall (gnus-get-function method 'request-list-newsgroups) (nth 1 method))) + +(defun gnus-server-opened (method) + (funcall (gnus-get-function method 'server-opened) (nth 1 method))) + +(defun gnus-status-message (method) + (funcall (gnus-get-function method 'status-message) (nth 1 method))) + +(defun gnus-request-group (group &optional dont-check) + (let ((method (gnus-find-method-for-group group))) + (funcall (gnus-get-function method 'request-group) + (gnus-group-real-name group) (nth 1 method) dont-check))) + +(defun gnus-retrieve-headers (articles group) + (let ((method (gnus-find-method-for-group group))) + (funcall (gnus-get-function method 'retrieve-headers) + articles (gnus-group-real-name group) (nth 1 method)))) + +(defun gnus-request-article (article group buffer) + (let ((method (gnus-find-method-for-group group))) + (funcall (gnus-get-function method 'request-article) + article (gnus-group-real-name group) (nth 1 method) buffer))) + +(defun gnus-request-head (article group) + (let ((method (gnus-find-method-for-group group))) + (funcall (gnus-get-function method 'request-head) + article (gnus-group-real-name group) (nth 1 method)))) + +;; Fix by Sudish Joseph . +(defun gnus-request-post-buffer (post header artbuf) + (let* ((group gnus-newsgroup-name) + (info (nth 2 (gnus-gethash group gnus-newsrc-hashtb))) + (method + (if (and gnus-post-method + (memq 'post (member (car gnus-current-select-method) + gnus-valid-select-methods))) + gnus-post-method + gnus-current-select-method))) + (funcall (gnus-get-function method 'request-post-buffer) + post header artbuf (gnus-group-real-name group) info))) + +(defun gnus-request-post (method) + (and gnus-post-method + (memq 'post (member (car method) gnus-valid-select-methods)) + (setq method gnus-post-method)) + (funcall (gnus-get-function method 'request-post) + (nth 1 method))) + +(defun gnus-request-expire-articles (articles group) + (let ((method (gnus-find-method-for-group group))) + (funcall (gnus-get-function method 'request-expire-articles) + articles (gnus-group-real-name group) (nth 1 method)))) + +(defun gnus-request-move-article (article group server accept-function) + (let ((method (gnus-find-method-for-group group))) + (funcall (gnus-get-function method 'request-move-article) + article (gnus-group-real-name group) + (nth 1 method) accept-function))) + +(defun gnus-request-accept-article (group) + (let ((func (if (symbolp group) group + (car (gnus-find-method-for-group group))))) + (funcall (intern (format "%s-request-accept-article" func)) + (gnus-group-real-name group)))) + +(defun gnus-find-method-for-group (group) + (let ((info (nth 2 (gnus-gethash group gnus-newsrc-hashtb)))) + (if (or (not info) + (not (nth 4 info))) + gnus-select-method + (nth 4 info)))) + +(defun gnus-check-backend-function (func group) + (let ((method (if (stringp group) (car (gnus-find-method-for-group group)) + group))) + (fboundp (intern (format "%s-%s" method func))))) + +(defun gnus-methods-using (method) + (let ((valids gnus-valid-select-methods) + outs) + (while valids + (if (memq method (car valids)) + (setq outs (cons (car valids) outs))) + (setq valids (cdr valids))) + outs)) + +;;; +;;; Active & Newsrc File Handling +;;; + +;; Newsrc related functions. +;; Gnus internal format of gnus-newsrc-assoc: +;; (("alt.general" 3 (1 . 1)) +;; ("alt.misc" 3 ((1 . 10) (12 . 15))) +;; ("alt.test" 7 (1 . 99) (45 57 93)) ...) +;; The first item is the group name; the second is the subscription +;; level; the third is either a range of a list of ranges of read +;; articles, the optional fourth element is a list of marked articles, +;; the optional fifth element is the select method. +;; +;; Gnus internal format of gnus-newsrc-hashtb: +;; (95 ("alt.general" 3 (1 . 1)) ("alt.misc" 3 ((1 . 10) (12 . 15))) ...) +;; This is the entry for "alt.misc". The first element is the number +;; of unread articles in "alt.misc". The cdr of this entry is the +;; element *before* "alt.misc" in gnus-newsrc-assoc, which makes is +;; trivial to remove or add new elements into gnus-newsrc-assoc +;; without scanning the entire list. So, to get the actual information +;; of "alt.misc", you'd say something like +;; (nth 2 (gnus-gethash "alt.misc" gnus-newsrc-hashtb)) +;; +;; Gnus internal format of gnus-active-hashtb: +;; ((1 . 1)) +;; (5 . 10)) +;; (67 . 99)) ...) +;; The only element in each entry in this hash table is a range of +;; (possibly) available articles. (Articles in this range may have +;; been expired or cancelled.) +;; +;; Gnus internal format of gnus-killed-list and gnus-zombie-list: +;; ("alt.misc" "alt.test" "alt.general" ...) + +(defun gnus-setup-news (&optional rawfile level) + "Setup news information. +If RAWFILE is non-nil, the .newsrc file will also be read. +If LEVEL is non-nil, the news will be set up at level LEVEL." + (let ((init (not (and gnus-newsrc-assoc + gnus-active-hashtb + (not rawfile))))) + ;; Clear some variables to re-initialize news information. + (if init + (setq gnus-newsrc-assoc nil + gnus-active-hashtb nil)) + ;; Read the acitve file and create `gnus-active-hashtb'. + ;; If `gnus-read-active-file' is nil, then we just create an empty + ;; hash table. The partial filling out of the hash table will be + ;; done in `gnus-get-unread-articles'. + (if gnus-read-active-file + (gnus-read-active-file) + (setq gnus-active-hashtb (make-vector 4095 0))) + + ;; Read the newsrc file and create `gnus-newsrc-hashtb'. + (if init (gnus-read-newsrc-file rawfile)) + ;; Find the number of unread articles in each non-dead group. + (gnus-get-unread-articles level) + ;; Find new newsgroups and treat them. + (if (and init gnus-check-new-newsgroups gnus-read-active-file) + (gnus-find-new-newsgroups)) + (if (and init gnus-check-bogus-newsgroups gnus-read-active-file) + (gnus-check-bogus-newsgroups)))) + +(defun gnus-find-new-newsgroups () + "Search for new newsgroups and add them. +Each new newsgroup will be treated with `gnus-subscribe-newsgroup-method.' +The `-n' option line from .newsrc is respected." + (interactive) + (if (not gnus-have-read-active-file) (gnus-read-active-file)) + (if (not (gnus-check-first-time-used)) + (let ((groups 0) + group new-newsgroups) + (if (not gnus-killed-hashtb) (gnus-make-hashtable-from-killed)) + ;; Go though every newsgroup in `gnus-active-hashtb' and compare + ;; with `gnus-newsrc-hashtb' and `gnus-killed-hashtb'. + (mapatoms + (lambda (sym) + (setq group (symbol-name sym)) + (if (or (gnus-gethash group gnus-killed-hashtb) + (gnus-gethash group gnus-newsrc-hashtb)) + () + (if (and gnus-newsrc-options-n-yes + (string-match gnus-newsrc-options-n-yes group)) + (progn + (setq groups (1+ groups)) + (gnus-sethash group group gnus-killed-hashtb) + (funcall gnus-subscribe-options-newsgroup-method group)) + (if (or (null gnus-newsrc-options-n-no) + (not (string-match gnus-newsrc-options-n-no group))) + ;; Add this group. + (progn + (setq groups (1+ groups)) + (gnus-sethash group group gnus-killed-hashtb) + (if gnus-subscribe-hierarchical-interactive + (setq new-newsgroups (cons group new-newsgroups)) + (funcall gnus-subscribe-newsgroup-method group))))))) + gnus-active-hashtb) + (if new-newsgroups + (gnus-subscribe-hierarchical-interactive new-newsgroups)) + ;; Suggested by Per Abrahamsen . + (if (> groups 0) + (message "%d new newsgroup%s arrived." + groups (if (> groups 1) "s have" " has")))))) + +(defun gnus-check-first-time-used () + (if (or (file-exists-p gnus-startup-file) + (file-exists-p (concat gnus-startup-file ".el")) + (file-exists-p (concat gnus-startup-file ".eld"))) + nil + (message "First time user; subscribing you to default groups") + (let ((groups gnus-default-subscribed-newsgroups) + group) + (if (eq groups t) + nil + (setq groups (or groups gnus-backup-default-subscribed-newsgroups)) + (mapatoms + (lambda (sym) + (setq group (symbol-name sym)) + (if (and gnus-newsrc-options-n-yes + (string-match gnus-newsrc-options-n-yes group)) + (funcall gnus-subscribe-options-newsgroup-method group) + (and (or (null gnus-newsrc-options-n-no) + (not (string-match gnus-newsrc-options-n-no group))) + (setq gnus-killed-list (cons group gnus-killed-list))))) + gnus-active-hashtb) + (while groups + (if (gnus-gethash (car groups) gnus-active-hashtb) + (gnus-group-change-level (car groups) 3 9)) + (setq groups (cdr groups))))))) + +;; `gnus-group-change-level' is the fundamental function for changing +;; subscription levels of newsgroups. This might mean just changing +;; from level 1 to 2, which is pretty trivial, from 2 to 6 or back +;; again, which subscribes/unsubscribes a group, which is equally +;; trivial. Changing from 1-7 to 8-9 means that you kill a group, and +;; from 8-9 to 1-7 means that you remove the group from the list of +;; killed (or zombie) groups and add them to the (kinda) subscribed +;; groups. And last but not least, moving from 8 to 9 and 9 to 8, +;; which is trivial. +;; ENTRY can either be a string (newsgroup name) or a list (if +;; FROMKILLED is t, it's a list on the format (NUM INFO-LIST), +;; otherwise it's a list in the format of the `gnus-newsrc-hashtb' +;; entries. +;; LEVEL is the new level of the group, OLDLEVEL is the old level and +;; PREVIOUS is the group (in hashtb entry format) to insert this group +;; after. +(defun gnus-group-change-level (entry level &optional oldlevel + previous fromkilled) + (let (group info active num) + ;; Glean what info we can from the arguments + (if (consp entry) + (if fromkilled (setq group (nth 1 entry)) + (setq group (car (nth 2 entry)))) + (setq group entry)) + (if (and (stringp entry) + oldlevel + (< oldlevel 8)) + (setq entry (gnus-gethash entry gnus-newsrc-hashtb))) + (if (and (not oldlevel) + (listp entry)) + (setq oldlevel (car (cdr (nth 2 entry))))) + (if (stringp previous) + (setq previous (gnus-gethash previous gnus-newsrc-hashtb))) + + (gnus-dribble-enter + (format "(gnus-group-change-level %S %S %S %S %S)" + group level oldlevel (car (nth 2 previous)) fromkilled)) + + ;; Then we remove the newgroup from any old structures, if needed. + ;; If the group was killed, we remove it from the killed or zombie + ;; list. If not, and it is in fact going to be killed, we remove + ;; it from the newsrc hash table and assoc. + (cond ((>= oldlevel 8) + (if (= oldlevel 8) + (setq gnus-zombie-list (delete group gnus-zombie-list)) + (setq gnus-killed-list (delete group gnus-killed-list)))) + (t + (if (>= level 8) + (progn + (gnus-sethash (car (nth 2 entry)) + nil gnus-newsrc-hashtb) + (if (nth 3 entry) + (setcdr (gnus-gethash (car (nth 3 entry)) + gnus-newsrc-hashtb) + (cdr entry))) + (setcdr (cdr entry) (cdr (cdr (cdr entry)))))))) + + ;; Finally we enter (if needed) the list where it is supposed to + ;; go, and change the subscription level. If it is to be killed, + ;; we enter it into the killed or zombie list. + (cond ((>= level 8) + (if (= level 8) + (setq gnus-zombie-list (cons group gnus-zombie-list)) + (setq gnus-killed-list (cons group gnus-killed-list)))) + (t + ;; If the list is to be entered into the newsrc assoc, and + ;; it was killed, we have to create an entry in the newsrc + ;; hashtb format and fix the pointers in the newsrc assoc. + (if (>= oldlevel 8) + (progn + (if (listp entry) + (progn + (setq info (cdr entry)) + (setq num (car entry))) + (setq active (gnus-gethash group gnus-active-hashtb)) + (setq num (- (1+ (cdr active)) (car active))) + (setq info (list group level (cons 1 (1- (car active)))))) + (setq entry (cons info (if previous (cdr (cdr previous)) + (cdr gnus-newsrc-assoc)))) + (setcdr (if previous (cdr previous) gnus-newsrc-assoc) + entry) + (gnus-sethash group (cons num (if previous (cdr previous) + gnus-newsrc-assoc)) + gnus-newsrc-hashtb) + (if (cdr entry) + (setcdr (gnus-gethash (car (car (cdr entry))) + gnus-newsrc-hashtb) + entry))) + ;; It was alive, and it is going to stay alive, so we + ;; just change the level and don't change any pointers or + ;; hash table entries. + (setcar (cdr (car (cdr (cdr entry)))) level)))))) + +(defun gnus-kill-newsgroup (newsgroup) + "Obsolete function. Kills a newsgroup." + (gnus-group-change-level (gnus-gethash newsgroup gnus-newsrc-hashtb) 9)) + +(defun gnus-check-bogus-newsgroups (&optional confirm) + "Delete bogus newsgroups. +If CONFIRM is non-nil, the user has to confirm the deletion of every +newsgroup." + (let ((newsrc (cdr gnus-newsrc-assoc)) + (dead-lists '(gnus-killed-list gnus-zombie-list)) + bogus group killed) + (message "Checking bogus newsgroups...") + (if (not gnus-have-read-active-file) (gnus-read-active-file)) + ;; Find all bogus newsgroup that are subscribed. + (while newsrc + (setq group (car (car newsrc))) + (if (or (gnus-gethash group gnus-active-hashtb) + (nth 4 (car newsrc)) + (and confirm + (not (y-or-n-p + (format "Delete bogus newsgroup: %s " group))))) + ;; Active newsgroup. + () + ;; Found a bogus newsgroup. + (setq bogus (cons group bogus))) + (setq newsrc (cdr newsrc))) + ;; Remove all bogus subscribed groups by first killing them, and + ;; then removing them from the list of killed groups. + (while bogus + (gnus-group-change-level + (gnus-gethash (car bogus) gnus-newsrc-hashtb) 9) + (setq gnus-killed-list (delq (car bogus) gnus-killed-list)) + (setq bogus (cdr bogus))) + ;; Then we remove all bogus groups from the list of killed and + ;; zombie groups. They are are deleted without confirmation. + (while dead-lists + (setq killed (symbol-value (car dead-lists))) + (while killed + (setq group (car killed)) + (or (gnus-gethash group gnus-active-hashtb) + ;; The group is bogus. + (setq bogus (cons group bogus))) + (setq killed (cdr killed))) + (while bogus + (set (car dead-lists) + (delq (car bogus) (symbol-value (car dead-lists)))) + (setq bogus (cdr bogus))) + (setq dead-lists (cdr dead-lists))) + (message "Checking bogus newsgroups... done"))) + +;; Go though `gnus-newsrc-assoc' and compare with `gnus-active-hashtb' +;; and compute how many unread articles there are in each group. +(defun gnus-get-unread-articles (&optional level) + (let ((newsrc (cdr gnus-newsrc-assoc)) + (level (or level 7)) + info group active) + (message "Checking new news...") + (while newsrc + (setq info (car newsrc)) + (setq group (car info)) + + ;; Check foreign newsgroups. If the user doesn't want to check + ;; them, or they can't be checked, for instance, if the news + ;; server can't be reached, we just set the number of unread + ;; articles in this newsgroup to t. This means that Gnus + ;; thinks that there are unread articles, but it has no idea how + ;; many. + (if (nth 4 info) + (and (or (if (numberp gnus-activate-foreign-newsgroups) + (> (nth 1 info) gnus-activate-foreign-newsgroups) + (not gnus-activate-foreign-newsgroups)) + (not (gnus-activate-foreign-newsgroup info))) + (progn + (gnus-sethash group nil gnus-active-hashtb) + (setcar (gnus-gethash group gnus-newsrc-hashtb) t)))) + + (if (or (and (> (nth 1 info) level) + (not (car (gnus-gethash group gnus-newsrc-hashtb))) + (setcar (gnus-gethash group gnus-newsrc-hashtb) t)) + (not (or (setq active (gnus-gethash group gnus-active-hashtb)) + (and (not gnus-read-active-file) + (setq active (gnus-activate-newsgroup + (car info))))))) + ;; If this is a bogus group, there's not much we can do. + () + (gnus-get-unread-articles-in-group info active)) + (setq newsrc (cdr newsrc))) + (message "Checking new news... done"))) + + +;; Create a hash table out of the newsrc alist. The `car's of the +;; alist elements are used as keys. +(defun gnus-make-hashtable-from-newsrc-alist () + (let ((alist gnus-newsrc-assoc) + prev) + (setq gnus-newsrc-hashtb (gnus-make-hashtable (length alist))) + (setq alist + (setq prev (setq gnus-newsrc-assoc + (cons (list "dummy.group" 0 (cons 0 0)) alist)))) + (while alist + (gnus-sethash (car (car alist)) (cons nil prev) gnus-newsrc-hashtb) + (setq prev alist) + (setq alist (cdr alist))))) + +(defun gnus-make-hashtable-from-killed () + "Create a hash table from the killed and zombie lists." + (let ((lists '(gnus-killed-list gnus-zombie-list)) + list) + (setq gnus-killed-hashtb + (gnus-make-hashtable + (+ (length gnus-killed-list) (length gnus-zombie-list)))) + (while lists + (setq list (symbol-value (car lists))) + (setq lists (cdr lists)) + (while list + (gnus-sethash (car list) (car list) gnus-killed-hashtb) + (setq list (cdr list)))))) + +(defun gnus-get-unread-articles-in-group (info active) + (let (num srange lowest range group) + ;; Modify the list of read articles according to what articles + ;; are available; then tally the unread articles and add the + ;; number to the group hash table entry. + (setq range (nth 2 info)) + (setq num 0) + (cond ((not range) + (setq num (- (1+ (cdr active)) (car active)))) + ((atom (car range)) + ;; Fix a single (num . num) range according to the + ;; active hash table. + (if (< (cdr range) (car active)) (setcdr range (car active))) + ;; Compute number of unread articles. + (setq num (- (cdr active) (- (1+ (cdr range)) (car range)))) + (if (< num 0) (setq num 0))) + (t + ;; The read list is a list of ranges. Fix them according to + ;; the active hash table. + (setq srange range) + (setq lowest (1- (car active))) + (while (and (< (cdr (car srange)) lowest)) + (if (and (cdr srange) + (<= (cdr (car srange)) (1+ lowest))) + (progn + (setcdr (car srange) (cdr (car (cdr srange)))) + (setcdr srange (cdr (cdr srange)))) + (setcdr (car srange) lowest))) + ;; Compute the number of unread articles. + (while range + (setq num (+ num (- (1+ (cdr (car range))) + (car (car range))))) + (setq range (cdr range))) + (setq num (- (cdr active) num)))) + (setcar (gnus-gethash (car info) gnus-newsrc-hashtb) num) + ;; Suggested by Sudish Joseph . + ;; Active will be (n . n-1) for groups that have no articles + ;; whatsoever, which makes the number of unread articles wrong, so: + (if (< num 0) 0 num))) + +(defun gnus-activate-foreign-newsgroup (info) + (and (gnus-check-news-server (nth 4 info)) + (gnus-activate-newsgroup (car info) (gnus-group-real-name (car info))))) + +(defun gnus-activate-newsgroup (group &optional real-group-name) + (let (active) + (if (gnus-request-group group) + (save-excursion + (set-buffer nntp-server-buffer) + (goto-char 1) + (if (looking-at "[0-9]+ [0-9]+ \\([0-9]+\\) \\([0-9]+\\)") + (gnus-sethash group + (setq active + (cons (string-to-int (buffer-substring (match-beginning 1) + (match-end 1))) + (string-to-int + (buffer-substring (match-beginning 2) + (match-end 2))))) + gnus-active-hashtb)))) + active)) + +(defun gnus-update-read-articles + (group unread unselected ticked &optional domarks replied expirable killed + interesting bookmark) + "Update the list of read and ticked articles in GROUP using the +UNREAD and TICKED lists. +Note: UNSELECTED has to be sorted over `<'." + (let* ((active (gnus-gethash group gnus-active-hashtb)) + (entry (gnus-gethash group gnus-newsrc-hashtb)) + (number (car entry)) + (info (nth 2 entry)) + (marked (nth 3 info)) + (prev 1) + (unread (sort (copy-sequence unread) (function <))) + last read) + (if (not info) + ;; 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))) + (if (not (and (numberp number) (= 0 number))) + (setq unread (nconc unselected unread))) + ;; Set the number of unread articles in gnus-newsrc-hashtb. + (if (not (eq 'nnvirtual (car gnus-current-select-method))) + (setcar entry (length unread))) + ;; Compute the ranges of read articles by looking at the list of + ;; unread articles. + (while unread + (if (/= (car unread) prev) + (setq read (cons (cons prev (1- (car unread))) read))) + (setq prev (1+ (car unread))) + (setq unread (cdr unread))) + (if (<= prev (cdr active)) + (setq read (cons (cons prev (cdr active)) read))) + ;; Enter this list into the group info. + (setcar (cdr (cdr info)) + (if (> (length read) 1) (nreverse read) (car read))) + ;; Enter the list of ticked articles. + (gnus-set-marked-articles + info ticked + (or (and domarks replied) (cdr (assq 'reply marked))) + (or (and domarks expirable) (cdr (assq 'expire marked))) + (or (and domarks killed) (cdr (assq 'killed marked))) + (or (and domarks interesting) (cdr (assq 'interesting marked))) + (or (and domarks bookmark) (cdr (assq 'bookmark marked))))))) + +(defun gnus-read-active-file () + "Get active file from NNTP server." + (gnus-group-set-mode-line) + (setq gnus-have-read-active-file t) + ;; Make sure a connection to NNTP server is alive. + (gnus-check-news-server gnus-select-method) + (let ((mesg (format "Reading active file from %s via %s..." + (nth 1 gnus-select-method) (car gnus-select-method)))) + (message mesg) + (if (gnus-request-list gnus-select-method) ; Get active + (save-excursion + (set-buffer nntp-server-buffer) + (gnus-active-to-gnus-format) + (setq gnus-have-read-active-file t) + (message "%s...done" mesg)) + (error "Cannot read active file from NNTP server.")))) + +;; rewritten by jwz based on ideas from Rick Sladkey +;; Further rewrites by lmi. +(defun gnus-active-to-gnus-format () + "Convert active file format to internal format. +Lines matching gnus-ignored-newsgroups are ignored." + (let ((cur (current-buffer))) + ;; Delete unnecessary lines. + (goto-char (point-min)) + (delete-matching-lines gnus-ignored-newsgroups) + ;; Make large enough hash table. + (setq gnus-active-hashtb + (gnus-make-hashtable (count-lines (point-min) (point-max)))) + ;; Store active file in hashtable. + (save-restriction + (goto-char (point-min)) + (if (or (re-search-forward "\n.\r?$" nil t) + (goto-char (point-max))) + (progn + (beginning-of-line) + (narrow-to-region (point-min) (point)))) + (goto-char (point-min)) + (if (string-match "%[oO]" gnus-group-line-format) + ;; Suggested by Brian Edmonds . + ;; If we want information on moderated groups, we use this + ;; loop... + (let ((mod-hashtb (make-vector 7 0)) + group max mod) + (while (not (eobp)) + (setq group (let ((obarray gnus-active-hashtb)) + (read cur))) + (setq max (read cur)) + (set group (cons (read cur) max)) + ;; Enter moderated groups into a list. + (if (string= + (symbol-name (let ((obarray mod-hashtb)) (read cur))) + "m") + (setq gnus-moderated-list + (cons (symbol-name group) gnus-moderated-list))) + (forward-line 1))) + ;; And if we do not care about moderation, we use this loop, + ;; which is faster. + (let (group max) + (while (not (eobp)) + ;; group gets set to a symbol interned in gnus-active-hashtb + ;; (what a hack!!) + (setq group (let ((obarray gnus-active-hashtb)) + (read cur))) + (setq max (read cur)) + (set group (cons (read cur) max)) + (forward-line 1))))))) + +(defun gnus-read-newsrc-file (&optional force) + "Read startup file. +If FORCE is non-nil, the .newsrc file is read." + (setq gnus-current-startup-file (gnus-make-newsrc-file gnus-startup-file)) + ;; Reset variables that might be defined in the .newsrc.eld file. + (let ((variables gnus-variable-list)) + (while variables + (set (car variables) nil) + (setq variables (cdr variables)))) + (let* ((newsrc-file gnus-current-startup-file) + (quick-file (concat newsrc-file ".el"))) + (save-excursion + ;; We always load the .newsrc.eld file. If always contains + ;; much information that can not be gotten from the .newsrc + ;; file (ticked articles, killed groups, foreign methods, etc.) + (gnus-read-newsrc-el-file quick-file) + + (if (or force + (and (file-newer-than-file-p newsrc-file quick-file) + (file-newer-than-file-p newsrc-file + (concat quick-file "d"))) + (not gnus-newsrc-assoc)) + ;; We read the .newsrc file. Note that if there if a + ;; .newsrc.eld file exists, it has already been read, and + ;; the `gnus-newsrc-hashtb' has been created. While reading + ;; the .newsrc file, Gnus will only use the information it + ;; can find there for changing the data already read - + ;; ie. reading the .newsrc file will not trash the data + ;; already read (except for read articles). + (save-excursion + (message "Reading %s..." newsrc-file) + (set-buffer (find-file-noselect newsrc-file)) + (buffer-disable-undo (current-buffer)) + (gnus-newsrc-to-gnus-format) + (kill-buffer (current-buffer)) + (message "Reading %s... done" newsrc-file))) + (gnus-dribble-read-file)))) + +(defun gnus-read-newsrc-el-file (file) + (let ((ding-file (concat file "d"))) + ;; We always, always read the .eld file. + (message "Reading %s..." ding-file) + (condition-case nil + (load ding-file t t t) + (error nil)) + (gnus-make-hashtable-from-newsrc-alist) + (if (not (file-newer-than-file-p file ding-file)) + () + ;; Old format quick file + (message "Reading %s..." file) + ;; The .el file is newer than the .eld file, so we read that one + ;; as well. + (gnus-read-old-newsrc-el-file file)))) + +;; Parse the old-style quick startup file +(defun gnus-read-old-newsrc-el-file (file) + (let (newsrc killed marked group g m len info) + (prog1 + (let (gnus-killed-assoc gnus-marked-assoc gnus-newsrc-assoc) + (prog1 + (condition-case nil + (load file t t t) + (error nil)) + (setq newsrc gnus-newsrc-assoc + killed gnus-killed-assoc + marked gnus-marked-assoc))) + (setq gnus-newsrc-assoc nil) + (while newsrc + (setq group (car newsrc)) + (let ((info (nth 2 (gnus-gethash (car group) gnus-newsrc-hashtb)))) + (if info + (progn + ;; Bug by Kimball Collins . + (setcar (nthcdr 2 info) (cdr (cdr group))) + (setcar (cdr info) (if (nth 1 group) 3 6)) + (setq gnus-newsrc-assoc (cons info gnus-newsrc-assoc))) + (setq gnus-newsrc-assoc + (cons + (setq info + (list (car group) + (if (nth 1 group) 3 6) (cdr (cdr group)))) + gnus-newsrc-assoc))) + (if (setq m (assoc (car group) marked)) + (setcdr (cdr (cdr info)) (cons (list (cons 'tick (cdr m))) nil)))) + (setq newsrc (cdr newsrc))) + (setq newsrc killed) + (while newsrc + (setcar newsrc (car (car newsrc))) + (setq newsrc (cdr newsrc))) + (setq gnus-killed-list killed)) + (setq gnus-newsrc-assoc (nreverse gnus-newsrc-assoc)) + (gnus-make-hashtable-from-newsrc-alist))) + +(defun gnus-make-newsrc-file (file) + "Make server dependent file name by catenating FILE and server host name." + (let* ((file (expand-file-name file nil)) + (real-file (concat file "-" (nth 1 gnus-select-method)))) + (if (file-exists-p real-file) + real-file file) + )) + +;; jwz: rewrote this function to be much more efficient, and not be subject +;; to regexp overflow errors when it encounters very long lines -- the old +;; behavior was to blow off the rest of the *file* when a line was encountered +;; that was too long to match!! Now it uses only simple looking-at calls, and +;; doesn't create as many temporary strings. It also now handles multiple +;; consecutive options lines (before it only handled the first.) +;; Tiny rewrite by lmi. +(defun gnus-newsrc-to-gnus-format () + "Parse current buffer as .newsrc file." + ;; We have to re-initialize these variables (except for + ;; gnus-killed-list) because quick startup file may contain bogus + ;; values. + (setq gnus-newsrc-options nil) + (setq gnus-newsrc-options-n-yes nil) + (setq gnus-newsrc-options-n-no nil) + (setq gnus-newsrc-assoc nil) + (gnus-parse-options-lines) + (gnus-parse-newsrc-body)) + +(defun gnus-parse-options-lines () + ;; newsrc.5 seems to indicate that the options line can come anywhere + ;; in the file, and that there can be any number of them: + ;; + ;; An options line starts with the word options (left- + ;; justified). Then there are the list of options just as + ;; they would be on the readnews command line. For instance: + ;; + ;; options -n all !net.sf-lovers !mod.human-nets -r + ;; options -c -r + ;; + ;; A string of lines beginning with a space or tab after the + ;; initial options line will be considered continuation + ;; lines. + ;; + ;; For now, we only accept it at the beginning of the file. + + (goto-char (point-min)) + (skip-chars-forward " \t\n") + (setq gnus-newsrc-options nil) + (while (looking-at "^options[ \t]*\\(.*\\)\n") + ;; handle consecutive options lines + (setq gnus-newsrc-options (concat gnus-newsrc-options + (if gnus-newsrc-options "\n\t") + (buffer-substring (match-beginning 1) + (match-end 1)))) + (forward-line 1) + (while (looking-at "[ \t]+\\(.*\\)\n") + ;; handle subsequent continuation lines of this options line + (setq gnus-newsrc-options (concat gnus-newsrc-options "\n\t" + (buffer-substring (match-beginning 1) + (match-end 1)))) + (forward-line 1))) + ;; Gather all "-n" options lines. + (let ((start 0) + (result nil)) + (if gnus-newsrc-options + (while (and (string-match "^[ \t]*-n\\([^\n]*\\)$" + gnus-newsrc-options + start) + (setq start (match-end 0))) + (setq result (concat result + (and result " ") + (substring gnus-newsrc-options + (match-beginning 1) + (match-end 1)))))) + (let ((yes-and-no (and result (gnus-parse-n-options result)))) + (setq gnus-newsrc-options-n-yes (car yes-and-no)) + (setq gnus-newsrc-options-n-no (cdr yes-and-no))) + nil)) + +(defun gnus-parse-newsrc-body () + ;; Point has been positioned after the options lines. We shouldn't + ;; see any more in here. + + (let ((subscribe nil) + (read-list nil) + (line (1+ (count-lines (point-min) (point)))) + newsgroup + p p2) + (save-restriction + (skip-chars-forward " \t") + (while (not (eobp)) + (cond + ((= (following-char) ?\n) + ;; skip blank lines + nil) + (t + (setq p (point)) + (skip-chars-forward "^:!\n") + (if (= (following-char) ?\n) + (error "line %d is unparsable in %s" line (buffer-name))) + (setq p2 (point)) + (skip-chars-backward " \t") + + ;; #### note: we could avoid consing a string here by binding obarray + ;; and reading the newsgroup directly into the gnus-newsrc-hashtb, + ;; then setq'ing newsgroup to symbol-name of that, like we do in + ;; gnus-active-to-gnus-format. + (setq newsgroup (buffer-substring p (point))) + (goto-char p2) + + (setq subscribe (= (following-char) ?:)) + (setq read-list nil) + + (forward-char 1) ; after : or ! + (skip-chars-forward " \t") + (while (not (= (following-char) ?\n)) + (skip-chars-forward " \t") + (or + (and (cond + ((looking-at "\\([0-9]+\\)-\\([0-9]+\\)") ; a range + (setq read-list + (cons + (cons + (progn + ;; faster that buffer-substring/string-to-int + (narrow-to-region (point-min) (match-end 1)) + (read (current-buffer))) + (progn + (narrow-to-region (point-min) (match-end 2)) + (forward-char) ; skip over "-" + (prog1 + (read (current-buffer)) + (widen)))) + read-list)) + t) + ((looking-at "[0-9]+") + ;; faster that buffer-substring/string-to-int + (narrow-to-region (point-min) (match-end 0)) + (setq p (read (current-buffer))) + (widen) + (setq read-list (cons (cons p p) read-list)) + t) + (t + ;; bogus chars in ranges + nil)) + (progn + (goto-char (match-end 0)) + (skip-chars-forward " \t") + (cond ((= (following-char) ?,) + (forward-char 1) + t) + ((= (following-char) ?\n) + t) + (t + ;; bogus char after range + nil)))) + ;; if we get here, the parse failed + (progn + (end-of-line) ; give up on this line + (ding) + (message "Ignoring bogus line %d for %s in %s" + line newsgroup (buffer-name)) + (sleep-for 1)))) + (if read-list + (let ((info (nth 2 (gnus-gethash newsgroup gnus-newsrc-hashtb)))) + (if info + (progn + (setcar (nthcdr 2 info) (nreverse read-list)) + (setcar (cdr info) (if subscribe 2 6)) + (setq gnus-newsrc-assoc (cons info gnus-newsrc-assoc))) + (setq gnus-newsrc-assoc + (cons + (cons newsgroup + (cons (if subscribe 2 6) (nreverse read-list))) + gnus-newsrc-assoc)))) + (setq gnus-killed-list (cons newsgroup gnus-killed-list))))) + (setq line (1+ line)) + (forward-line 1)))) + (setq gnus-newsrc-assoc (nreverse gnus-newsrc-assoc)) + (gnus-make-hashtable-from-newsrc-alist) + nil) + +(defun gnus-parse-n-options (options) + "Parse -n NEWSGROUPS options and return a cons of YES and NO regexps." + (let ((yes nil) + (no nil) + (yes-or-no nil) ;`!' or not. + (newsgroup nil)) + ;; Parse each newsgroup description such as "comp.all". Commas + ;; and white spaces can be a newsgroup separator. + (while + (string-match "^[ \t\n,]*\\(!?\\)\\([^- \t\n,][^ \t\n,]*\\)" options) + (setq yes-or-no + (substring options (match-beginning 1) (match-end 1))) + (setq newsgroup + (regexp-quote + (substring options + (match-beginning 2) (match-end 2)))) + (setq options (substring options (match-end 2))) + ;; Rewrite "all" to ".+" not ".*". ".+" requires at least one + ;; character. + (while (string-match "\\(^\\|\\\\[.]\\)all\\(\\\\[.]\\|$\\)" newsgroup) + (setq newsgroup + (concat (substring newsgroup 0 (match-end 1)) + ".+" + (substring newsgroup (match-beginning 2))))) + ;; It is yes or no. + (cond ((string-equal yes-or-no "!") + (setq no (cons newsgroup no))) + ((string-equal newsgroup ".+")) ;Ignore `all'. + (t + (setq yes (cons newsgroup yes)))) + ) + ;; Make a cons of regexps from parsing result. + ;; We have to append \(\.\|$\) to prevent matching substring of + ;; newsgroup. For example, "jp.net" should not match with + ;; "jp.network". + ;; Fixes for large regexp problems are from yonezu@nak.math.keio.ac.jp. + (cons (if yes + (concat "^\\(" + (apply (function concat) + (mapcar + (lambda (newsgroup) + (concat newsgroup "\\|")) + (cdr yes))) + (car yes) "\\)\\(\\.\\|$\\)")) + (if no + (concat "^\\(" + (apply (function concat) + (mapcar + (lambda (newsgroup) + (concat newsgroup "\\|")) + (cdr no))) + (car no) "\\)\\(\\.\\|$\\)"))) + )) + +(defun gnus-save-newsrc-file () + "Save to .newsrc FILE." + ;; Note: We cannot save .newsrc file if all newsgroups are removed + ;; from the variable gnus-newsrc-assoc. + (and (or gnus-newsrc-assoc gnus-killed-list) + gnus-current-startup-file + (save-excursion + (if (= 0 (save-excursion + (set-buffer gnus-dribble-buffer) + (buffer-size))) + (message "(No changes need to be saved)") + (if gnus-save-newsrc-file + (let ((make-backup-files t) + (version-control nil) + (require-final-newline t)) ;Don't ask even if requested. + (message "Saving %s..." gnus-current-startup-file) + ;; Make backup file of master newsrc. + ;; You can stop or change version control of backup file. + ;; Suggested by jason@violet.berkeley.edu. + (run-hooks 'gnus-save-newsrc-hook) + (gnus-gnus-to-newsrc-format) + (message "Saving %s... done" gnus-current-startup-file))) + ;; Quickly loadable .newsrc. + (set-buffer (get-buffer-create " *Gnus-newsrc*")) + (gnus-add-current-to-buffer-list) + (buffer-disable-undo (current-buffer)) + (erase-buffer) + (message "Saving %s.eld..." gnus-current-startup-file) + (gnus-gnus-to-quick-newsrc-format) + (let ((make-backup-files nil) + (version-control nil) + (require-final-newline t)) ;Don't ask even if requested. + (write-region 1 (point-max) + (concat gnus-current-startup-file ".eld") + nil 'nomesg)) + (kill-buffer (current-buffer)) + (message "Saving %s.eld... done" gnus-current-startup-file) + (gnus-dribble-delete-file))))) + +(defun gnus-gnus-to-quick-newsrc-format () + "Insert Gnus variables such as gnus-newsrc-assoc in lisp format." + (insert ";; (ding) Gnus startup file.\n") + (insert ";; Never delete this file - touch .newsrc instead to force Gnus\n") + (insert ";; to read .newsrc.\n") + (let ((variables gnus-variable-list) + (gnus-newsrc-assoc (cdr gnus-newsrc-assoc)) + variable) + ;; insert lisp expressions. + (while variables + (setq variable (car variables)) + (and (boundp variable) + (symbol-value variable) + (or gnus-save-killed-list + (not (or (eq variable 'gnus-killed-list) + (eq variable 'gnus-zombie-list)))) + (insert "(setq " (symbol-name variable) " '" + (prin1-to-string (symbol-value variable)) + ")\n")) + (setq variables (cdr variables))))) + +(defun gnus-gnus-to-newsrc-format () + (let ((newsrc (cdr gnus-newsrc-assoc)) + group ranges) + (save-excursion + (set-buffer (create-file-buffer gnus-startup-file)) + (buffer-disable-undo (current-buffer)) + (erase-buffer) + ;; Bug by Hallvard B Furuseth . + (if gnus-newsrc-options (insert "options " gnus-newsrc-options "\n")) + (while newsrc + (setq group (car newsrc)) + (insert (car group) (if (>= (nth 1 group) 6) "!" ":")) + (if (setq ranges (nth 2 group)) + (progn + (insert " ") + (gnus-ranges-to-newsrc-format + (if (atom (car ranges)) (list ranges) ranges)))) + (insert "\n") + (setq newsrc (cdr newsrc))) + (write-region 1 (point-max) gnus-startup-file nil 'nomesg) + (kill-buffer (current-buffer))))) + +(defun gnus-ranges-to-newsrc-format (ranges) + "Insert ranges of read articles." + (let ((range nil)) ;Range is a pair of BEGIN and END. + (while ranges + (setq range (car ranges)) + (setq ranges (cdr ranges)) + (cond ((= (car range) (cdr range)) + (if (= (car range) 0) + (setq ranges nil) ;No unread articles. + (insert (int-to-string (car range))) + (if ranges (insert ",")) + )) + (t + (insert (int-to-string (car range)) + "-" + (int-to-string (cdr range))) + (if ranges (insert ",")) + )) + ))) + +(defun gnus-read-descriptions-file () + (message "Reading descriptions file...") + (if (not (gnus-request-list-newsgroups gnus-select-method)) + (progn + (message "Couldn't read newsgroups descriptions") + nil) + (let (group) + (setq gnus-description-hashtb + (gnus-make-hashtable (length gnus-active-hashtb))) + (save-excursion + (save-restriction + (set-buffer nntp-server-buffer) + (goto-char (point-min)) + (delete-non-matching-lines "^[a-zA-Z\\.0-9]+[ \t]") + (goto-char (point-min)) + (if (or (search-forward "\n.\n" nil t) + (goto-char (point-max))) + (progn + (beginning-of-line) + (narrow-to-region (point-min) (point)))) + (goto-char (point-min)) + (while (not (eobp)) + (setq group (let ((obarray gnus-description-hashtb)) + (read (current-buffer)))) + (skip-chars-forward " \t") + (set group (buffer-substring + (point) (save-excursion (end-of-line) (point)))) + (forward-line 1)))) + (message "Reading descriptions file...done") + t))) + +(provide 'gnus) + +;;; gnus.el ends here diff --git a/lisp/mhspool.el b/lisp/mhspool.el new file mode 100644 index 000000000..785f2536b --- /dev/null +++ b/lisp/mhspool.el @@ -0,0 +1,490 @@ +;;; mhspool.el --- MH folder access using NNTP for GNU Emacs + +;; Copyright (C) 1988, 1989, 1990, 1993 Free Software Foundation, Inc. + +;; Author: Masanobu UMEDA +;; Maintainer: FSF +;; Keywords: mail, news + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to +;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +;;; Commentary: + +;; This package enables you to read mail or articles in MH folders, or +;; articles saved by GNUS. In any case, the file names of mail or +;; articles must consist of only numeric letters. + +;; Before using this package, you have to create a server specific +;; startup file according to the directory which you want to read. For +;; example, if you want to read mail under the directory named +;; `~/Mail', the file must be a file named `.newsrc-:Mail'. (There is +;; no way to specify hierarchical directory now.) In this case, the +;; name of the NNTP server passed to GNUS must be `:Mail'. + +;;; Code: + +(require 'nntp) + +(defvar mhspool-list-folders-method + (function mhspool-list-folders-using-sh) + "*Function to list files in folders. +The function should accept a directory as its argument, and fill the +current buffer with file and directory names. The output format must +be the same as that of 'ls -R1'. Two functions +mhspool-list-folders-using-ls and mhspool-list-folders-using-sh are +provided now. I suppose the later is faster.") + +(defvar mhspool-list-directory-switches '("-R") + "*Switches for mhspool-list-folders-using-ls to pass to `ls' for getting file lists. +One entry should appear on one line. You may need to add `-1' option.") + + + +(defconst mhspool-version "MHSPOOL 1.8" + "Version numbers of this version of MHSPOOL.") + +(defvar mhspool-spool-directory "~/Mail" + "Private mail directory.") + +(defvar mhspool-current-directory nil + "Current news group directory.") + +;;; +;;; Replacement of Extended Command for retrieving many headers. +;;; + +(defun mhspool-retrieve-headers (sequence) + "Return list of article headers specified by SEQUENCE of article id. +The format of list is + `([NUMBER SUBJECT FROM XREF LINES DATE MESSAGE-ID REFERENCES] ...)'. +If there is no References: field, In-Reply-To: field is used instead. +Reader macros for the vector are defined as `nntp-header-FIELD'. +Writer macros for the vector are defined as `nntp-set-header-FIELD'. +Newsgroup must be selected before calling this." + (save-excursion + (set-buffer nntp-server-buffer) + ;;(erase-buffer) + (let ((file nil) + (number (length sequence)) + (count 0) + (headers nil) ;Result list. + (article 0) + (subject nil) + (message-id nil) + (from nil) + (xref nil) + (lines 0) + (date nil) + (references nil)) + (while sequence + ;;(nntp-send-strings-to-server "HEAD" (car sequence)) + (setq article (car sequence)) + (setq file + (concat mhspool-current-directory (prin1-to-string article))) + (if (and (file-exists-p file) + (not (file-directory-p file))) + (progn + (erase-buffer) + (insert-file-contents file) + ;; Make message body invisible. + (goto-char (point-min)) + (search-forward "\n\n" nil 'move) + (narrow-to-region (point-min) (point)) + ;; Fold continuation lines. + (goto-char (point-min)) + (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t) + (replace-match " " t t)) + ;; Make it possible to search for `\nFIELD'. + (goto-char (point-min)) + (insert "\n") + ;; Extract From: + (goto-char (point-min)) + (if (search-forward "\nFrom: " nil t) + (setq from (buffer-substring + (point) + (save-excursion (end-of-line) (point)))) + (setq from "(Unknown User)")) + ;; Extract Subject: + (goto-char (point-min)) + (if (search-forward "\nSubject: " nil t) + (setq subject (buffer-substring + (point) + (save-excursion (end-of-line) (point)))) + (setq subject "(None)")) + ;; Extract Message-ID: + (goto-char (point-min)) + (if (search-forward "\nMessage-ID: " nil t) + (setq message-id (buffer-substring + (point) + (save-excursion (end-of-line) (point)))) + (setq message-id nil)) + ;; Extract Date: + (goto-char (point-min)) + (if (search-forward "\nDate: " nil t) + (setq date (buffer-substring + (point) + (save-excursion (end-of-line) (point)))) + (setq date nil)) + ;; Extract Lines: + (goto-char (point-min)) + (if (search-forward "\nLines: " nil t) + (setq lines (string-to-int + (buffer-substring + (point) + (save-excursion (end-of-line) (point))))) + ;; Count lines since there is no lines field in most cases. + (setq lines + (save-restriction + (goto-char (point-max)) + (widen) + (count-lines (point) (point-max))))) + ;; Extract Xref: + (goto-char (point-min)) + (if (search-forward "\nXref: " nil t) + (setq xref (buffer-substring + (point) + (save-excursion (end-of-line) (point)))) + (setq xref nil)) + ;; Extract References: + ;; If no References: field, use In-Reply-To: field instead. + ;; Suggested by tanaka@flab.fujitsu.co.jp (Hiroshi TANAKA). + (goto-char (point-min)) + (if (or (search-forward "\nReferences: " nil t) + (search-forward "\nIn-Reply-To: " nil t)) + (setq references (buffer-substring + (point) + (save-excursion (end-of-line) (point)))) + (setq references nil)) + ;; Collect valid article only. + (and article + message-id + (setq headers + (cons (vector article subject from + xref lines date + message-id references) headers))) + )) + (setq sequence (cdr sequence)) + (setq count (1+ count)) + (and (numberp nntp-large-newsgroup) + (> number nntp-large-newsgroup) + (zerop (% count 20)) + (message "MHSPOOL: Receiving headers... %d%%" + (/ (* count 100) number))) + ) + (and (numberp nntp-large-newsgroup) + (> number nntp-large-newsgroup) + (message "MHSPOOL: Receiving headers... done")) + (nreverse headers) + ))) + + +;;; +;;; Replacement of NNTP Raw Interface. +;;; + +(defun mhspool-open-server (host &optional service) + "Open news server on HOST. +If HOST is nil, use value of environment variable `NNTPSERVER'. +If optional argument SERVICE is non-nil, open by the service name." + (let ((host (or host (getenv "NNTPSERVER"))) + (status nil)) + ;; Get directory name from HOST name. + (if (string-match ":\\(.+\\)$" host) + (progn + (setq mhspool-spool-directory + (file-name-as-directory + (expand-file-name + (substring host (match-beginning 1) (match-end 1)) + (expand-file-name "~/" nil)))) + (setq host (system-name))) + (setq mhspool-spool-directory nil)) + (setq nntp-status-string "") + (cond ((and (stringp host) + (stringp mhspool-spool-directory) + (file-directory-p mhspool-spool-directory) + (string-equal host (system-name))) + (setq status (mhspool-open-server-internal host service))) + ((string-equal host (system-name)) + (setq nntp-status-string + (format "No such directory: %s. Goodbye." + mhspool-spool-directory))) + ((null host) + (setq nntp-status-string "NNTP server is not specified.")) + (t + (setq nntp-status-string + (format "MHSPOOL: cannot talk to %s." host))) + ) + status + )) + +(defun mhspool-close-server () + "Close news server." + (mhspool-close-server-internal)) + +(fset 'mhspool-request-quit (symbol-function 'mhspool-close-server)) + +(defun mhspool-server-opened () + "Return server process status, T or NIL. +If the stream is opened, return T, otherwise return NIL." + (and nntp-server-buffer + (get-buffer nntp-server-buffer))) + +(defun mhspool-status-message () + "Return server status response as string." + nntp-status-string + ) + +(defun mhspool-request-article (id) + "Select article by message ID (or number)." + (let ((file (concat mhspool-current-directory (prin1-to-string id)))) + (if (and (stringp file) + (file-exists-p file) + (not (file-directory-p file))) + (save-excursion + (mhspool-find-file file))) + )) + +(defun mhspool-request-body (id) + "Select article body by message ID (or number)." + (if (mhspool-request-article id) + (save-excursion + (set-buffer nntp-server-buffer) + (goto-char (point-min)) + (if (search-forward "\n\n" nil t) + (delete-region (point-min) (point))) + t + ) + )) + +(defun mhspool-request-head (id) + "Select article head by message ID (or number)." + (if (mhspool-request-article id) + (save-excursion + (set-buffer nntp-server-buffer) + (goto-char (point-min)) + (if (search-forward "\n\n" nil t) + (delete-region (1- (point)) (point-max))) + t + ) + )) + +(defun mhspool-request-stat (id) + "Select article by message ID (or number)." + (setq nntp-status-string "MHSPOOL: STAT is not implemented.") + nil + ) + +(defun mhspool-request-group (group) + "Select news GROUP." + (cond ((file-directory-p + (mhspool-article-pathname group)) + ;; Mail/NEWS.GROUP/N + (setq mhspool-current-directory + (mhspool-article-pathname group))) + ((file-directory-p + (mhspool-article-pathname + (mhspool-replace-chars-in-string group ?. ?/))) + ;; Mail/NEWS/GROUP/N + (setq mhspool-current-directory + (mhspool-article-pathname + (mhspool-replace-chars-in-string group ?. ?/)))) + )) + +(defun mhspool-request-list () + "List active newsgoups." + (save-excursion + (let* ((newsgroup nil) + (articles nil) + (directory (file-name-as-directory + (expand-file-name mhspool-spool-directory nil))) + (folder-regexp (concat "^" (regexp-quote directory) "\\(.+\\):$")) + (buffer (get-buffer-create " *MHSPOOL File List*"))) + (set-buffer nntp-server-buffer) + (erase-buffer) + (set-buffer buffer) + (erase-buffer) +;; (apply 'call-process +;; "ls" nil t nil +;; (append mhspool-list-directory-switches (list directory))) + (funcall mhspool-list-folders-method directory) + (goto-char (point-min)) + (while (re-search-forward folder-regexp nil t) + (setq newsgroup + (mhspool-replace-chars-in-string + (buffer-substring (match-beginning 1) (match-end 1)) ?/ ?.)) + (setq articles nil) + (forward-line 1) ;(beginning-of-line) + ;; Thank nobu@flab.fujitsu.junet for his bug fixes. + (while (and (not (eobp)) + (not (looking-at "^$"))) + (if (looking-at "^[0-9]+$") + (setq articles + (cons (string-to-int + (buffer-substring + (match-beginning 0) (match-end 0))) + articles))) + (forward-line 1)) + (if articles + (princ (format "%s %d %d n\n" newsgroup + (apply (function max) articles) + (apply (function min) articles)) + nntp-server-buffer)) + ) + (kill-buffer buffer) + (set-buffer nntp-server-buffer) + (buffer-size) + ))) + +(defun mhspool-request-list-newsgroups () + "List newsgoups (defined in NNTP2)." + (setq nntp-status-string "MHSPOOL: LIST NEWSGROUPS is not implemented.") + nil + ) + +(defun mhspool-request-list-distributions () + "List distributions (defined in NNTP2)." + (setq nntp-status-string "MHSPOOL: LIST DISTRIBUTIONS is not implemented.") + nil + ) + +(defun mhspool-request-last () + "Set current article pointer to the previous article +in the current news group." + (setq nntp-status-string "MHSPOOL: LAST is not implemented.") + nil + ) + +(defun mhspool-request-next () + "Advance current article pointer." + (setq nntp-status-string "MHSPOOL: NEXT is not implemented.") + nil + ) + +(defun mhspool-request-post () + "Post a new news in current buffer." + (setq nntp-status-string "MHSPOOL: POST: what do you mean?") + nil + ) + + +;;; +;;; Replacement of Low-Level Interface to NNTP Server. +;;; + +(defun mhspool-open-server-internal (host &optional service) + "Open connection to news server on HOST by SERVICE (default is nntp)." + (save-excursion + (if (not (string-equal host (system-name))) + (error "MHSPOOL: cannot talk to %s." host)) + ;; Initialize communication buffer. + (setq nntp-server-buffer (get-buffer-create " *nntpd*")) + (set-buffer nntp-server-buffer) + (buffer-disable-undo (current-buffer)) + (erase-buffer) + (kill-all-local-variables) + (setq case-fold-search t) ;Should ignore case. + (setq nntp-server-process nil) + (setq nntp-server-name host) + ;; It is possible to change kanji-fileio-code in this hook. + (run-hooks 'nntp-server-hook) + t + )) + +(defun mhspool-close-server-internal () + "Close connection to news server." + (if nntp-server-buffer + (kill-buffer nntp-server-buffer)) + (setq nntp-server-buffer nil) + (setq nntp-server-process nil)) + +(defun mhspool-find-file (file) + "Insert FILE in server buffer safely." + (set-buffer nntp-server-buffer) + (erase-buffer) + (condition-case () + (progn + (insert-file-contents file) + (goto-char (point-min)) + ;; If there is no body, `^L' appears at end of file. Special + ;; hack for MH folder. + (and (search-forward "\n\n" nil t) + (string-equal (buffer-substring (point) (point-max)) "\^L") + (delete-char 1)) + t + ) + (file-error nil) + )) + +(defun mhspool-article-pathname (group) + "Make pathname for GROUP." + (concat (file-name-as-directory mhspool-spool-directory) group "/")) + +(defun mhspool-replace-chars-in-string (string from to) + "Replace characters in STRING from FROM to TO." + (let ((string (substring string 0)) ;Copy string. + (len (length string)) + (idx 0)) + ;; Replace all occurrences of FROM with TO. + (while (< idx len) + (if (= (aref string idx) from) + (aset string idx to)) + (setq idx (1+ idx))) + string + )) + + +;; Methods for listing files in folders. + +(defun mhspool-list-folders-using-ls (directory) + "List files in folders under DIRECTORY using 'ls'." + (apply 'call-process + "ls" nil t nil + (append mhspool-list-directory-switches (list directory)))) + +;; Basic ideas by tanaka@flab.fujitsu.co.jp (Hiroshi TANAKA) + +(defun mhspool-list-folders-using-sh (directory) + "List files in folders under DIRECTORY using '/bin/sh'." + (let ((buffer (current-buffer)) + (script (get-buffer-create " *MHSPOOL Shell Script Buffer*"))) + (save-excursion + (save-restriction + (set-buffer script) + (erase-buffer) + ;; /bin/sh script which does 'ls -R'. + (insert + "PS2= + ffind() { + cd $1; echo $1: + ls -1 + echo + for j in `echo *[a-zA-Z]*` + do + if [ -d $1/$j ]; then + ffind $1/$j + fi + done + } + cd " directory "; ffind `pwd`; exit 0\n") + (call-process-region (point-min) (point-max) "sh" nil buffer nil) + )) + (kill-buffer script) + )) + +(provide 'mhspool) + +;;; mhspool.el ends here diff --git a/lisp/nnheader.el b/lisp/nnheader.el new file mode 100644 index 000000000..faa80c392 --- /dev/null +++ b/lisp/nnheader.el @@ -0,0 +1,140 @@ +;;; nnheader: Header access macros for Gnus and its backends + +;; Copyright (C) 1987,88,89,90,93,94 Free Software Foundation, Inc. + +;; Author: Masanobu UMEDA +;; Lars Ingebrigtsen +;; Keywords: news + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to +;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +;;; Commentary: + +;; These macros may look very much like the ones in GNUS 4.1. They +;; are, in a way, but you should note that the indices they use have +;; been changed from the internal GNUS format to the NOV format. Makes +;; it possible to read headers from XOVER much faster. +;; +;; The format of a header is now: +;; [number subject from date id references chars lines xref] +;; +;; (That last entry is defined as "misc" in the NOV format, but Gnus +;; uses it for xrefs.) + +;;; Code: + +(defalias 'nntp-header-number 'header-number) +(defmacro header-number (header) + "Return article number in HEADER." + (` (aref (, header) 0))) + +(defalias 'nntp-set-header-number 'header-set-number) +(defmacro header-set-number (header number) + "Set article number of HEADER to NUMBER." + (` (aset (, header) 0 (, number)))) + +(defalias 'nntp-header-subject 'header-subject) +(defmacro header-subject (header) + "Return subject string in HEADER." + (` (aref (, header) 1))) + +(defalias 'nntp-set-header-subject 'header-set-subject) +(defmacro header-set-subject (header subject) + "Set article subject of HEADER to SUBJECT." + (` (aset (, header) 1 (, subject)))) + +(defalias 'nntp-header-from 'header-from) +(defmacro header-from (header) + "Return author string in HEADER." + (` (aref (, header) 2))) + +(defalias 'nntp-set-header-from 'header-set-from) +(defmacro header-set-from (header from) + "Set article author of HEADER to FROM." + (` (aset (, header) 2 (, from)))) + +(defalias 'nntp-header-xref 'header-xref) +(defmacro header-xref (header) + "Return xref string in HEADER." + (` (aref (, header) 8))) + +(defalias 'nntp-set-header-xref 'header-set-xref) +(defmacro header-set-xref (header xref) + "Set article xref of HEADER to xref." + (` (aset (, header) 8 (, xref)))) + +(defalias 'nntp-header-lines 'header-lines) +(defmacro header-lines (header) + "Return lines in HEADER." + (` (aref (, header) 7))) + +(defalias 'nntp-set-header-lines 'header-set-lines) +(defmacro header-set-lines (header lines) + "Set article lines of HEADER to LINES." + (` (aset (, header) 7 (, lines)))) + +(defalias 'nntp-header-date 'header-date) +(defmacro header-date (header) + "Return date in HEADER." + (` (aref (, header) 3))) + +(defalias 'nntp-set-header-date 'header-set-date) +(defmacro header-set-date (header date) + "Set article date of HEADER to DATE." + (` (aset (, header) 3 (, date)))) + +(defalias 'nntp-header-id 'header-id) +(defmacro header-id (header) + "Return Id in HEADER." + (` (aref (, header) 4))) + +(defalias 'nntp-set-header-id 'header-set-id) +(defmacro header-set-id (header id) + "Set article Id of HEADER to ID." + (` (aset (, header) 4 (, id)))) + +(defalias 'nntp-header-references 'header-references) +(defmacro header-references (header) + "Return references in HEADER." + (` (aref (, header) 5))) + +(defalias 'nntp-set-header-references 'header-set-references) +(defmacro header-set-references (header ref) + "Set article references of HEADER to REF." + (` (aset (, header) 5 (, ref)))) + +(defalias 'nntp-header-chars 'header-chars) +(defmacro header-chars (header) + "Return number of chars of article in HEADER." + (` (aref (, header) 6))) + +(defalias 'nntp-set-header-chars 'header-set-chars) +(defmacro header-set-chars (header chars) + "Set number of chars in article of HEADER to CHARS." + (` (aset (, header) 6 (, chars)))) + +;; Various cruft the backends and Gnus need to communicate. + +(defvar nntp-server-buffer nil) +(defvar gnus-backends-are-talkative t + "*If non-nil, Gnus backends will generate lots of comments.") +(defvar news-reply-yank-from nil) +(defvar news-reply-yank-message-id nil) + +(provide 'nnheader) + +;;; nnheader.el ends here diff --git a/lisp/nnmail.el b/lisp/nnmail.el new file mode 100644 index 000000000..5759080bf --- /dev/null +++ b/lisp/nnmail.el @@ -0,0 +1,601 @@ +;;; nnmail.el --- mail mbox access for Gnus + +;; Copyright (C) 1994 Free Software Foundation, Inc. + +;; Author: Lars Ingebrigtsen +;; Masanobu UMEDA +;; Keywords: news + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to +;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +;;; Commentary: + +;;; Code: + +(require 'nnheader) +(require 'rmail) + +(defvar nnmail-split-methods + '(("mail.misc" "")) + "nnmail will split incoming mail into the groups detailed in this variable.") + +(defvar nnmail-mbox-file (expand-file-name "~/mbox") + "The name of the mail box file in the users home directory.") + +(defvar nnmail-active-file (expand-file-name "~/.mbox-active") + "The name of the active file for the mail box.") + +(defvar nnmail-expiry-wait 7 + "Articles that are older than `nnmail-expiry-wait' days will be expired.") + +;; Quote fix by Sudish Joseph . +(defvar nnmail-expiry-wait-function nil + "Variable that holds funtion to specify how old articles should be before they are expired. + The function will be called with the name of the group that the +expiry is to be performed in, and it should return an integer that +says how many days an article can be stored before it is considered +'old'. + +Eg.: + +(setq nnmail-expiry-wait-function + (function + (lambda (newsgroup) + (cond ((string-match \"private\" newsgroup) 31) + ((string-match \"junk\" newsgroup) 1) + (t 7)))))") + +(defvar nnmail-spool-file + (or (getenv "MAIL") + (concat "/usr/spool/mail/" (user-login-name)))) + +(defvar nnmail-read-incoming-hook nil + "Hook that will be run after the incoming mail has been transferred. +The incoming mail is moved from `nnmail-spool-file' (which normally is +something like \"/usr/spool/mail/$user\") to the user's home +directory. This hook is called after the incoming mail box has been +emptied, and can be used to call any mail box programs you have +running (\"xwatch\", etc.) + +Eg. + +(add-hook 'nnmail-read-incoming-hook + (function + (lambda () + (start-process \"mailsend\" nil + \"/local/bin/mailsend\" \"read\" \"mbox\"))))") + +(defvar nnmail-large-newsgroup 50 + "*The number of the articles which indicates a large newsgroup. +If the number of the articles is greater than the value, verbose +messages will be shown to indicate the current status.") + + + +(defconst nnmail-version "nnmail 0.1" + "nnmail version.") + +(defvar nnmail-current-group nil + "Current nnmail news group directory.") + +(defconst nnmail-mbox-buffer "*nnmail mbox buffer*") + +(defvar nnmail-active-alist nil) + +(defvar nnmail-status-string "") + +;;; Interface functions + +(defun nnmail-retrieve-headers (sequence &optional newsgroup server) + "Retrieve the headers for the articles in SEQUENCE. +Newsgroup must be selected before calling this function." + (save-excursion + (set-buffer nntp-server-buffer) + (erase-buffer) + (let ((file nil) + (number (length sequence)) + (count 0) + beg article art-string start stop) + (nnmail-possibly-change-newsgroup newsgroup) + (while sequence + (setq article (car sequence)) + (setq art-string (nnmail-article-string article)) + (set-buffer nnmail-mbox-buffer) + (if (or (search-forward art-string nil t) + (progn (goto-char 1) + (search-forward art-string nil t))) + (progn + (setq start + (save-excursion + (re-search-backward + (concat "^" rmail-unix-mail-delimiter) nil t) + (point))) + (search-forward "\n\n" nil t) + (setq stop (1- (point))) + (set-buffer nntp-server-buffer) + (insert (format "221 %d Article retrieved.\n" article)) + (setq beg (point)) + (insert-buffer-substring nnmail-mbox-buffer start stop) + (goto-char (point-max)) + (insert ".\n"))) + (setq sequence (cdr sequence)) + (setq count (1+ count)) + (and (numberp nnmail-large-newsgroup) + (> number nnmail-large-newsgroup) + (zerop (% count 20)) + (message "NNMAIL: Receiving headers... %d%%" + (/ (* count 100) number)))) + + (and (numberp nnmail-large-newsgroup) + (> number nnmail-large-newsgroup) + (message "NNMAIL: Receiving headers... done")) + + ;; Fold continuation lines. + (goto-char 1) + (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t) + (replace-match " " t t)) + 'headers))) + +(defun nnmail-open-server (host &optional service) + "Open mbox backend." + (setq nnmail-status-string "") + (nnmail-open-server-internal host service)) + +(defun nnmail-close-server (&optional server) + "Close news server." + (nnmail-close-server-internal)) + +(fset 'nnmail-request-quit (symbol-function 'nnmail-close-server)) + +(defun nnmail-server-opened (&optional server) + "Return server process status, T or NIL. +If the stream is opened, return T, otherwise return NIL." + (and nntp-server-buffer + (get-buffer nntp-server-buffer))) + +(defun nnmail-status-message () + "Return server status response as string." + nnmail-status-string) + +(defun nnmail-request-article (article &optional newsgroup server buffer) + "Select ARTICLE by number." + (nnmail-possibly-change-newsgroup newsgroup) + (if (stringp article) + nil + (save-excursion + (set-buffer nnmail-mbox-buffer) + (goto-char 1) + (if (search-forward (nnmail-article-string article) nil t) + (let (start stop) + (re-search-backward (concat "^" rmail-unix-mail-delimiter) nil t) + (setq start (point)) + (forward-line 1) + (or (and (re-search-forward + (concat "^" rmail-unix-mail-delimiter) nil t) + (forward-line -1)) + (goto-char (point-max))) + (setq stop (point)) + (let ((nntp-server-buffer (or buffer nntp-server-buffer))) + (set-buffer nntp-server-buffer) + (erase-buffer) + (insert-buffer-substring nnmail-mbox-buffer start stop) + t)))))) + +(defun nnmail-request-group (group &optional server dont-check) + "Select news GROUP." + (if (nnmail-possibly-change-newsgroup group) + (if dont-check + t + (nnmail-get-new-mail) + (save-excursion + (set-buffer nntp-server-buffer) + (erase-buffer) + (let ((active (assoc group nnmail-active-alist))) + (insert (format "211 %d %d %d %s\n" + (1+ (- (cdr (car (cdr active))) + (car (car (cdr active))))) + (car (car (cdr active))) + (cdr (car (cdr active))) + (car active)))) + t)))) + +(defun nnmail-request-list (&optional server) + "List active newsgoups." + (nnmail-find-file nnmail-active-file)) + +(defun nnmail-request-list-newsgroups (&optional server) + "List newsgroups (defined in NNTP2)." + (setq nntp-status-string "NNMAIL: LIST NEWSGROUPS is not implemented.") + nil) + +(defun nnmail-request-post (&optional server) + "Post a new news in current buffer." + (mail-send-and-exit nil)) + +(defun nnmail-request-post-buffer (method header article-buffer group info) + (let ((method-address (nth 1 (nth 4 info))) + from subject date to reply-to message-of + references message-id sender follow-to) + (setq method-address + (if (and (stringp method-address) + (string= method-address "")) + nil method-address)) + (save-excursion + (set-buffer (get-buffer-create "*mail*")) + (mail-mode) + (local-set-key "\C-c\C-c" 'gnus-mail-send-and-exit) + (local-set-key "\C-c\C-y" 'gnus-mail-yank-original) + (if (and (buffer-modified-p) + (> (buffer-size) 0) + (not (y-or-n-p "Unsent mail being composed; erase it? "))) + () + (erase-buffer) + (if (eq method 'post) + (mail-setup method-address nil nil nil nil nil) + (save-excursion + (set-buffer article-buffer) + (goto-char (point-min)) + (narrow-to-region (point-min) + (progn (search-forward "\n\n") (point))) + (set-text-properties (point-min) (point-max) nil) + (if (and (boundp 'gnus-followup-to-function) + gnus-followup-to-function) + (setq follow-to (funcall gnus-followup-to-function group))) + (setq from (header-from header)) + (setq date (header-date header)) + (and from + (let ((stop-pos + (string-match " *at \\| *@ \\| *(\\| *<" from))) + (setq message-of + (concat (if stop-pos (substring from 0 stop-pos) from) + "'s message of " date)))) + (setq sender (mail-fetch-field "sender")) + (setq subject (header-subject header)) + (or (string-match "^[Rr][Ee]:" subject) + (setq subject (concat "Re: " subject))) + (setq reply-to (mail-fetch-field "reply-to")) + (setq references (header-references header)) + (setq message-id (header-id header)) + (widen)) + (setq news-reply-yank-from from) + (setq news-reply-yank-message-id message-id) + (mail-setup (or follow-to method-address sender reply-to from) + subject message-of nil article-buffer nil) + ;; Fold long references line to follow RFC1036. + (mail-position-on-field "References") + (let ((begin (- (point) (length "References: "))) + (fill-column 78) + (fill-prefix "\t")) + (if references (insert references)) + (if (and references message-id) (insert " ")) + (if message-id (insert message-id)) + ;; The region must end with a newline to fill the region + ;; without inserting extra newline. + (fill-region-as-paragraph begin (1+ (point)))) + )) + (current-buffer)))) + +(defun nnmail-request-expire-articles (articles newsgroup &optional server) + "Expire all articles in the ARTICLES list in group GROUP. +The list of unexpired articles will be returned (ie. all articles that +were too fresh to be expired)." + (nnmail-possibly-change-newsgroup newsgroup) + (let* ((days (or (and nnmail-expiry-wait-function + (funcall nnmail-expiry-wait-function newsgroup)) + nnmail-expiry-wait)) + (cur-time (current-time)) + (day-sec (* 24 60 60 days)) + (day-time (list nil nil)) + mod-time article rest) + (setcar day-time (/ day-sec 65536)) + (setcar (cdr day-time) (- day-sec (* (car day-time) 65536))) + (if (< (car (cdr cur-time)) (car (cdr day-time))) + (progn + (setcar day-time (+ 1 (- (car cur-time) (car day-time)))) + (setcar (cdr day-time) (- (+ 65536 (car (cdr cur-time))) + (car (cdr day-time))))) + (setcar day-time (- (car cur-time) (car day-time))) + (setcar (cdr day-time) (- (car (cdr cur-time)) (car (cdr day-time))))) + (save-excursion + (set-buffer nnmail-mbox-buffer) + (while articles + (goto-char 1) + (if (and (search-forward (nnmail-article-string (car articles)) nil t) + (setq mod-time (read (current-buffer))) + (or (< (car mod-time) (car day-time)) + (and (= (car mod-time) (car day-time)) + (< (car (cdr mod-time)) (car (cdr day-time)))))) + (progn + (message "Deleting: %s" article) + (nnmail-delete-mail)) + (setq rest (cons (car articles) rest))) + (setq articles (cdr articles))) + (save-buffer) + rest))) + +(defun nnmail-request-move-article (article group server accept-form) + (let ((buf (get-buffer-create " *nnmail move*")) + result) + (and + (nnmail-request-article article group server) + (save-excursion + (set-buffer buf) + (insert-buffer-substring nntp-server-buffer) + (goto-char (point-min)) + (if (re-search-forward + "^X-Gnus-Newsgroup:" + (save-excursion (search-forward "\n\n" nil t) (point)) t) + (delete-region (progn (beginning-of-line) (point)) + (progn (forward-line 1) (point)))) + (setq result (eval accept-form)) + (kill-buffer (current-buffer)) + result) + (save-excursion + (set-buffer nnmail-mbox-buffer) + (goto-char 1) + (if (search-forward (nnmail-article-string article) nil t) + (nnmail-delete-mail)) + (save-buffer))) + result)) + +(defun nnmail-request-accept-article (group) + (let ((buf (current-buffer)) + result beg) + (and + (nnmail-get-active) + (save-excursion + (set-buffer nnmail-mbox-buffer) + (setq beg (goto-char (point-max))) + (insert-buffer-substring buf) + (goto-char beg) + (if (stringp group) + (progn + (search-forward "\n\n" nil t) + (forward-line -1) + (setq result (nnmail-insert-newsgroup-line group beg (point)))) + (setq result (nnmail-choose-mail beg (point-max)))) + (save-buffer) + result) + (nnmail-save-active)) + (debug) + result)) + + +;;; Low-Level Interface + +(defun nnmail-delete-mail () + (re-search-backward (concat "^" rmail-unix-mail-delimiter) nil t) + (delete-region + (point) + (progn + (forward-line 1) + (or (and (re-search-forward + (concat "^" rmail-unix-mail-delimiter) nil t) + (forward-line -1) + (point)) + (point-max))))) + +(defun nnmail-open-server-internal (host &optional service) + "Open connection to news server on HOST by SERVICE (default is nntp)." + (save-excursion + (if (not (string-equal host (system-name))) + (error "NNMAIL: cannot talk to %s." host)) + ;; Initialize communication buffer. + (setq nntp-server-buffer (get-buffer-create " *nntpd*")) + (set-buffer nntp-server-buffer) + (buffer-disable-undo (current-buffer)) + (erase-buffer) + (kill-all-local-variables) + (setq case-fold-search t) ;Should ignore case. + t)) + +(defun nnmail-close-server-internal () + "Close connection to news server." + nil) + +(defun nnmail-find-file (file) + "Insert FILE in server buffer safely." + (save-excursion + (set-buffer nntp-server-buffer) + (erase-buffer) + (condition-case () + (progn (insert-file-contents file) t) + (file-error nil)))) + +(defun nnmail-possibly-change-newsgroup (newsgroup) + (if (not (get-buffer nnmail-mbox-buffer)) + (save-excursion + (set-buffer (setq nnmail-mbox-buffer + (find-file-noselect nnmail-mbox-file))) + (buffer-disable-undo (current-buffer)))) + (if (not nnmail-active-alist) + (nnmail-get-active)) + (if newsgroup + (if (assoc newsgroup nnmail-active-alist) + (setq nnmail-current-group newsgroup)))) + +;; Most of this function was taken from rmail.el +(defun nnmail-move-inbox () + (let ((inbox (expand-file-name nnmail-spool-file)) + tofile errors) + (setq tofile (make-temp-name + (expand-file-name (concat nnmail-mbox-file "-Incoming")))) + (unwind-protect + (save-excursion + (setq errors (generate-new-buffer " *nnmail loss*")) + (buffer-disable-undo errors) + (call-process + (expand-file-name "movemail" exec-directory) + nil errors nil inbox tofile) + (if (not (buffer-modified-p errors)) + ;; No output => movemail won + nil + (set-buffer errors) + (subst-char-in-region (point-min) (point-max) ?\n ?\ ) + (goto-char (point-max)) + (skip-chars-backward " \t") + (delete-region (point) (point-max)) + (goto-char (point-min)) + (if (looking-at "movemail: ") + (delete-region (point-min) (match-end 0))) + (error (concat "movemail: " + (buffer-substring (point-min) + (point-max))))))) + tofile)) + +(defun nnmail-article-string (article) + (concat "\nX-Gnus-Newsgroup: " nnmail-current-group ":" + (int-to-string article) " (")) + +(defun nnmail-choose-mail (beg end) + (let (result) + (save-excursion + (goto-char end) + (let ((methods nnmail-split-methods) + found) + (while (and (not found) methods) + (if (re-search-backward (car (cdr (car methods))) beg t) + (progn + (setq result (nnmail-insert-newsgroup-line + (car (car methods)) beg end)) + (setq found t)) + (setq methods (cdr methods)))) + (if (not found) + (setq result (nnmail-insert-newsgroup-line + (car (car nnmail-split-methods)) beg end))))) + result)) + +(defun nnmail-insert-newsgroup-line (group beg end) + (let ((active (car (cdr (assoc group nnmail-active-alist)))) + (time (current-time))) + (if (not active) + (progn + (setq nnmail-active-alist + (cons (list group (cons 1 0)) nnmail-active-alist)) + (setq active (car (cdr (car nnmail-active-alist)))))) + (setcdr active (1+ (cdr active))) + (insert (format "X-Gnus-Newsgroup: %s:%d (%d %d)\n" group (cdr active) + (car time) (car (cdr time)))) + (cons group (cdr active)))) + +(defun nnmail-split-region (beg end) + (goto-char beg) + (let ((delim (concat "^" rmail-unix-mail-delimiter)) + start stop) + (while (re-search-forward delim nil t) + (setq start (point)) + (search-forward "\n\n" nil t) + (save-excursion + (forward-char -1) + (if (not (save-excursion (re-search-backward "^Lines:" start t))) + (insert + (format "Lines: %d\n" + (count-lines + (point) + (or (re-search-forward rmail-unix-mail-delimiter nil t) + (point-max))))))) + (setq stop (1- (point))) + (if (not (search-backward "X-Gnus-Newsgroup: " start t)) + (nnmail-choose-mail start stop))))) + +(defun nnmail-read-mbox () + (if (and nnmail-mbox-buffer + (get-buffer nnmail-mbox-buffer) + (buffer-name nnmail-mbox-buffer) + (save-excursion + (set-buffer nnmail-mbox-buffer) + (= (buffer-size) (nth 7 (file-attributes nnmail-mbox-file))))) + () + (save-excursion + (set-buffer (setq nnmail-mbox-buffer + (find-file-noselect nnmail-mbox-file))) + (buffer-disable-undo (current-buffer)) + (nnmail-split-region (point-min) (point-max))))) + +(defun nnmail-split-incoming (incoming) + (save-excursion + (set-buffer nnmail-mbox-buffer) + (goto-char (point-max)) + (let ((start (point))) + (insert-file-contents incoming) + (nnmail-split-region start (point-max))))) + +(defun nnmail-get-active () + (let ((methods nnmail-split-methods)) + (setq nnmail-active-alist nil) + (if (nnmail-request-list) + (save-excursion + (set-buffer (get-buffer-create " *nntpd*")) + (goto-char 1) + (while (re-search-forward + "^\\([^ \t]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+\\)" nil t) + (setq nnmail-active-alist + (cons (list (buffer-substring (match-beginning 1) + (match-end 1)) + (cons (string-to-int + (buffer-substring (match-beginning 3) + (match-end 3))) + (string-to-int + (buffer-substring (match-beginning 2) + (match-end 2))))) + nnmail-active-alist))))) + (while methods + (if (not (assoc (car (car methods)) nnmail-active-alist)) + (setq nnmail-active-alist + (cons (list (car (car methods)) (cons 1 0)) + nnmail-active-alist))) + (setq methods (cdr methods))) + t)) + +(defun nnmail-save-active () + (let ((groups nnmail-active-alist) + group) + (save-excursion + (set-buffer (get-buffer-create " *nnmail*")) + (buffer-disable-undo (current-buffer)) + (erase-buffer) + (while groups + (setq group (car groups)) + (insert (format "%s %d %d y\n" (car group) (cdr (car (cdr group)) ) + (car (car (cdr group))))) + (setq groups (cdr groups))) + (write-region 1 (point-max) (expand-file-name nnmail-active-file) nil + 'nomesg) + (kill-buffer (current-buffer))))) + +(defun nnmail-get-new-mail () + (let (incoming) + (nnmail-get-active) + (nnmail-read-mbox) + (if (and (file-exists-p nnmail-spool-file) + (> (nth 7 (file-attributes nnmail-spool-file)) 0)) + (progn + (setq incoming (nnmail-move-inbox)) + (nnmail-split-incoming incoming) + (run-hooks 'nnmail-read-incoming-hook))) + (and (buffer-modified-p nnmail-mbox-buffer) + (save-excursion + (nnmail-save-active) + (set-buffer nnmail-mbox-buffer) + (save-buffer))) +; (if incoming +; (delete-file incoming)) + )) + +(provide 'nnmail) + +;;; nnmail.el ends here diff --git a/lisp/nnml.el b/lisp/nnml.el new file mode 100644 index 000000000..90caa4373 --- /dev/null +++ b/lisp/nnml.el @@ -0,0 +1,707 @@ +;;; nnml.el --- mail spool access for Gnus + +;; Copyright (C) 1994 Free Software Foundation, Inc. + +;; Author: Lars Ingebrigtsen +;; Masanobu UMEDA +;; Keywords: news + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to +;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +;;; Commentary: + +;; Based on nnspool.el by Masanobu UMEDA . + +;;; Code: + +(require 'nnheader) +(require 'rmail) +(require 'nnmail) + +(defvar nnml-directory "~/Mail/" + "*Mail directory.") + +(defvar nnml-active-file (concat nnml-directory "active") + "*Mail active file.") + +(defvar nnml-newsgroups-file (concat nnml-directory "newsgroups") + "*Mail newsgroups description file.") + +(defvar nnml-nov-is-evil nil + "If non-nil, Gnus will never generate and use nov databases for mail groups. +Using nov databases will speed up header fetching considerably. +This variable shouldn't be flipped much. If you have, for some reason, +set this to t, and want to set it to nil again, you should always run +the `nnml-generate-nov-databases' command. The function will go +through all nnml directories and generate nov databases for them +all. This may very well take some time.") + +(defvar nnml-large-newsgroup 50 + "*The number of the articles which indicates a large newsgroup. +If the number of the articles is greater than the value, verbose +messages will be shown to indicate the current status.") + + + +(defconst nnml-version "nnml 0.2" + "nnml version.") + +(defvar nnml-current-directory nil + "Current news group directory.") + +(defvar nnml-status-string "") + +(defvar nnml-nov-buffer-alist nil) + + + +;;; Interface functions. + +(defun nnml-retrieve-headers (sequence &optional newsgroup server) + "Retrieve the headers for the articles in SEQUENCE. +Newsgroup must be selected before calling this function." + (save-excursion + (set-buffer nntp-server-buffer) + (erase-buffer) + (let ((file nil) + (number (length sequence)) + (count 0) + beg article) + (nnml-possibly-change-directory newsgroup) + (if (nnml-retrieve-header-with-nov sequence) + 'nov + (while sequence + (setq article (car sequence)) + (setq file + (concat nnml-current-directory (prin1-to-string article))) + (if (and (file-exists-p file) + (not (file-directory-p file))) + (progn + (insert (format "221 %d Article retrieved.\n" article)) + (setq beg (point)) + (insert-file-contents file) + (goto-char beg) + (if (search-forward "\n\n" nil t) + (forward-char -1) + (goto-char (point-max)) + (insert "\n\n")) + (insert ".\n") + (delete-region (point) (point-max)))) + (setq sequence (cdr sequence)) + (setq count (1+ count)) + (and (numberp nnml-large-newsgroup) + (> number nnml-large-newsgroup) + (zerop (% count 20)) + (message "NNML: Receiving headers... %d%%" + (/ (* count 100) number)))) + + (and (numberp nnml-large-newsgroup) + (> number nnml-large-newsgroup) + (message "NNML: Receiving headers... done")) + + ;; Fold continuation lines. + (goto-char 1) + (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t) + (replace-match " " t t)) + 'headers)))) + +(defun nnml-open-server (host &optional service) + "Open news server on HOST. +If HOST is nil, use value of environment variable `NNTPSERVER'. +If optional argument SERVICE is non-nil, open by the service name." + (let ((host (or host (getenv "NNTPSERVER")))) + (setq nnml-status-string "") + (nnmail-open-server-internal host service))) + +(defun nnml-close-server (&optional server) + "Close news server." + (nnml-close-server-internal)) + +(fset 'nnml-request-quit (symbol-function 'nnml-close-server)) + +(defun nnml-server-opened (&optional server) + "Return server process status, T or NIL. +If the stream is opened, return T, otherwise return NIL." + (and nntp-server-buffer + (get-buffer nntp-server-buffer))) + +(defun nnml-status-message () + "Return server status response as string." + nnml-status-string) + +(defun nnml-request-article (id &optional newsgroup server buffer) + "Select article by message ID (or number)." + (nnml-possibly-change-directory newsgroup) + (let ((file (if (stringp id) + nil + (concat nnml-current-directory (prin1-to-string id)))) + (nntp-server-buffer (or buffer nntp-server-buffer))) + (if (and (stringp file) + (file-exists-p file) + (not (file-directory-p file))) + (save-excursion + (nnml-find-file file))))) + +(defun nnml-request-group (group &optional server dont-check) + "Select news GROUP." + (if (not dont-check) + (nnml-get-new-mail)) + (let ((pathname (nnml-article-pathname group)) + dir) + (if (file-directory-p pathname) + (progn + (setq nnml-current-directory pathname) + (if (not dont-check) + (progn + (setq dir + (sort + (mapcar + (function + (lambda (name) + (string-to-int name))) + (directory-files pathname nil "^[0-9]+$" t)) + '<)) + (save-excursion + (set-buffer nntp-server-buffer) + (erase-buffer) + (if dir + (insert (format "211 %d %d %d %s\n" (length dir) + (car dir) + (progn (while (cdr dir) + (setq dir (cdr dir))) + (car dir)) + group)) + (insert (format "211 0 1 0 %s\n" group)))))) + t)))) + +(defun nnml-request-list (&optional server) + "List active newsgoups." + (save-excursion + (nnml-find-file nnml-active-file))) + +(defun nnml-request-list-newsgroups (&optional server) + "List newsgroups (defined in NNTP2)." + (save-excursion + (nnml-find-file nnml-newsgroups-file))) + +(defun nnml-request-post (&optional server) + "Post a new news in current buffer." + (mail-send-and-exit nil)) + +(fset 'nnml-request-post-buffer 'nnmail-request-post-buffer) + +(defun nnml-request-expire-articles (articles newsgroup &optional server) + "Expire all articles in the ARTICLES list in group GROUP. +The list of unexpired articles will be returned (ie. all articles that +were too fresh to be expired)." + (nnml-possibly-change-directory newsgroup) + (let* ((days (or (and nnmail-expiry-wait-function + (funcall nnmail-expiry-wait-function newsgroup)) + nnmail-expiry-wait)) + (cur-time (current-time)) + (day-sec (* 24 60 60 days)) + (day-time (list nil nil)) + mod-time article rest) + (setcar day-time (/ day-sec 65536)) + (setcar (cdr day-time) (- day-sec (* (car day-time) 65536))) + (if (< (car (cdr cur-time)) (car (cdr day-time))) + (progn + (setcar day-time (+ 1 (- (car cur-time) (car day-time)))) + (setcar (cdr day-time) (- (+ 65536 (car (cdr cur-time))) + (car (cdr day-time))))) + (setcar day-time (- (car cur-time) (car day-time))) + (setcar (cdr day-time) (- (car (cdr cur-time)) (car (cdr day-time))))) + (while articles + (setq article (concat nnml-current-directory (int-to-string + (car articles)))) + (if (setq mod-time (nth 5 (file-attributes article))) + (if (or (< (car mod-time) (car day-time)) + (and (= (car mod-time) (car day-time)) + (< (car (cdr mod-time)) (car (cdr day-time))))) + (progn + (message "Deleting %s..." article) + (condition-case () + (delete-file article) + (file-error nil)) + (nnml-nov-delete-article newsgroup (car articles))) + (setq rest (cons (car articles) rest)))) + (setq articles (cdr articles))) + (nnml-save-nov) + rest)) + +(defun nnml-request-move-article (article group server accept-form) + (let ((buf (get-buffer-create " *nnml move*")) + result) + (and + (nnml-request-article article group server) + (save-excursion + (set-buffer buf) + (insert-buffer-substring nntp-server-buffer) + (setq result (eval accept-form)) + (kill-buffer (current-buffer)) + result) + (and (condition-case () + (delete-file (concat nnml-current-directory + (int-to-string article))) + (file-error nil)) + (nnml-nov-delete-article group article) + (nnml-save-nov))) + result)) + +(defun nnml-request-accept-article (group) + (let (result) + (if (stringp group) + (and + (nnml-get-active) + ;; We trick the choosing function into believing that only one + ;; group is availiable. + (let ((nnmail-split-methods '(group ""))) + (setq result + (cons group (nnml-choose-mail (point-min) (point-max))))) + (nnml-save-active)) + (and + (nnml-get-active) + (setq result (nnml-choose-mail (point-min) (point-max))) + (nnml-save-active))) + result)) + + +;;; Low-Level Interface + +(defun nnml-retrieve-header-with-nov (articles) + (if nnml-nov-is-evil + nil + (let ((first (car articles)) + (last (progn (while (cdr articles) (setq articles (cdr articles))) + (car articles))) + (nov (concat nnml-current-directory ".nov"))) + (if (file-exists-p nov) + (save-excursion + (set-buffer nntp-server-buffer) + (erase-buffer) + (insert-file-contents nov) + (goto-char 1) + (while (and (not (eobp)) (< first (read (current-buffer)))) + (forward-line 1)) + (beginning-of-line) + (if (not (eobp)) (delete-region 1 (point))) + (while (and (not (eobp)) (>= last (read (current-buffer)))) + (forward-line 1)) + (beginning-of-line) + (if (not (eobp)) (delete-region (point) (point-max))) + t))))) + +(defun nnml-open-server-internal (host &optional service) + "Open connection to news server on HOST by SERVICE." + (save-excursion + (if (not (string-equal host (system-name))) + (error "nnml: cannot talk to %s." host)) + ;; Initialize communication buffer. + (setq nntp-server-buffer (get-buffer-create " *nntpd*")) + (set-buffer nntp-server-buffer) + (buffer-disable-undo (current-buffer)) + (erase-buffer) + (kill-all-local-variables) + (setq case-fold-search t) ;Should ignore case. + t)) + +(defun nnml-close-server-internal () + "Close connection to news server." + nil) + +(defun nnml-find-file (file) + "Insert FILE in server buffer safely." + (set-buffer nntp-server-buffer) + (erase-buffer) + (condition-case () + (progn (insert-file-contents file) t) + (file-error nil))) + +(defun nnml-possibly-change-directory (newsgroup) + (if newsgroup + (let ((pathname (nnml-article-pathname newsgroup))) + (if (file-directory-p pathname) + (setq nnml-current-directory pathname) + (error "No such newsgroup: %s" newsgroup))))) + +(defun nnml-article-pathname (group) + "Make pathname for GROUP." + (concat (file-name-as-directory (expand-file-name nnml-directory)) + (nnml-replace-chars-in-string group ?. ?/) "/")) + +(defun nnml-replace-chars-in-string (string from to) + "Replace characters in STRING from FROM to TO." + (let ((string (substring string 0)) ;Copy string. + (len (length string)) + (idx 0)) + ;; Replace all occurrences of FROM with TO. + (while (< idx len) + (if (= (aref string idx) from) + (aset string idx to)) + (setq idx (1+ idx))) + string)) + +(defun nnml-create-directories () + (let ((methods nnmail-split-methods) + dir dirs) + (while methods + (setq dir (nnml-article-pathname (car (car methods)))) + (while (not (file-directory-p dir)) + (setq dirs (cons dir dirs)) + (setq dir (file-name-directory (directory-file-name dir)))) + (while dirs + (if (make-directory (directory-file-name (car dirs))) + (error "Could not create directory %s" (car dirs))) + (message "Creating mail directory %s" (car dirs)) + (setq dirs (cdr dirs))) + (setq methods (cdr methods))))) + +;; Most of this function was taken from rmail.el +(defun nnml-move-inbox () + (let ((inbox (expand-file-name nnmail-spool-file)) + tofile errors) + (setq tofile (make-temp-name + (expand-file-name (concat nnml-directory "Incoming")))) + (unwind-protect + (save-excursion + (setq errors (generate-new-buffer " *nnml loss*")) + (buffer-disable-undo errors) + (call-process + (expand-file-name "movemail" exec-directory) + nil errors nil inbox tofile) + (if (not (buffer-modified-p errors)) + ;; No output => movemail won + nil + (set-buffer errors) + (subst-char-in-region (point-min) (point-max) ?\n ?\ ) + (goto-char (point-max)) + (skip-chars-backward " \t") + (delete-region (point) (point-max)) + (goto-char (point-min)) + (if (looking-at "movemail: ") + (delete-region (point-min) (match-end 0))) + (error (concat "movemail: " + (buffer-substring (point-min) + (point-max))))))) + (if (buffer-name errors) + (kill-buffer errors)) + tofile)) + +(defvar nnml-newsgroups nil) + +(defun nnml-get-active () + (let ((methods nnmail-split-methods)) + (setq nnml-newsgroups nil) + (if (nnml-request-list) + (save-excursion + (set-buffer (get-buffer-create " *nntpd*")) + (goto-char 1) + (while (re-search-forward + "^\\([^ \t]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+\\)" nil t) + (setq nnml-newsgroups + (cons (list (buffer-substring (match-beginning 1) + (match-end 1)) + (cons (string-to-int + (buffer-substring (match-beginning 3) + (match-end 3))) + (string-to-int + (buffer-substring (match-beginning 2) + (match-end 2))))) + nnml-newsgroups))))) + (while methods + (if (not (assoc (car (car methods)) nnml-newsgroups)) + (setq nnml-newsgroups + (cons (list (car (car methods)) (cons 1 0)) + nnml-newsgroups))) + (setq methods (cdr methods))) + t)) + +(defun nnml-save-active () + (let ((groups nnml-newsgroups) + group) + (save-excursion + (set-buffer (get-buffer-create " *nnml*")) + (buffer-disable-undo (current-buffer)) + (erase-buffer) + (while groups + (setq group (car groups)) + (insert (format "%s %d %d y\n" (car group) (cdr (car (cdr group)) ) + (car (car (cdr group))))) + (setq groups (cdr groups))) + (write-region 1 (point-max) (expand-file-name nnml-active-file) nil + 'nomesg) + (kill-buffer (current-buffer))))) + +(defun nnml-split-incoming (incoming) + "Go through the entire INCOMING file and pick out each individual mail." + (let (start) + (nnml-get-active) + (save-excursion + (set-buffer (get-buffer-create "*(ding) Gnus mail*")) + (buffer-disable-undo (current-buffer)) + (erase-buffer) + (insert-file-contents incoming) + (goto-char 1) + ;; Go to the beginning of the first mail... + (if (and (re-search-forward (concat "^" rmail-unix-mail-delimiter) nil t) + (goto-char (match-beginning 0))) + ;; and then carry on until the bitter end. + (while (not (eobp)) + (setq start (point)) + (forward-line 1) + (if (re-search-forward + (concat "^" rmail-unix-mail-delimiter) nil t) + (goto-char (match-beginning 0)) + (goto-char (point-max))) + (nnml-choose-mail start (point)))) + (kill-buffer (current-buffer))))) + +;; Mail crossposts syggested by Brian Edmonds . +(defun nnml-article-group (beg end) + (let ((methods nnmail-split-methods) + found group-art) + (save-excursion + (save-restriction + (narrow-to-region beg end) + (while methods + (goto-char (point-max)) + (if (or (cdr methods) + (not (string= "" (nth 1 (car methods))))) + (if (re-search-backward (car (cdr (car methods))) nil t) + (setq group-art + (cons + (cons (car (car methods)) + (nnml-active-number (car (car methods)))) + group-art))) + (or group-art + (setq group-art + (list (cons (car (car methods)) + (nnml-active-number (car (car methods)))))))) + (setq methods (cdr methods))) + group-art)))) + +(defun nnml-choose-mail (beg end) + "Find out what mail group the mail between BEG and END belongs in." + (let ((group-art (nreverse (nnml-article-group beg end))) + chars nov-line lines) + (save-excursion + (save-restriction + (narrow-to-region beg end) + ;; First fix headers. + (goto-char (point-min)) + (save-excursion + (save-restriction + (narrow-to-region (point) + (progn (search-forward "\n\n" nil t) + (setq chars (- (point-max) (point))) + (setq lines (- (count-lines + (point) (point-max)) 1)) + (1- (point)))) + ;; Insert Lines. + (if (not (save-excursion (re-search-backward "^Lines:" beg t))) + (insert (format "Lines: %d\n" lines))) + ;; Make an Xref header. + (save-excursion + (goto-char (point-max)) + (if (re-search-backward "^Xref:" nil t) + (delete-region (match-beginning 0) + (progn (forward-line 1) (point))))) + (insert (format "Xref: %s" (system-name))) + (let ((ga group-art)) + (while ga + (insert (format " %s:%d" (car (car ga)) (cdr (car ga)))) + (setq ga (cdr ga)))) + (insert "\n") + ;; Generate a nov line for this article. + (setq nov-line (nnml-make-nov-line chars)))) + ;; Then we actually save the article. + (let ((ga group-art) + first) + (while ga + (nnml-add-nov (car (car ga)) (cdr (car ga)) nov-line) + (let ((file (concat (nnml-article-pathname + (car (car ga))) + (int-to-string (cdr (car ga)))))) + (if first + ;; It was already saved, so we just make a hard link. + (add-name-to-file first file t) + ;; Save the article. + (write-region (point-min) (point-max) file nil nil) + (setq first file))) + (setq ga (cdr ga)))) + group-art)))) + +(defun nnml-active-number (group) + "Compute the next article number in GROUP." + (let ((active (car (cdr (assoc group nnml-newsgroups))))) + (setcdr active (1+ (cdr active))) + (let (file) + (while (file-exists-p + (setq file (concat (nnml-article-pathname group) + (int-to-string (cdr active))))) + (setcdr active (1+ (cdr active))))) + (cdr active))) + +(defun nnml-get-new-mail () + "Read new incoming mail." + (let (incoming) + (nnml-create-directories) + (if (and (file-exists-p nnmail-spool-file) + (> (nth 7 (file-attributes nnmail-spool-file)) 0)) + (progn + (message "nnml: Reading incoming mail...") + (setq incoming (nnml-move-inbox)) + (nnml-split-incoming incoming) + (nnml-save-active) + (nnml-save-nov) +;; (delete-file incoming) + (message "nnml: Reading incoming mail...done"))))) + + +(defun nnml-add-nov (group article line) + "Add a nov line for the GROUP base." + (save-excursion + (set-buffer (nnml-open-nov group)) + (goto-char (point-max)) + (insert (int-to-string article) line))) + +(defsubst nnml-header-value () + (buffer-substring (match-end 0) (save-excursion (end-of-line) (point)))) + +(defun nnml-make-nov-line (chars) + "Create a nov from the current headers." + (let (subject from date id references lines xref in-reply-to char) + ;; [number subject from date id references chars lines xref] + (save-excursion + (goto-char (point-min)) + (while (re-search-forward "^\\(from\\|subject\\|message-id\\|date\\|lines\\|xref\\|references\\|in-reply-to\\): " + nil t) + (beginning-of-line) + (setq char (downcase (following-char))) + (cond + ((eq char ?s) + (setq subject (nnml-header-value))) + ((eq char ?f) + (setq from (nnml-header-value))) + ((eq char ?x) + (setq xref (nnml-header-value))) + ((eq char ?l) + (setq lines (nnml-header-value))) + ((eq char ?d) + (setq date (nnml-header-value))) + ((eq char ?m) + (setq id (setq id (nnml-header-value)))) + ((eq char ?r) + (setq references (nnml-header-value))) + ((eq char ?i) + (setq in-reply-to (nnml-header-value)))) + (forward-line 1)) + + (and (not references) + in-reply-to + (string-match "<[^>]+>" in-reply-to) + (setq references + (substring in-reply-to (match-beginning 0) + (match-end 0))))) + ;; [number subject from date id references chars lines xref] + (format "\t%s\t%s\t%s\t%s\t%s\t%d\t%s\t%s\n" + (or subject "(none)") + (or from "(nobody)") (or date "") + (or id "") (or references "") + chars (or lines "0") (or xref "")))) + +(defun nnml-open-nov (group) + (or (cdr (assoc group nnml-nov-buffer-alist)) + (let ((buffer (find-file-noselect + (concat (nnml-article-pathname group) ".nov")))) + (save-excursion + (set-buffer buffer) + (buffer-disable-undo (current-buffer))) + (setq nnml-nov-buffer-alist (cons (cons group buffer) + nnml-nov-buffer-alist)) + buffer))) + +(defun nnml-save-nov () + (save-excursion + (while nnml-nov-buffer-alist + (if (buffer-name (cdr (car nnml-nov-buffer-alist))) + (progn + (set-buffer (cdr (car nnml-nov-buffer-alist))) + (write-region 1 (point-max) (buffer-file-name) nil 'nomesg) + (set-buffer-modified-p nil) + (kill-buffer (current-buffer)))) + (setq nnml-nov-buffer-alist (cdr nnml-nov-buffer-alist))))) + +(defun nnml-generate-nov-databases (dir) + (interactive (list nnml-directory)) + (let ((dirs (directory-files dir t nil t))) + (while dirs + (if (and (not (string-match "/\\.\\.$" (car dirs))) + (not (string-match "/\\.$" (car dirs))) + (file-directory-p (car dirs))) + (nnml-generate-nov-databases (car dirs))) + (setq dirs (cdr dirs)))) + (let ((files (sort + (mapcar + (function + (lambda (name) + (string-to-int name))) + (directory-files dir nil "^[0-9]+$" t)) + (function <))) + (nov (concat dir "/.nov")) + (nov-buffer (get-buffer-create "*nov*")) + nov-line chars) + (if files + (save-excursion + (set-buffer nntp-server-buffer) + (if (file-exists-p nov) + (delete-file nov)) + (save-excursion + (set-buffer nov-buffer) + (buffer-disable-undo (current-buffer)) + (erase-buffer)) + (while files + (erase-buffer) + (insert-file-contents (concat dir "/" (int-to-string (car files)))) + (goto-char 1) + (narrow-to-region 1 (save-excursion (search-forward "\n\n" nil t) + (setq chars (- (point-max) + (point))) + (point))) + (setq nov-line (nnml-make-nov-line chars)) + (save-excursion + (set-buffer nov-buffer) + (goto-char (point-max)) + (insert (int-to-string (car files)) nov-line)) + (widen) + (setq files (cdr files))) + (save-excursion + (set-buffer nov-buffer) + (write-region 1 (point-max) (expand-file-name nov) nil + 'nomesg) + (kill-buffer (current-buffer))))))) + +(defun nnml-nov-delete-article (group article) + (save-excursion + (set-buffer (nnml-open-nov group)) + (goto-char 1) + (if (re-search-forward (concat "^" (int-to-string article) "\t")) + (delete-region (match-beginning 0) (progn (forward-line 1) (point)))))) + +(provide 'nnml) + +;;; nnml.el ends here diff --git a/lisp/nnspool.el b/lisp/nnspool.el new file mode 100644 index 000000000..500bcb9af --- /dev/null +++ b/lisp/nnspool.el @@ -0,0 +1,387 @@ +;;; nnspool.el --- spool access using NNTP for GNU Emacs + +;; Copyright (C) 1988, 1989, 1990, 1993, 1994 Free Software Foundation, Inc. + +;; Author: Masanobu UMEDA +;; Lars Ingebrigtsen +;; Keywords: news + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to +;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +;;; Commentary: + +;; All the Gnus backends have the same interface, and should return +;; data in a similar format. Below is and overview of what functions +;; these packages must supply and what result they should return. +;; +;; Variables: +;; +;; `nntp-server-buffer' - All data should be returned to Gnus in this +;; buffer. +;; +;; Functions for the imaginary backend `choke': +;; +;; `choke-retrieve-headers ARTICLES &optional GROUP SERVER' +;; Should return all headers for all ARTICLES, or return NOV lines for +;; the same. +;; +;; `choke-request-group GROUP &optional SERVER DISCARD' +;; Switch to GROUP. If DISCARD is nil, active information on the group +;; must be returned. +;; +;; `choke-request-article ARTICLE &optional GROUP SERVER' +;; Return ARTICLE, which is either an article number or id. +;; +;; `choke-request-list SERVER' +;; Return a list of all active newsgroups on SERVER. +;; +;; `choke-request-list-newsgroups SERVER' +;; Return a list of descriptions of all newsgroups on SERVER. +;; +;; `choke-request-post-buffer METHOD HEADER ARTICLE-BUFFER GROUP INFO' +;; Should return a buffer that is suitable for "posting". nnspool and +;; nntp return a `*post-buffer*', and nnmail return a `*mail*' +;; buffer. This function should fill out the appropriate header +;; fields. +;; +;; `choke-request-post &optional SERVER' +;; Function that will be called from a buffer to be posted. +;; +;; `choke-open-server SERVER &optional ARGUMENT' +;; Open a connection to SERVER. +;; +;; `choke-close-server &optional SERVER' +;; Close the connection to server. +;; +;; `choke-server-opened &optional SERVER' +;; Whether the server is opened or not. +;; +;; `choke-server-status &optional SERVER' +;; Should return a status string (not in nntp buffer, but as the +;; result of the function). +;; +;; `choke-request-expire-articles ARTICLES &optional NEWSGROUP SERVER' +;; Should expire (according to some aging scheme) all ARTICLES. Most +;; backends will not be able to expire articles. Should return a list +;; of all articles that were not expired. +;; +;; All these functions must return nil if they couldn't service the +;; request. If the optional arguments are not supplied, some "current" +;; or "default" values should be used. In short, one should emulate an +;; NNTP server, in a way. All results should be returned in the NNTP +;; format. (See RFC977). + +;;; Code: + +(require 'nnheader) +(require 'nntp) + +(defvar nnspool-inews-program news-inews-program + "*Program to post news.") + +(defvar nnspool-inews-switches '("-h") + "*Switches for nnspool-request-post to pass to `inews' for posting news.") + +(defvar nnspool-spool-directory news-path + "*Local news spool directory.") + +(defvar nnspool-active-file "/usr/lib/news/active" + "*Local news active file.") + +(defvar nnspool-newsgroups-file "/usr/lib/news/newsgroups" + "*Local news newsgroups file.") + +(defvar nnspool-distributions-file "/usr/lib/news/distributions" + "*Local news distributions file.") + +(defvar nnspool-history-file "/usr/lib/news/history" + "*Local news history file.") + +(defvar nnspool-large-newsgroup 50 + "*The number of the articles which indicates a large newsgroup. +If the number of the articles is greater than the value, verbose +messages will be shown to indicate the current status.") + + + +(defconst nnspool-version "nnspool 2.0" + "Version numbers of this version of NNSPOOL.") + +(defvar nnspool-current-directory nil + "Current news group directory.") + +(defvar nnspool-status-string "") + + + +;;; Interface functions. + +(defun nnspool-retrieve-headers (sequence &optional newsgroup server) + "Retrieve the headers for the articles in SEQUENCE. +Newsgroup must be selected before calling this function." + (save-excursion + (set-buffer nntp-server-buffer) + (erase-buffer) + (let* ((number (length sequence)) + (count 0) + (do-message (and (numberp nnspool-large-newsgroup) + (> number nnspool-large-newsgroup))) + file beg article) + (nnspool-possibly-change-directory newsgroup) + (while sequence + (setq article (car sequence)) + (setq file + (concat nnspool-current-directory (prin1-to-string article))) + (if (file-exists-p file) + (progn + (insert (format "221 %d Article retrieved.\n" article)) + (setq beg (point)) + (insert-file-contents file) + (goto-char beg) + (search-forward "\n\n" nil t) + (forward-char -1) + (insert ".\n") + (delete-region (point) (point-max)))) + (setq sequence (cdr sequence)) + + (and do-message + (zerop (% (setq count (1+ count)) 20)) + (message "NNSPOOL: Receiving headers... %d%%" + (/ (* count 100) number)))) + + (if do-message (message "NNSPOOL: Receiving headers... done")) + + ;; Fold continuation lines. + (goto-char 1) + (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t) + (replace-match " " t t)) + 'headers))) + +(defun nnspool-open-server (host &optional service) + "Open local spool." + (setq nnspool-status-string "") + (cond ((and (file-directory-p nnspool-spool-directory) + (file-exists-p nnspool-active-file)) + (nnspool-open-server-internal host service)) + (t + (setq nnspool-status-string + (format "NNSPOOL: cannot talk to %s." host)) + nil))) + +(defun nnspool-close-server (&optional server) + "Close news server." + (nnspool-close-server-internal)) + +(fset 'nnspool-request-quit (symbol-function 'nnspool-close-server)) + +(defun nnspool-server-opened (&optional server) + "Return server process status, T or NIL. +If the stream is opened, return T, otherwise return NIL." + (and nntp-server-buffer + (get-buffer nntp-server-buffer))) + +(defun nnspool-status-message () + "Return server status response as string." + nnspool-status-string) + +(defun nnspool-request-article (id &optional newsgroup server buffer) + "Select article by message ID (or number)." + (nnspool-possibly-change-directory newsgroup) + (let ((file (if (stringp id) + (nnspool-find-article-by-message-id id) + (concat nnspool-current-directory (prin1-to-string id)))) + (nntp-server-buffer (or buffer nntp-server-buffer))) + (if (and (stringp file) + (file-exists-p file) + (not (file-directory-p file))) + (save-excursion + (nnspool-find-file file))))) + +(defun nnspool-request-body (id &optional newsgroup server) + "Select article body by message ID (or number)." + (nnspool-possibly-change-directory newsgroup) + (if (nnspool-request-article id) + (save-excursion + (set-buffer nntp-server-buffer) + (goto-char (point-min)) + (if (search-forward "\n\n" nil t) + (delete-region (point-min) (point))) + t))) + +(defun nnspool-request-head (id &optional newsgroup server) + "Select article head by message ID (or number)." + (nnspool-possibly-change-directory newsgroup) + (if (nnspool-request-article id) + (save-excursion + (set-buffer nntp-server-buffer) + (goto-char (point-min)) + (if (search-forward "\n\n" nil t) + (delete-region (1- (point)) (point-max))) + t))) + +(defun nnspool-request-group (group &optional server dont-check) + "Select news GROUP." + (let ((pathname (nnspool-article-pathname + (nnspool-replace-chars-in-string group ?. ?/))) + dir) + (if (file-directory-p pathname) + (progn + (setq nnspool-current-directory pathname) + (if (not dont-check) + (progn + (setq dir (directory-files pathname nil "^[0-9]+$" t)) + ;; yes, completely empty spool directories *are* possible + ;; Fix by Sudish Joseph + (and dir + (setq dir + (sort + (mapcar + (function + (lambda (name) + (string-to-int name))) + dir) + '<))) + (save-excursion + (set-buffer nntp-server-buffer) + (erase-buffer) + (if dir + (insert + (format "211 %d %d %d %s\n" (length dir) (car dir) + (progn (while (cdr dir) (setq dir (cdr dir))) + (car dir)) + group)) + (insert (format "211 0 0 0 %s\n" group)))))) + t)))) + +(defun nnspool-request-list (&optional server) + "List active newsgoups." + (save-excursion + (nnspool-find-file nnspool-active-file))) + +(defun nnspool-request-list-newsgroups (&optional server) + "List newsgroups (defined in NNTP2)." + (save-excursion + (nnspool-find-file nnspool-newsgroups-file))) + +(defun nnspool-request-list-distributions (&optional server) + "List distributions (defined in NNTP2)." + (save-excursion + (nnspool-find-file nnspool-distributions-file))) + +(defun nnspool-request-post (&optional server) + "Post a new news in current buffer." + (save-excursion + ;; We have to work in the server buffer because of NEmacs hack. + (copy-to-buffer nntp-server-buffer (point-min) (point-max)) + (set-buffer nntp-server-buffer) + (apply (function call-process-region) + (point-min) (point-max) + nnspool-inews-program 'delete t nil nnspool-inews-switches) + (prog1 + (or (zerop (buffer-size)) + ;; If inews returns strings, it must be error message + ;; unless SPOOLNEWS is defined. + ;; This condition is very weak, but there is no good rule + ;; identifying errors when SPOOLNEWS is defined. + ;; Suggested by ohm@kaba.junet. + (string-match "spooled" (buffer-string))) + ;; Make status message by unfolding lines. + (subst-char-in-region (point-min) (point-max) ?\n ?\\ 'noundo) + (setq nnspool-status-string (buffer-string)) + (erase-buffer)))) + +(fset 'nnspool-request-post-buffer 'nntp-request-post-buffer) + + +;;; Low-Level Interface. + +(defun nnspool-open-server-internal (host &optional service) + "Open connection to news server on HOST by SERVICE (default is nntp)." + (save-excursion + (if (not (string-equal host (system-name))) + (error "NNSPOOL: cannot talk to %s." host)) + ;; Initialize communication buffer. + (setq nntp-server-buffer (get-buffer-create " *nntpd*")) + (set-buffer nntp-server-buffer) + (buffer-disable-undo (current-buffer)) + (erase-buffer) + (kill-all-local-variables) + (setq case-fold-search t) ;Should ignore case. + t)) + +(defun nnspool-close-server-internal () + "Close connection to news server." + (if (get-file-buffer nnspool-history-file) + (kill-buffer (get-file-buffer nnspool-history-file)))) + +(defun nnspool-find-article-by-message-id (id) + "Return full pathname of an article identified by message-ID." + (save-excursion + (let ((buffer (get-file-buffer nnspool-history-file))) + (if buffer + (set-buffer buffer) + ;; Finding history file may take lots of time. + (message "Reading history file...") + (set-buffer (find-file-noselect nnspool-history-file)) + (message "Reading history file... done"))) + ;; Search from end of the file. I think this is much faster than + ;; do from the beginning of the file. + (goto-char (point-max)) + (if (re-search-backward + (concat "^" (regexp-quote id) + "[ \t].*[ \t]\\([^ \t/]+\\)/\\([0-9]+\\)[ \t]*$") nil t) + (let ((group (buffer-substring (match-beginning 1) (match-end 1))) + (number (buffer-substring (match-beginning 2) (match-end 2)))) + (concat (nnspool-article-pathname + (nnspool-replace-chars-in-string group ?. ?/)) + number))))) + +(defun nnspool-find-file (file) + "Insert FILE in server buffer safely." + (set-buffer nntp-server-buffer) + (erase-buffer) + (condition-case () + (progn (insert-file-contents file) t) + (file-error nil))) + +(defun nnspool-possibly-change-directory (newsgroup) + (if newsgroup + (let ((pathname (nnspool-article-pathname + (nnspool-replace-chars-in-string newsgroup ?. ?/)))) + (if (file-directory-p pathname) + (setq nnspool-current-directory pathname) + (error "No such newsgroup: %s" newsgroup))))) + +(defun nnspool-article-pathname (group) + "Make pathname for GROUP." + (concat (file-name-as-directory nnspool-spool-directory) group "/")) + +(defun nnspool-replace-chars-in-string (string from to) + "Replace characters in STRING from FROM to TO." + (let ((string (substring string 0)) ;Copy string. + (len (length string)) + (idx 0)) + ;; Replace all occurrences of FROM with TO. + (while (< idx len) + (if (= (aref string idx) from) + (aset string idx to)) + (setq idx (1+ idx))) + string)) + +(provide 'nnspool) + +;;; nnspool.el ends here diff --git a/lisp/nntp.el b/lisp/nntp.el new file mode 100644 index 000000000..7f9dc211c --- /dev/null +++ b/lisp/nntp.el @@ -0,0 +1,762 @@ +;;; nntp.el --- NNTP (RFC977) Interface for GNU Emacs +;; Copyright (C) 1987, 1988, 1989, 1990, 1992, 1993, 1994 Free Software Foundation, Inc. + +;; Author: Masanobu UMEDA +;; Lars Ingebrigtsen +;; Keywords: news + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to +;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +;;; Commentary: + +;;; Code: + +(require 'rnews) +(require 'nnheader) + +(eval-and-compile + (autoload 'news-setup "rnewspost") + (autoload 'news-reply-mode "rnewspost")) + +(defvar nntp-server-hook nil + "*Hooks for the NNTP server. +If the kanji code of the NNTP server is different from the local kanji +code, the correct kanji code of the buffer associated with the NNTP +server must be specified as follows: + +\(setq nntp-server-hook + (function + (lambda () + ;; Server's Kanji code is EUC (NEmacs hack). + (make-local-variable 'kanji-fileio-code) + (setq kanji-fileio-code 0)))) + +If you'd like to change something depending on the server in this +hook, use the variable `nntp-server-name'.") + +(defvar nntp-server-opened-hook nil + "You can send commands at startup like AUTHINFO with this hook.") + +(defvar nntp-large-newsgroup 50 + "*The number of the articles which indicates a large newsgroup. +If the number of the articles is greater than the value, verbose +messages will be shown to indicate the current status.") + +(defvar nntp-buggy-select (memq system-type '(usg-unix-v fujitsu-uts)) + "*T if your select routine is buggy. +If the select routine signals error or fall into infinite loop while +waiting for the server response, the variable must be set to t. In +case of Fujitsu UTS, it is set to T since `accept-process-output' +doesn't work properly.") + +(defvar nntp-maximum-request 1 + "*The maximum number of the requests sent to the NNTP server at one time. +If Emacs hangs up while retrieving headers, set the variable to a +lower value.") + +(defvar nntp-debug-read 10000 + "*Display '...' every 10Kbytes of a message being received if it is non-nil. +If it is a number, dots are displayed per the number.") + +(defvar nntp-xover-is-evil nil + "*If non-nil, nntp will never attempt to use XOVER when talking to the server.") + +(defvar nntp-build-old-threads nil + "*Non-nil means that Gnus will try to build threads by grabbing old headers. +If an unread article in the group refers to an older, already read (or +just marked as read) article, the old article will not normally be +displayed in the Summary buffer. If this variable is non-nil, Gnus +will attempt to grab the headers to the old articles, and thereby +build complete threads. `nntp-xover-is-evil' has to be nil if this is +to work.") + +(defvar nntp-xover-commands '("XOVER" "XOVERVIEW") + "List of strings that are used as commands to fetch NOV lines from a server. +The strings are tried in turn until a positive response is gotten. If +none of the commands are successful, nntp will just grab headers one +by one.") + + +(defconst nntp-version "nntp 4.0" + "Version numbers of this version of NNTP.") + +(defvar nntp-server-name nil + "The name of the host running NNTP server.") + +(defvar nntp-server-buffer nil + "Buffer associated with NNTP server process.") + +(defvar nntp-server-process nil + "The NNTP server process. +You'd better not use this variable in NNTP front-end program but +instead use `nntp-server-buffer'.") + +(defvar nntp-status-string nil + "Save the server response message. +You'd better not use this variable in NNTP front-end program but +instead call function `nntp-status-message' to get status message.") + +(defvar nntp-current-server "") + +(defvar nntp-server-alist nil) + +(defvar nntp-server-xover t) + +(defvar nntp-current-group "") + +;;; Interface funtions. + +(defun nntp-retrieve-headers (sequence &optional newsgroup server) + "Retrieve the headers to the articles in SEQUENCE." + (nntp-possibly-change-server newsgroup server) + (save-excursion + (set-buffer nntp-server-buffer) + (erase-buffer) + (if (and (not nntp-xover-is-evil) + (nntp-retrieve-headers-with-xover sequence)) + 'nov + (let ((number (length sequence)) + (count 0) + (received 0) + (last-point (point-min))) + ;; Send HEAD command. + (while sequence + (nntp-send-strings-to-server "HEAD" (car sequence)) + (setq sequence (cdr sequence)) + (setq count (1+ count)) + ;; Every 400 header requests we have to read stream in order + ;; to avoid deadlock. + (if (or (null sequence) ;All requests have been sent. + (zerop (% count nntp-maximum-request))) + (progn + (accept-process-output) + (while (progn + (goto-char last-point) + ;; Count replies. + (while (re-search-forward "^[0-9]" nil t) + (setq received (1+ received))) + (setq last-point (point)) + (< received count)) + ;; If number of headers is greater than 100, give + ;; informative messages. + (and (numberp nntp-large-newsgroup) + (> number nntp-large-newsgroup) + (zerop (% received 20)) + (message "NNTP: Receiving headers... %d%%" + (/ (* received 100) number))) + (nntp-accept-response)) + )) + ) + ;; Wait for text of last command. + (goto-char (point-max)) + (re-search-backward "^[0-9]" nil t) + (if (looking-at "^[23]") + (while (progn + (goto-char (- (point-max) 3)) + (not (looking-at "^\\.\r$"))) + (nntp-accept-response))) + (and (numberp nntp-large-newsgroup) + (> number nntp-large-newsgroup) + (message "NNTP: Receiving headers... done")) + ;; Now all of replies are received. + (setq received number) + ;; First, fold continuation lines. + (goto-char (point-min)) + (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t) + (replace-match " " t t)) + ;; Remove all "\r"'s + (goto-char (point-min)) + (while (re-search-forward "\r" nil t) + (replace-match "" t t)) + 'headers)))) + +(defun nntp-open-server (server &optional service) + "Open news server on SERVER. +If SERVER is nil, use value of environment variable `NNTPSERVER'. +If optional argument SERVICE is non-nil, open by the service name." + (let ((server (or server (getenv "NNTPSERVER"))) + (status nil)) + (setq nntp-status-string "") + (message "nntp: Connecting to server on %s..." server) + (cond ((and server (nntp-open-server-internal server service)) + (setq nntp-current-server server) + (setq status (nntp-wait-for-response "^[23].*\r$")) + ;; Do check unexpected close of connection. + ;; Suggested by feldmark@hanako.stars.flab.fujitsu.junet. + (if status + (progn + (set-process-sentinel nntp-server-process + 'nntp-default-sentinel) + ;; You can send commands at startup like AUTHINFO here. + ;; Added by Hallvard B Furuseth + (run-hooks 'nntp-server-opened-hook)) + ;; We have to close connection here, since function + ;; `nntp-server-opened' may return incorrect status. + (nntp-close-server-internal server) + )) + ((null server) + (setq nntp-status-string "NNTP server is not specified.")) + ) + (message "") + status + )) + +(defun nntp-close-server (&optional server) + "Close news server." + (nntp-possibly-change-server nil server) + (unwind-protect + (progn + ;; Un-set default sentinel function before closing connection. + (and nntp-server-process + (eq 'nntp-default-sentinel + (process-sentinel nntp-server-process)) + (set-process-sentinel nntp-server-process nil)) + ;; We cannot send QUIT command unless the process is running. + (if (nntp-server-opened) + (nntp-send-command nil "QUIT")) + ) + (nntp-close-server-internal server) + )) + +(fset 'nntp-request-quit (symbol-function 'nntp-close-server)) + +(defun nntp-server-opened (&optional server) + "Return server process status. +If the stream is opened, return non-nil, otherwise return nil." + (if (or server nntp-current-server) + (let ((process (nth 1 (assoc (or server nntp-current-server) + nntp-server-alist)))) + (and process + (memq (process-status process) '(open run)))))) + +(defun nntp-status-message (&optional server) + "Return server status response as string." + (if (and nntp-status-string + ;; NNN MESSAGE + (string-match "[0-9][0-9][0-9][ \t]+\\([^\r]*\\).*$" + nntp-status-string)) + (substring nntp-status-string (match-beginning 1) (match-end 1)) + ;; Empty message if nothing. + "" + )) + +(defun nntp-request-article (id &optional newsgroup server buffer) + "Select article by message ID (or number)." + (nntp-possibly-change-server newsgroup server) + (if buffer (set-process-buffer nntp-server-process (current-buffer))) + (prog1 + (let ((nntp-server-buffer (or buffer nntp-server-buffer))) + ;; If NEmacs, end of message may look like: "\256\215" (".^M") + (prog1 + (nntp-send-command "^\\.\r$" "ARTICLE" id) + (nntp-decode-text))) + (if buffer (set-process-buffer nntp-server-process nntp-server-buffer)))) + +(defun nntp-request-body (id &optional newsgroup server) + "Select article body by message ID (or number)." + (nntp-possibly-change-server newsgroup server) + (prog1 + ;; If NEmacs, end of message may look like: "\256\215" (".^M") + (nntp-send-command "^\\.\r$" "BODY" id) + (nntp-decode-text) + )) + +(defun nntp-request-head (id &optional newsgroup server) + "Select article head by message ID (or number)." + (nntp-possibly-change-server newsgroup server) + (prog1 + (nntp-send-command "^\\.\r$" "HEAD" id) + (nntp-decode-text) + )) + +(defun nntp-request-stat (id &optional newsgroup server) + "Select article by message ID (or number)." + (nntp-possibly-change-server newsgroup server) + (nntp-send-command "^[23].*\r$" "STAT" id)) + +(defun nntp-request-group (group &optional server dont-check) + "Select news GROUP." + (if (nntp-possibly-change-server nil server) + (progn + (nntp-send-command "^.*\r$" "GROUP" group) + ))) + +(defun nntp-request-list (&optional server) + "List active newsgroups." + (nntp-possibly-change-server nil server) + (prog1 + (nntp-send-command "^\\.\r$" "LIST") + (nntp-decode-text) + )) + +(defun nntp-request-list-newsgroups (&optional server) + "List newsgroups (defined in NNTP2)." + (nntp-possibly-change-server nil server) + (prog1 + (nntp-send-command "^\\.\r$" "LIST NEWSGROUPS") + (nntp-decode-text) + )) + +(defun nntp-request-list-distributions (&optional server) + "List distributions (defined in NNTP2)." + (nntp-possibly-change-server nil server) + (prog1 + (nntp-send-command "^\\.\r$" "LIST DISTRIBUTIONS") + (nntp-decode-text) + )) + +(defun nntp-request-last (&optional newsgroup server) + "Set current article pointer to the previous article +in the current news group." + (nntp-possibly-change-server newsgroup server) + (nntp-send-command "^[23].*\r$" "LAST")) + +(defun nntp-request-next (&optional newsgroup server) + "Advance current article pointer." + (nntp-possibly-change-server newsgroup server) + (nntp-send-command "^[23].*\r$" "NEXT")) + +(defun nntp-request-post (&optional server) + "Post a new news in current buffer." + (nntp-possibly-change-server nil server) + (if (nntp-send-command "^[23].*\r$" "POST") + (progn + (nntp-encode-text) + (nntp-send-region-to-server (point-min) (point-max)) + ;; 1.2a NNTP's post command is buggy. "^M" (\r) is not + ;; appended to end of the status message. + (nntp-wait-for-response "^[23].*$") + ))) + +(defun nntp-request-post-buffer (method header article-buffer group info) + (let (from subject date to followup-to newsgroups message-of + references distribution message-id follow-to) + (save-excursion + (set-buffer (get-buffer-create "*post-news*")) + (news-reply-mode) + (if (and (buffer-modified-p) + (> (buffer-size) 0) + (not (y-or-n-p "Unsent article being composed; erase it? "))) + () + (erase-buffer) + (if (eq method 'post) + (news-setup nil nil nil header article-buffer) + (save-excursion + (set-buffer article-buffer) + (goto-char (point-min)) + (narrow-to-region (point-min) + (progn (search-forward "\n\n") (point))) + (if (and (boundp 'gnus-followup-to-function) + gnus-followup-to-function) + (setq follow-to (funcall gnus-followup-to-function group))) + (setq from (header-from header)) + (setq date (header-date header)) + (and from + (let ((stop-pos + (string-match " *at \\| *@ \\| *(\\| *<" from))) + (setq message-of + (concat (if stop-pos (substring from 0 stop-pos) from) + "'s message of " date)))) + (setq subject (header-subject header)) + (or (string-match "^[Rr][Ee]:" subject) + (setq subject (concat "Re: " subject))) + (setq followup-to (mail-fetch-field "followup-to")) + (if (or (null gnus-use-followup-to) ;Ignore followup-to: field. + (string-equal "" followup-to) ;Bogus header. + (string-equal "poster" followup-to)) ;Poster + (setq followup-to nil)) + (setq newsgroups (or followup-to (mail-fetch-field "newsgroups"))) + (setq references (header-references header)) + (setq distribution (mail-fetch-field "distribution")) + ;; Remove bogus distribution. + (and (string= distribution "world") + (setq distribution nil)) + (setq message-id (header-id header)) + (widen)) + (setq news-reply-yank-from from) + (setq news-reply-yank-message-id message-id) + (news-setup nil subject message-of newsgroups article-buffer) + ;; Fold long references line to follow RFC1036. + (mail-position-on-field "References") + (let ((begin (- (point) (length "References: "))) + (fill-column 79) + (fill-prefix "\t")) + (if references (insert references)) + (if (and references message-id) (insert " ")) + (if message-id (insert message-id)) + ;; The region must end with a newline to fill the region + ;; without inserting extra newline. + (fill-region-as-paragraph begin (1+ (point)))) + (if distribution + (progn + (mail-position-on-field "Distribution") + (insert distribution))))) + (current-buffer)))) + +;;; Internal functions. + +(defun nntp-default-sentinel (proc status) + "Default sentinel function for NNTP server process." + (let ((servers nntp-server-alist)) + (while (and servers + (not (equal proc (nth 1 (car servers))))) + (setq servers (cdr servers))) + (error "nntp: Connection closed to server %s." + (or (car (car servers)) "(none)")))) + +;; Encoding and decoding of NNTP text. + +(defun nntp-decode-text () + "Decode text transmitted by NNTP. +0. Delete status line. +1. Delete `^M' at end of line. +2. Delete `.' at end of buffer (end of text mark). +3. Delete `.' at beginning of line." + (save-excursion + (set-buffer nntp-server-buffer) + ;; Insert newline at end of buffer. + (goto-char (point-max)) + (if (not (bolp)) + (insert "\n")) + ;; Delete status line. + (goto-char (point-min)) + (delete-region (point) (progn (forward-line 1) (point))) + ;; Delete `^M' at end of line. + ;; (replace-regexp "\r$" "") + (while (not (eobp)) + (end-of-line) + (if (= (preceding-char) ?\r) + (delete-char -1)) + (forward-line 1) + ) + ;; Delete `.' at end of buffer (end of text mark). + (goto-char (point-max)) + (forward-line -1) ;(beginning-of-line) + (if (looking-at "^\\.$") + (delete-region (point) (progn (forward-line 1) (point)))) + ;; Replace `..' at beginning of line with `.'. + (goto-char (point-min)) + ;; (replace-regexp "^\\.\\." ".") + (while (search-forward "\n.." nil t) + (delete-char -1)) + )) + +(defun nntp-encode-text () + "Encode text in current buffer for NNTP transmission. +1. Insert `.' at beginning of line. +2. Insert `.' at end of buffer (end of text mark)." + (save-excursion + ;; Insert newline at end of buffer. + (goto-char (point-max)) + (if (not (bolp)) + (insert "\n")) + ;; Replace `.' at beginning of line with `..'. + (goto-char (point-min)) + ;; (replace-regexp "^\\." "..") + (while (search-forward "\n." nil t) + (insert ".")) + ;; Insert `.' at end of buffer (end of text mark). + (goto-char (point-max)) + (insert ".\r\n") + )) + + +;;; +;;; Synchronous Communication with NNTP Server. +;;; + +(defun nntp-send-command (response cmd &rest args) + "Wait for server RESPONSE after sending CMD and optional ARGS to server." + (save-excursion + ;; Clear communication buffer. + (set-buffer nntp-server-buffer) + (erase-buffer) + (apply 'nntp-send-strings-to-server cmd args) + (if response + (nntp-wait-for-response response) + t) + )) + +(defun nntp-wait-for-response (regexp) + "Wait for server response which matches REGEXP." + (save-excursion + (let ((status t) + (wait t) + (dotnum 0) ;Number of "." being displayed. + (dotsize ;How often "." displayed. + (if (numberp nntp-debug-read) nntp-debug-read 10000))) + (set-buffer nntp-server-buffer) + ;; Wait for status response (RFC977). + ;; 1xx - Informative message. + ;; 2xx - Command ok. + ;; 3xx - Command ok so far, send the rest of it. + ;; 4xx - Command was correct, but couldn't be performed for some + ;; reason. + ;; 5xx - Command unimplemented, or incorrect, or a serious + ;; program error occurred. + (nntp-accept-response) + (while wait + (goto-char (point-min)) + (cond ((looking-at "[23]") + (setq wait nil)) + ((looking-at "[45]") + (setq status nil) + (setq wait nil)) + (t (nntp-accept-response)) + )) + ;; Save status message. + (end-of-line) + (setq nntp-status-string + (buffer-substring (point-min) (point))) + (if status + (progn + (setq wait t) + (while wait + (goto-char (point-max)) + (forward-line -1) ;(beginning-of-line) + ;;(message (buffer-substring + ;; (point) + ;; (save-excursion (end-of-line) (point)))) + (if (looking-at regexp) + (setq wait nil) + (if nntp-debug-read + (let ((newnum (/ (buffer-size) dotsize))) + (if (not (= dotnum newnum)) + (progn + (setq dotnum newnum) + (message "NNTP: Reading %s" + (make-string dotnum ?.)))))) + (nntp-accept-response) + ;;(if nntp-debug-read (message "")) + )) + ;; Remove "...". + (if (and nntp-debug-read (> dotnum 0)) + (message "")) + ;; Successfully received server response. + t + )) + ))) + + +;;; +;;; Low-Level Interface to NNTP Server. +;;; + +(defun nntp-retrieve-headers-with-xover (sequence) + (if (not nntp-server-xover) + () + (let ((range (format "%d-%d" + (if nntp-build-old-threads 1 (car sequence)) + (nntp-last-element sequence)))) + (prog1 + (if (stringp nntp-server-xover) + (nntp-send-command "^\\.\r$" nntp-server-xover range) + (let ((commands nntp-xover-commands)) + (while (and commands + (eq t nntp-server-xover)) + (nntp-send-command "^\\.\r$" (car commands) range) + (save-excursion + (set-buffer nntp-server-buffer) + (goto-char 1) + (if (looking-at "[23]") + (setq nntp-server-xover (car commands)))) + (setq commands (cdr commands))) + (if (eq t nntp-server-xover) + (setq nntp-server-xover nil)) + (setcar (nthcdr 2 (assoc nntp-current-server nntp-server-alist)) + nntp-server-xover) + nntp-server-xover) + t) + (if nntp-server-xover (nntp-decode-text) (erase-buffer)))))) + +(defun nntp-send-strings-to-server (&rest strings) + "Send list of STRINGS to news server as command and its arguments." + (let ((cmd (car strings)) + (strings (cdr strings))) + ;; Command and each argument must be separated by one or more spaces. + (while strings + (setq cmd (concat cmd " " (car strings))) + (setq strings (cdr strings))) + ;; Command line must be terminated by a CR-LF. + (if (not (nntp-server-opened nntp-current-server)) + (progn + (nntp-close-server nntp-current-server) + (if (not (nntp-open-server nntp-current-server)) + (error (nntp-status-message))) + (save-excursion + (set-buffer nntp-server-buffer) + (erase-buffer)))) + (process-send-string nntp-server-process (concat cmd "\r\n")) + )) + +(defun nntp-send-region-to-server (begin end) + "Send current buffer region (from BEGIN to END) to news server." + (save-excursion + ;; We have to work in the buffer associated with NNTP server + ;; process because of NEmacs hack. + (copy-to-buffer nntp-server-buffer begin end) + (set-buffer nntp-server-buffer) + (setq begin (point-min)) + (setq end (point-max)) + ;; `process-send-region' does not work if text to be sent is very + ;; large. I don't know maximum size of text sent correctly. + (let ((last nil) + (size 100)) ;Size of text sent at once. + (save-restriction + (narrow-to-region begin end) + (goto-char begin) + (while (not (eobp)) + ;;(setq last (min end (+ (point) size))) + ;; NEmacs gets confused if character at `last' is Kanji. + (setq last (save-excursion + (goto-char (min end (+ (point) size))) + (or (eobp) (forward-char 1)) ;Adjust point + (point))) + (process-send-region nntp-server-process (point) last) + ;; I don't know whether the next codes solve the known + ;; problem of communication error of GNU Emacs. + (accept-process-output) + ;;(sit-for 0) + (goto-char last) + ))) + ;; We cannot erase buffer, because reply may be received. + (delete-region begin end) + )) + +(defun nntp-open-server-internal (server &optional service) + "Open connection to news server on SERVER by SERVICE (default is nntp)." + (let (proc) + (save-excursion + ;; Use TCP/IP stream emulation package if needed. + (or (fboundp 'open-network-stream) + (require 'tcp)) + ;; Initialize communication buffer. + (setq nntp-server-buffer (get-buffer-create " *nntpd*")) + (set-buffer nntp-server-buffer) + (buffer-disable-undo (current-buffer)) + (erase-buffer) + (kill-all-local-variables) + (setq case-fold-search t) ;Should ignore case. + (if (setq proc + (condition-case nil + (open-network-stream "nntpd" (current-buffer) + server (or service "nntp")) + (error nil))) + (progn + (setq nntp-server-process proc) + ;; Suggested by Hallvard B Furuseth . + (process-kill-without-query proc) + (setq nntp-server-xover t) + (setq nntp-server-name server) + (setq nntp-server-alist (cons (list server nntp-server-process t) + nntp-server-alist)) + ;; It is possible to change kanji-fileio-code in this hook. + (run-hooks 'nntp-server-hook) + nntp-server-process))))) + + +(defun nntp-close-server-internal (&optional server) + "Close connection to news server." + (nntp-possibly-change-server nil server) + (if nntp-server-process + (delete-process nntp-server-process)) + (setq nntp-server-process nil) + (let* ((servers nntp-server-alist) + (prev servers)) + (if (and servers (string= (car (car servers)) server)) + (setq nntp-server-alist (cdr nntp-server-alist)) + (setq servers (cdr servers)) + (while servers + (if (string= (car (car servers)) server) + (setcdr prev (cdr servers))) + (setq prev servers) + (setq servers (cdr servers)))))) + +(defun nntp-request-close () + "Close all server connections." + (while nntp-server-alist + (delete-process (car (cdr (car nntp-server-alist)))) + (setq nntp-server-alist (cdr nntp-server-alist))) + (setq nntp-current-server "") + (setq nntp-server-process nil)) + +(defun nntp-accept-response () + "Read response of server. +It is well-known that the communication speed will be much improved by +defining this function as macro." + ;; To deal with server process exiting before + ;; accept-process-output is called. + ;; Suggested by Jason Venner . + ;; This is a copy of `nntp-default-sentinel'. + (or (memq (process-status nntp-server-process) '(open run)) + (error "NNTP: Connection closed.")) + (if nntp-buggy-select + (progn + ;; We cannot use `accept-process-output'. + ;; Fujitsu UTS requires messages during sleep-for. I don't know why. + (message "NNTP: Reading...") + (sleep-for 1) + (message "")) + (condition-case errorcode + (accept-process-output nntp-server-process) + (error + (cond ((string-equal "select error: Invalid argument" (nth 1 errorcode)) + ;; Ignore select error. + nil + ) + (t + (signal (car errorcode) (cdr errorcode)) + )) + )))) + +(defun nntp-last-element (list) + "Return last element of LIST." + (while (cdr list) + (setq list (cdr list))) + (car list)) + +(defun nntp-possibly-change-server (newsgroup server) + (let (result changed-server) + ;; First see if we need to change the server - or even open a new + ;; server. + (if (and server (not (string= server nntp-current-server))) + (progn + ;; Fix by Sudish Joseph . + (if (or (assoc server nntp-server-alist) + (nntp-open-server server)) + ;; `nntp-open-server' may change `nntp-server-alist', so + ;; we assoc again. + (let ((info (assoc server nntp-server-alist))) + (setq nntp-current-server server) + ;; Variable for backwards compatability. + (setq nntp-server-name server) + (setq nntp-server-process (nth 1 info)) + (setq nntp-server-xover (nth 2 info)) + (setq changed-server t) + (setq result t)))) + (setq result t)) + ;; The we see whether it is necessary to change newsgroup. + (if (and newsgroup result (or (not (string= newsgroup nntp-current-group)) + changed-server)) + (progn + (setq result (nntp-request-group newsgroup server)) + (setq nntp-current-group newsgroup))) + result)) + +(provide 'nntp) + +;;; nntp.el ends here diff --git a/lisp/nnvirtual.el b/lisp/nnvirtual.el new file mode 100644 index 000000000..a64f3c4d2 --- /dev/null +++ b/lisp/nnvirtual.el @@ -0,0 +1,240 @@ +;;;; nnvirtual.el --- Virtual newsgroups access for (ding) Gnus + +;; Copyright (C) 1994 Free Software Foundation, Inc. + +;; Author: Lars Ingebrigtsen +;; Keywords: news + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to +;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +;;; Commentary: + +;; Based on nnspool.el by Masanobu UMEDA . +;; +;; The other access methods (nntp.el and nnspool.el) are general news +;; access methods. This module relies on Gnus and can not be used +;; separately. + +;;; Code: + +(require 'nntp) +(require 'nnheader) +(require 'gnus) + +(defconst nnvirtual-version "nnvirtual 0.0" + "Version numbers of this version of nnvirual.") + +(defvar nnvirtual-large-newsgroup 50 + "*The number of the articles which indicates a large newsgroup. +If the number of the articles is greater than the value, verbose +messages will be shown to indicate the current status.") + + + +(defvar nnvirtual-newsgroups nil + "The newsgroups that belong to this virtual newsgroup.") + +(defvar nnvirtual-newsgroups-regexp nil + "The newsgroups that belong to this virtual newsgroup.") + +(defvar nnvirtual-mapping nil) + +(defvar nnvirtual-do-not-open nil) + +(defvar nnvirtual-status-string "") + + + +;;; Interface functions. + +(defun nnvirtual-retrieve-headers (sequence &optional newsgroup server) + "Retrieve the headers for the articles in SEQUENCE." + (nnvirtual-possibly-change-newsgroups newsgroup server) + (save-excursion + (set-buffer (get-buffer-create "*virtual headers*")) + (erase-buffer) + (let ((number (length sequence)) + (count 0) + (i 0) + prev articles group-articles beg art-info article group) + (if sequence (setq prev (car (aref nnvirtual-mapping (car sequence))))) + (while sequence + (setq art-info (aref nnvirtual-mapping (car sequence))) + (if (not (equal prev (car art-info))) + (progn + (setq group-articles (cons (list prev (nreverse articles)) + group-articles)) + (setq articles nil) + (setq prev (car art-info)))) + (setq articles (cons (cdr art-info) articles)) + (setq sequence (cdr sequence))) + (if prev + (setq group-articles (cons (list prev (nreverse articles)) + group-articles))) + (setq group-articles (nreverse group-articles)) + (while group-articles + (setq group (car (car group-articles))) + (gnus-retrieve-headers (car (cdr (car group-articles))) group) + (save-excursion + (set-buffer nntp-server-buffer) + (goto-char 1) + (insert "\n.\n") + (goto-char 1) + (while (search-forward "\n.\n" nil t) + (if (not (looking-at ".[0-9]+ \\([0-9]+\\) ")) + () + (setq article (string-to-int (gnus-buffer-substring 1 1))) + (setq i 1) + (while (/= article (cdr (aref nnvirtual-mapping i))) + (setq i (1+ i))) + (goto-char (match-beginning 1)) + (looking-at "[0-9]+ ") + (replace-match (format "%d " i)) + (setq beg (point)) + (search-forward "\n.\n" nil t) + (if (not (re-search-backward "^Xref: " beg t)) + (progn + (forward-char -2) + (insert (format "Xref: ding %s:%d\n" group article)) + (forward-char -1))) + ))) + (goto-char (point-max)) + (insert-buffer-substring nntp-server-buffer 4) + (setq group-articles (cdr group-articles))) + (prog1 + (save-excursion + (if (not nntp-server-buffer) + (setq nntp-server-buffer (get-buffer-create " *nntpd*"))) + (set-buffer nntp-server-buffer) + (erase-buffer) + (insert-buffer-substring "*virtual headers*") + 'headers) + (kill-buffer (current-buffer)))))) + +(defun nnvirtual-open-server (newsgroups &optional something) + "Open a virtual newsgroup that contains NEWSGROUPS." + (let ((newsrc gnus-newsrc-assoc)) + (setq nnvirtual-newsgroups nil) + (setq nnvirtual-newsgroups-regexp newsgroups) + (while newsrc + (if (string-match newsgroups (car (car newsrc))) + (setq nnvirtual-newsgroups (cons (car (car newsrc)) + nnvirtual-newsgroups))) + (setq newsrc (cdr newsrc))) + (if (null nnvirtual-newsgroups) + (setq nnvirtual-status-string + (format + "nnvirtual: No newsgroups for this virtual newsgroup")) + (nnvirtual-open-server-internal)) + nnvirtual-newsgroups)) + +(defun nnvirtual-close-server (&rest dum) + "Close news server." + (nnvirtual-close-server-internal)) + +(fset 'nnvirtual-request-quit (symbol-function 'nnvirtual-close-server)) + +(defun nnvirtual-server-opened (&optional server) + "Return server process status, T or NIL. +If the stream is opened, return T, otherwise return NIL." + (and nntp-server-buffer + (get-buffer nntp-server-buffer))) + +(defun nnvirtual-status-message () + "Return server status response as string." + nnvirtual-status-string) + +(defun nnvirtual-request-article (id &optional newsgroup server buffer) + "Select article by message ID (or number)." + (nnvirtual-possibly-change-newsgroups newsgroup server) + (let (art) + (setq art (aref nnvirtual-mapping id)) + (gnus-request-group (car art)) + (gnus-request-article (cdr art) (car art) buffer))) + +(defun nnvirtual-request-group (group &optional server dont-check) + "Make GROUP the current newsgroup." + (nnvirtual-possibly-change-newsgroups nil server) + (let* ((group (concat gnus-foreign-group-prefix group)) + (info (nth 2 (gnus-gethash group gnus-newsrc-hashtb))) + (groups nnvirtual-newsgroups) + (i 0) + (total 0) + unread igroup) + (if (not info) + (error "No such group: %s" group)) + (setcar (nthcdr 2 info) nil) + (while groups + (setq unread (car (gnus-gethash (car groups) gnus-newsrc-hashtb))) + (if (numberp unread) (setq total (+ total unread))) + (setq groups (cdr groups))) + (setq nnvirtual-mapping (make-vector (+ 3 total) nil)) + (setq groups nnvirtual-newsgroups) + (while groups + (setq igroup (car groups)) + (setq unread (gnus-list-of-unread-articles igroup)) + (while unread + (aset nnvirtual-mapping (setq i (1+ i)) (cons igroup (car unread))) + (setq unread (cdr unread))) + (setq groups (cdr groups))) + (save-excursion + (set-buffer nntp-server-buffer) + (erase-buffer) + (insert (format "211 %d %d %d %s\n" (1+ total) 1 total group))) + t)) + +(defun nnvirtual-request-list (&optional server) + "List active newsgoups." + (setq nnvirtual-status-string "nnvirtual: LIST is not implemented.") + nil) + +(defun nnvirtual-request-list-newsgroups (&optional server) + "List newsgroups (defined in NNTP2)." + (setq nnvirtual-status-string "nnvirtual: LIST NEWSGROUPS is not implemented.") + nil) + +(fset 'nnvirtual-request-post 'nntp-request-post) + +(fset 'nnvirtual-request-post-buffer 'nntp-request-post-buffer) + + +;;; Low-Level Interface + +(defun nnvirtual-open-server-internal () + "Fix some internal variables." + (save-excursion + ;; Initialize communicatin buffer. + (setq nnvirtual-mapping nil) + (setq nntp-server-buffer (get-buffer-create " *nntpd*")) + (set-buffer nntp-server-buffer) + (buffer-disable-undo (current-buffer)) + (kill-all-local-variables) + (setq case-fold-search t))) + +(defun nnvirtual-close-server-internal (&rest dum) + "Close connection to news server." + nil) + +(defun nnvirtual-possibly-change-newsgroups (group groups-regexp) + (if (and groups-regexp + (not (and nnvirtual-newsgroups-regexp + (string= groups-regexp nnvirtual-newsgroups-regexp)))) + (nnvirtual-open-server groups-regexp))) + +(provide 'nnvirtual) + +;;; nnvirtual.el ends here diff --git a/readme b/readme new file mode 100644 index 000000000..89b1d8c75 --- /dev/null +++ b/readme @@ -0,0 +1,67 @@ +This package contains a pre-release of (ding) Gnus, version 0.5. The +lisp directory contains the source lisp files, and the texi directory +contains an early draft of the Gnus info pages. + +IMPORTANT NOTE FOR NNML USERS: If you have used an earlier version of +this package, you have to do the following: + +ESC ESC (load "nnml") +M-x nnml-generate-nov-databases + +nnml will chew on your mail for a while, and then you can use Gnus +again. Do not attempt to start Gnus before you have done this. + +(This note only applies to people who use nnml as a mail backedn.) + + +Gnus is meant to be totally compatible with GNUS. But, alas, it +probably isn't, which is one of the reasons for this pre-release. + +To use (ding) Gnus you first have to unpack the files, which you've +obviously done, because you are reading this. + +You should definitely byte-compile the source files. To do that, you +can simply say "make" in this directory. + +Then you have to tell Emacs where Gnus is. You might put something +like + + (setq load-path (cons (expand-file-name "~/dgnus/lisp") load-path)) + +in your .emacs file, or wherever you keep such things. + +Note that (ding) Gnus and GNUS can not coexist in a single Emacs. They +both use the same function and variable names. If you have been +running GNUS in your Emacs, you should probably exit that Emacs and +start a new one to fire up Gnus. + +Then you do a `M-x gnus', and everything should... uhm... it should +work, but it might not. Set `debug-on-error' to t, and mail me the +backtraces, or, better yet, find out why Gnus does something wrong, +fix it, and send me the diffs. :-) + +There are three main things I want your help and input on: + +1) Startup. Does eveything go smoothly, and why not? + +2) Any errors while you read news normally? + +3) Any errors if you do anything abnormal? + +4) Features you do not like, or do like, but would like to tweak a + bit, and features you would like to see. + +You do not have to send me typo corrections for the info pages. They +are a very rough first draft - I haven't even read through it, +although they should document all of Gnus, I think. + +I think I have implemented most of the deep-going changes that I'm +going to. Things that will probably come in the future, but I haven't +gotten around to yet is asynchronous posting/pre-fetch of headers and +articles, better digest handling, a hierarchal Newsgroup buffer, +allowing the user to provide Newsgroup headers from a function, and a +few other things that I can't think of at the moment. Oh, and the +mhspool backend doesn't work at all yet. + +Send any comments and all your bug fixes/complaints to +`larsi@ifi.uio.no'. diff --git a/texi/gnus.texi b/texi/gnus.texi new file mode 100644 index 000000000..eb9ae7681 --- /dev/null +++ b/texi/gnus.texi @@ -0,0 +1,2989 @@ +\input texinfo @c -*-texinfo-*- +@comment %**start of header (This is for running Texinfo on a region.) +@setfilename gnus +@settitle (ding) Gnus 1.0 Manual +@synindex fn cp +@synindex vr cp +@synindex pg cp +@iftex +@finalout +@end iftex +@setchapternewpage odd +@c @smallbook +@comment %**end of header (This is for running Texinfo on a region.) +@tex +\overfullrule=0pt +%\global\baselineskip 30pt % For printing in double spaces +@end tex + +@ifinfo + +This file documents GNUS, the GNU Emacs newsreader. + +Copyright (C) 1989, 1990, 1993 Free Software Foundation, Inc. + +Permission is granted to make and distribute verbatim copies of +this manual provided the copyright notice and this permission notice +are preserved on all copies. + +@ignore +Permission is granted to process this file through Tex and print the +results, provided the printed document carries copying permission +notice identical to this one except for the removal of this paragraph +(this paragraph not being relevant to the printed manual). + +@end ignore +Permission is granted to copy and distribute modified versions of this +manual under the conditions for verbatim copying, provided also that the +entire resulting derived work is distributed under the terms of a +permission notice identical to this one. + +Permission is granted to copy and distribute translations of this manual +into another language, under the above conditions for modified versions. +@end ifinfo + +@titlepage +@title Gnus Manual + +@author by Lars Ingebrigtsen +@page +@vskip 0pt plus 1filll +Copyright @copyright{} 1989, 1990, 1993 Free Software Foundation, Inc. + +Permission is granted to make and distribute verbatim copies of +this manual provided the copyright notice and this permission notice +are preserved on all copies. + +Permission is granted to copy and distribute modified versions of this +manual under the conditions for verbatim copying, provided that the +entire resulting derived work is distributed under the terms of a +permission notice identical to this one. + +Permission is granted to copy and distribute translations of this manual +into another language, under the above conditions for modified versions. + +Cover art by Etienne Suvasa. +@end titlepage +@page + +@node Top +@top The Gnus News Reader + +You can read news (and mail) from within Emacs by using (ding) Gnus. The +news can be gotten by any nefarious means you can think of - NNTP, local +spool, mail spool. All at the same time, if you want to push your luck. + +@menu +* History:: How Gnus got where it is today. +* Starting Up:: Finding news can be a pain. +* The Newsgroup Buffer:: Treating newsgroups. +* The Summary Buffer:: Reading articles. +* The Article Buffer:: Doing stuff to articles. +* Various:: General options. +* Customization:: Tailoring Gnus to your needs. +* Troubleshooting:: What you might try if things do not work. +* Reporting Bugs:: Bugs? What bugs?! +* Index:: Index. +* Key Index:: Key Index. +@end menu + +@node History +@chapter History + +GNUS was written by Masanobu UMEDA. When autumn crept up in '94, Lars +Ingebrigtsen grew bored and decided to write (ding) Gnus. + +(ding) Gnus is based on GNUS 4.1 and includes bits and pieces by Felix +Lee and jwz. + +The recommended pronounciation of the name this program is "ding +guh-noose", with "ding" being half-sung in a loud, high-pitched voice, +and "guh-noose" being grumbled and a disaffected fashion. Any irritation +and/or damage this name may cause you is not the responsibility of the +author, even though you might like to strangle him for the stupid idea. + +"(ding)", is, of course, short for "Ding Is Not Gnus", which is a total +and utter lie, but who cares? (Besides, the "Gnus" in this abbreviation +should probably be pronounced "news" as UMEDA intended, which makes it a +more appropriate name, don't you think?) + +@menu +* Compatibility:: Just how compatible is (ding) Gnus with GNUS? +* New Features:: A short description of all the new stuff in Gnus. +@end menu + +@node Compatibility +@section Compatibility + +(ding) Gnus was designed to be fully compatible with GNUS. Almost all +key binding have been kept. More key binding have been added, of course, +but only in one or two obscure cases have key bindings been changed. + +All commands have kept their names. Some internal functions have changed +their names. + +Even though old methods of doing things are still supported, only the +new methods are documented in this manual. If you detect a new method of +doing something while reading this manual, that does not mean you have +to stop doing it the old way. + +(ding) Gnus understands all GNUS startup files. + +@kindex M-x gnus-bug +Overall, a casual user who hasn't written much code that depends on GNUS +internals should suffer no problems. If problems occur, please let me +know (@kbd{M-x gnus-bug}). + +However, code that depends on the buffers looking a particular way will +almost invaribaly fail. For instance, the Summary buffer does not +display article numbers by default. + +@node New Features +@section New Features + +The look of all buffers can be changed by setting format-like variables. + +Local spool and several NNTP servers can be used at once. Virtual +newsgroups and private mail newsgroups are featured. + +Killing can be done on arbitrary headers. + +Gnus can generate dummy roots for threads that have lost their roots +(thereby gathering loose sub-threads in one thread) or it can go back +and retrieve enough headers to build a complete thread. + +Killed groups can be displayed in the Newsgroup buffer, and you can read +them as well. + +Gnus can do partial updates of new articles - you do not have to +retrieve the entire active file just to check for new articles in a few +groups. + +Gnus implements a sliding scale of subscribedness to newsgroups. + +Gnus can sort the displayed headers of articles. + +@node Starting Up +@chapter Starting Gnus + +@kindex M-x gnus +If your systems administrator has set thing up properly, starting Gnus +and reading news is extremely easy - you just type @kbd{M-x gnus}. + +If things do not go smoothly at startup, you have to twiddle some +variables. + +@menu +* Finding the News:: Choosing a method for getting news. +* First Time:: What does Gnus do the first time you start it? +* New Newsgroups:: What is Gnus supposed to do with new newsgroups? +* 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. +* Startup Variables:: Other variables you might change. +@end menu + +@node Finding the News +@section Finding the News + +@vindex gnus-default-select-method +The @code{gnus-default-select-method} variable controls how Gnus finds +news. This variable should be a list where the first element says "how" +and the second element says "where". + +For instance, if you want to get your daily dosage of news from the NNTP +server "news.friendly.server", you'd say: + +@example +(setq gnus-default-select-method '(nntp "news.friendly.server")) +@end example + +If you want to use a local spool, say: + +@example +(setq gnus-default-select-method '(nnspool "")) +@end example + +If this variable is not set, Gnus will take a look at the +@code{NNTPSERVER} environment variable. If that isn't set either, it +will try to use the machine that is running Emacs as an NNTP server. + +@vindex gnus-secondary-servers +You can also make Gnus prompt you interactively for the name of an NNTP +server. If you give a non-numerical prefix to `gnus' (ie. `C-u M-x +gnus'), Gnus will let you choose between the servers in the +@code{gnus-secondary-servers} variable (if any). You can also just type +in the name of any server you feel like visiting. + +However, if you use one NNTP server regularly, and is just interested in +a couple of newsgroups from a different server, you would be better +served by using the @code{gnus-group-browse-foreign-server} command from +the Newsgroup buffer. It will let you have a look at what groups are +available, and you can subscribe to any of the groups you want to. This +also makes @file{.newsrc} maintenance much tidier. + +@node First Time +@section The First Time + +One time has to be the first, but it doesn't have to be painful. + +If no startup files exist, Gnus will try to determine what newsgroups +should be subscribed by default. + +@vindex gnus-default-subscribed-newsgroups +If the variable @code{gnus-default-subscribed-newsgroups} is set, Gnus +will subscribe you to just those newsgroups in that list, leaving the +rest killed. Your systems administrator should have set this variable to +something useful. + +Since he hasn't, Gnus will ask the NNTP server (if you use one) if it +has any idea. + +If that fails as well, Gnus will just subscribe you to a few randomly +picked newsgroups (ie. @samp{*.newusers}). + +If @code{gnus-default-subscribed-newsgroups} is t, Gnus will just use +the normal functions for treating new newsgroups, and not do anything +special. + +@node New Newsgroups +@section New Newsgroups + +@vindex gnus-subscribe-newsgroup-method +What Gnus does when it encounters a new newsgroup is determined by the +@code{gnus-subscribe-newsgroup-method} variable. + +This variable should contain a function. Some handy ready-made values +are: + +@table @code +@item gnus-subscribe-randomly +@vindex gnus-subscribe-randomly +Subscribe all new newsgroups randomly. + +@item gnus-subscribe-alphabetically +@vindex gnus-subscribe-alphabetically +Subscribe all new newsgroups alphabetically. + +@item gnus-subscribe-hierarchically +@vindex gnus-subscribe-hierarchically +Subscribe all new newsgroups hierarchially. + +@item gnus-subscribe-interactively +@vindex gnus-subscribe-interactively +Subscribe new newsgroups interactively. This means that Gnus will ask +you about *all* new newsgroups. + +@item gnus-subscribe-zombies +@vindex gnus-subscribe-zombies +Make all new newsgroups zombies. You can browse the zombies later and +either kill them off properly or subscribe to them. This is the +default. + +@end table + +@vindex gnus-subscribe-hierarchical-interactive +A closely related variable is +@code{gnus-subscribe-hierarchical-interactive}. If this variable is +non-nil, Gnus will ask you in a hierarchial fashion whether to subscribe +to new newsgroups or not. Gnus will ask you for each sub-hierarchy +whether you want to descend the hierarchy or not. + +@vindex gnus-check-new-newsgroups +If you are satisfied that you never really want to see any new +newsgroups, you could set @code{gnus-check-new-newsgroups} to +nil. This will also save you some time at startup. Even if this +variable is nil, you can always subscribe to the new newsgroups +by just pressing @kbd{U} in the @dfn{Newsgroup buffer}. + +@node Startup Files +@section Startup Files + +Now, you all know about the @file{.newsrc} files. All information about +what newsgroups you read is traditionally stored in this file, which has +a rather rigid structure. + +Things got a bit more complicated with GNUS. In addition to keeping the +@file{.newsrc} file updated, it also used a file called @file{.newsrc.el} for +storing all the information that didn't fit into the @file{.newsrc} +file. (Actually, it duplicated everything in the @file{.newsrc} file.) +GNUS would read whichever one of these files that were the most recently +saved, which enabled people to swap between GNUS and other newsreaders. + +That was kinda silly, so (ding) Gnus went one better: In addition to the +@file{.newsrc} and @file{.newsrc.el} files, (ding) Gnus also has a file +called @file{.newsrc.eld}. It will read whichever of these files that +are most recent, but it will never write a @file{.newsrc.el} file. + +@vindex gnus-save-newsrc-file +You can also turn off writing @file{.newsrc} by setting +@code{gnus-save-newsrc-file} to nil, which means you can delete +the file and save some space, as well as some time when quitting +Gnus. However, that will make it impossible to use other newsreaders +than (ding) Gnus. But hey, who would want to, right? + +@vindex gnus-save-killed-list +If @code{gnus-save-killed-list} is nil, Gnus will not save the list of +killed groups to the startup file. This will save both time (when +starting and quitting) and space (on disk). It will also means that Gnus +has no record of what newsgroups are new or old, so the automatic new +newsgroups subscription methods become meaningless. You should always +set `gnus-check-new-newsgroups' to nil if you set this variable to +nil. + +@vindex gnus-startup-file +The @code{gnus-startup-file} variable says where the startup files +are. The default value is @file{"~/.newsrc"}, with the Gnus (El Dingo) +startup file being whatever that one is with a @samp{".eld"} appended. + +@vindex gnus-save-newsrc-hook +@code{gnus-save-newsrc-hook} is called before saving the @file{.newsrc} +file. + +@node Auto Save +@section Auto Save + +Whenever you do something that changes the Gnus data (reading articles, +cathing up, killing/subscribing to newsgroups,) the change is added to a +special @dfn{dribble} buffer. This buffer is auto-saved the normal Emacs +way. + +If Gnus detects this file at startup, it will ask the user whether to +read it. + +The auto save file is deleted whenever the real startup file is saved. + +@node The Active File +@section The Active File + +When Gnus starts, or indeed whenever it tries to determine if new +articles has arrived, it reads the active file. This is a file stored on +the NNTP server or in the local spool. + +@vindex gnus-ignored-newsgroups +Before examining the active file to see what newsgroups are available, +Gnus deletes all lines in this file that match +@code{gnus-ignored-newsgroups}. You may even use this variable to make +Gnus ignore hierarchies you aren't interested in. + +@vindex gnus-read-active-file +The active file can be rather Huge, so if you have a slow network, you +can set @code{gnus-read-active-file} to nil to prevent Gnus from reading +the entire active file. + +Gnus will try to make do by just getting information on the newsgroups +that you actually subscribe to. + +Note that if you subscribe to lots and lots of newsgroups, setting this +variable to nil will probabaly make Gnus slower, not faster. + + + +@node Startup Variables +@section Startup Variables + +@table @code +@item gnus-check-bogus-newsgroups +@vindex gnus-check-bogus-newsgroups +If non-nil, Gnus will check for and delete all bogus newsgroups at +startup. A @dfn{bogus newsgroup} is a newsgroup that you have in you +@file{.newsrc} file, but doesn't exist on the news server. Checking for +bogus newsgroups isn't very quick, so to save time and resources, it's +best to leave this option off, and instead do the checking for bogus +newsgroups once in a while from the Newsgroup buffer. +@item gnus-inhibit-startup-message +@vindex gnus-inhibit-startup-message +If non-nil, the startup message won't be displayed. That way, nobody will +notice thay you are reading news instead of doing your job. +@end table + +@node The Newsgroup Buffer +@chapter The Newsgroup Buffer + +The @dfn{Newsgroup buffer} lists all (or parts) of the available +newsgroups and displays various information regarding these groups. +It is the first buffer displayed when Gnus starts. + +@menu +* Newsgroup Buffer Format:: Information listed and how you can change it. +* Newsgroup Manouvering:: Commands for moving in the newsgroup buffer. +* Selecting a Newsgroup:: Actually reading news. +* Newsgroup Subscribing:: Unsubscribing, killing, subscribing. +* Newsgroup Levels:: Levels? What are those, then? +* Foreign Newsgroups:: How to create foreign newsgroups. +* Listing Groups:: Gnus can list various portions of the groups. +* Newsgroup Maintenance:: Maintaining a tidy @file{.newsrc} file. +* Browse Foreign Server:: You can browse a server. See what if has to offer. +* Exiting Gnus:: Stop reading news and get some work done. +* Misc Newsgroup Stuff:: Other stuff that you can to do. +@end menu + +@node Newsgroup Buffer Format +@section Newsgroup Buffer Format + +The default format of the Newsgroup buffer is nice and dull, but you can +make it as exciting and ugly as you feel like. + +Here's a couple of example newsgroup lines: + +@example + 25: news.announce.newusers + * 3: alt.fan.andrea-dworkin +@end example + +Quite simple, huh? + +Those lines mean that there are 25 unread articles in +@samp{news.announce.newusers} and 3 marked articles in +@samp{alt.fan.andrea-dworkin} and no unread artcles (see that little +asterisk at the beginning of the line?) + +@vindex gnus-group-line-format +You can fuck that up to your hearts delight by fiddling with the +@code{gnus-group-line-format} variable. This variable works along the +lines of a @code{format} specification, which is pretty much the same as +a @code{printf} specifications, for those of you who use (feh!) C. + +One extension is that specifications like @samp{%7,12s} is allowed, +which means that the field will be at least 7 characters long, and no +more that 12 characters long. + +The default value that produced those lines above is +@samp{"%M%S%5N: %G\n"}. + +There should always be a colon on the line; the cursor is always moved +to the colon. Nothing else is required - not even the newsgroup name. + +Here's a list of all available format characters: + +@table @samp +@item M +Only marked articles +@item S +Whether the group is subscribed +@item L +Level of subscribedness +@item N +Number of unread articles +@item G +Group name +@item m +Number of marked articles +@item T +Total number of articles; both read and unread +@item D +Newsgroup description +@item s +Select method +@item n +Select from where +@item z +A string that look like @samp{<%s:%n>} if a foreign select method is +used. +@end table + +@vindex gnus-group-mode-line-format +The mode line can also be changed by using the +@code{gnus-group-mode-line-format} variable. It does not understand that +many format specifiers: + +@table @samp +@item S +Default news server +@item M +Default select method +@end table + +@node Newsgroup Manouvering +@section Newsgroup Manouvering + +All movement commands understand the numeric prefix and will behave as +expected, hopefully. + +@table @kbd +@item n +@kindex n (Group) +@findex gnus-group-next-unread-group +Go to the next group with unread articles +(@code{gnus-group-next-unread-group}). +@item p, DEL +@kindex DEL (Group) +@kindex p (Group) +@findex gnus-group-prev-unread-group +Go to the previous group group with unread articles +(@code{gnus-group-prev-unread-group}). +@item N, C-n +@kindex N (Group) +@kindex C-n (Group) +@findex gnus-group-next-group +Go to the next group (@code{gnus-group-next-group}). +@item P, C-p +@kindex P (Group) +@kindex C-p (Group) +@findex gnus-group-prev-group +Go to the previous group (@code{gnus-group-prev-group}). +@item M-p +@kindex M-p (Group) +@findex gnus-group-next-unread-group-same-level +Go to the next unread group on the same level (or lower) +(@code{gnus-group-next-unread-group-same-level}). +@item M-n +@kindex M-n (Group) +@findex gnus-group-prev-unread-group-same-level +Go to the previous unread group on the same level (or lower) +(@code{gnus-group-prev-unread-group-same-level}). +@item j +@kindex j (Group) +@findex gnus-group-jump-to-group +Jump to a group (and make it visible if it isn't already) +(@code{gnus-group-jump-to-group}). +@end table + +@node Selecting a Newsgroup +@section Selecting a Newsgroup + +@table @kbd +@item SPACE +@kindex SPACE (Group) +@findex gnus-group-read-group +Select the current newsgroup, switch to the Summary buffer and display +the first unread article in the newsgroup +(@code{gnus-group-read-group}). If there are no unread articles in the +newsgroup, or if you give a prefix to this command, Gnus will offer to +fetch all the old articles in this newsgroup from the server. +server. +@item = +@kindex = (Group) +@findex gnus-group-select-group +Select the current newsgroup and switch to the Summary buffer +(@code{gnus-group-select-group}). +@item c +@kindex c (Group) +@findex gnus-group-catchup-current +Mark all unticked articles in this newsgroup as read +(@code{gnus-group-catchup-current}). +@item C +@kindex C (Group) +@findex gnus-group-catchup-current-all +Mark all articles in this newsgroup, even the ticked ones, as read +(@code{gnus-group-catchup-current-all}). +@end table + +@vindex gnus-large-newsgroup +The @code{gnus-large-newsgroup} variable says what Gnus considers to be +a "big" newsgroup. If the newsgroup is big, Gnus will query the user +before entering the newsgroup. The user can then specify how many +articles should be fetched from the server. If the user specifies a +negative number (@samp{-n}), the @samp{n} articles that have arrived +most recently will be fetched. If it is positive, the @samp{n} oldest +articles will be fetched. + +@vindex gnus-auto-select-newsgroup +If @code{gnus-auto-select-newsgroup} is non-nil, the first unread +article in the newsgroup will be displayed when you enter the +newsgroup. If you want to prevent automatic selection in some newsgroup +(say, in a binary newsgroup with Huge articles) you can set til variable +to nil in `gnus-select-group-hook', which is called when a newsgroup is +selected. This hook is also popularly used for sorting headers before +generating the Summary buffer. + +@node Newsgroup Subscribing +@section Newsgroup Subscribing + +@table @kbd +@item u +@kindex u (Group) +@findex gnus-group-unsubscribe-current-group +Unsubscribe the current newsgroup, or, if it was unsubscribed already, +subscribe it (@code{gnus-group-unsubscribe-current-group}). +@item U +@kindex U (Group) +@findex gnus-group-unsubscribe-group +Ask the user for a newsgroup to unsubscribe, and then unsubscribe it. If +it was unsubscribed already, subscribe it instead +(@code{gnus-group-unsubscribe-group}). +@item k +@kindex k (Group) +@findex gnus-group-kill-group +Kill the current newsgroup (@code{gnus-group-kill-group}). +@item y +@kindex y (Group) +@findex gnus-group-yank-group +Yank the last killed newsgroup (@code{gnus-group-yank-group}). +@item C-w +@kindex C-w (Group) +@findex gnus-group-kill-region +Kill all newsgroups in the region (@code{gnus-group-kill-region}). +@item M-z +@kindex M-z (Group) +@findex gnus-group-kill-all-zombies +Kill all zombie newsgroups (@code{gnus-group-kill-all-zombies}). +@end table + +@node Newsgroup Levels +@section Newsgroup Levels + +All newsgroups have a level of "subscribedness". For instance, if a +newsgroup is on level 2, it is "more" subscribed than a newsgroup on +level 5. You can ask Gnus to just list newsgroups on a given level and +lower, or to just check new articles in newsgroups on a given level and +lower, etc. + +@table @kbd +@item s +@kindex s (Group) +@findex gnus-group-set-current-level +Set the level of the current newsgroup depending on the numeric +prefix. For instance, @kbd{3 s} will set the level of the current +newsgroup to three (@code{gnus-group-set-current-level}). +@end table + +Gnus considers groups on levels 1-5 to be subscribed, 6-7 to be +unsubscribed, 8 to be zombies (walking dead) and 9 to be killed, +completely dead. Gnus treats subscribed and unsubscribed groups exactly +the same, but zombie and killed groups have no information on what +articles you have read, etc, stored. + +@vindex gnus-keep-same-level +If @code{gnus-keep-same-level} is non-nil, some movement commands will +only move to groups that are of the same level (or lower). In +particular, going from the last article in one newsgroup to the next +newsgroup will go to the next newsgroup of the same level (or +lower). This might be handy if you want to read the most important +newsgroups before you read the rest. + +@node Foreign Newsgroups +@section Foreign Newsgroups + +A @dfn{foreign newsgroup} is a newsgroup that is not read by the usual +(or default) means. It could be, for instance, a newsgroup from a +different NNTP server, it could be a virtual newsgroup or it could be a +"newsgroup" of your own personal mail. + +@table @kbd +@item M-a +@kindex M-a (Group) +@findex gnus-group-add-newsgroup +Add a new newsgroup. Gnus will prompt you for a name, a method and an +"address" (@code{gnus-group-add-newsgroup}). +@item M-e +@kindex M-e (Group) +@findex gnus-group-edit-newsgroup +Edit a newsgroup entry. Gnus will pop up a new buffer where you can edit +the entry (@code{gnus-group-edit-newsgroup}). +@end table + +The different methods all have their peculiarities, of course. + +@menu +* nntp:: Reading news from a different NNTP server +* nnspool:: Reading news from the local spool +* nnvirtual:: Combining articles from many newsgroups +* Mail:: Reading your personal mail with Gnus +@end menu + +@vindex gnus-activate-foreign-newsgroups +If the @code{gnus-activate-foreign-newsgroups} is t, Gnus will +check all foreign newsgroup at startup. This might take quite a while, +especially if you subscribe to lots of groups from different NNTP +servers. It is @code{nil} by default, which means that you won't be told +whether there are new articles in these groups. How many unread articles +there are will be determined when, or if, you decide to enter them. + +@node nntp +@subsection nntp + +Subscribing to a foreign group from an NNTP server is rather easy. You +just specify @code{nntp} as method and the address of the NNTP server as +the, uhm, address. + +The name of the foreign newsgroup can be the same as a native +newsgroup. However, two foreign newsgroup can not have the same names. + +@node nnspool +@subsection nnspool + +Subscribing to a foreign group from the local spool is extremely easy, +even though I don't see quite why you'd want to. If you have a local +spool, why don't you use that as the default method? + +Anyways, you just specify @code{nnspool} as the method and @samp{""} as +the address. + +@node nnvirtual +@subsection nnvirtual + +A @dfn{virtual newsgroup} is really nothing more than a collection of +other newsgroups. + +You specify @code{nnvirtual} as the method and a regular expression that +says which newsgroups that you wish to have in this one as the address. + +For instance, if you are tired of reading many small newsgroup, you can +put them all in one big newsgroup, and then grow tired of reading one +big, unwieldy newsgroup. The joys of computing! + +@example +"^alt\\.fan\\.andrea-dworkin$\\|rec\\.dworkin.*" +@end example + +These newsgroups can be native or foreign; everything should work +smoothly, but if your computer should explode, it was probably my +fault. (Including other virtual newsgroups in this one will probably +confuse Gnus, so don't do that.) + +One limitation, however - all newsgroups that are included in +a virtual newsgroup has to be alive (ie. subscribed or unsubscribed). In +fact, if you include a newsgroup in a virtual newsgroup, and it was +killed, it will be subscribed automagically. + +@node Mail +@subsection Mail + +Reading mail with a newsreader - isn't that just plain WeIrD? But of +course. + +@menu +* Creating Mail Newsgroups:: How to create mail newsgroups (duh). +* Expiring Old Mail Articles:: Yes. +@end menu + +Gnus will read the mail spool when you activate the newsgroup. The mail +file is first copied to your home directory. What happens after that +depends on what format you want to store you mail in. + +@menu +* nnmail:: Using the quite standard Un*x mbox. +* nnrmail:: Many Emacs programs use the rmail babyl format. +* nnml:: Store your mail in a private spool? +@end menu + +@vindex nnmail-read-incoming-hook +The mail backends all call @code{nnmail-read-incoming-hook} after +reading new mail. You can use this hook to notify any mail watch +programs, if you want to. + +Gnus gives you all the opportunity you want for shooting yourself in +your foot. Let's say you create a newsgroup that will contain all the +mail you get from your boss. And then you accidentally unsubscribe from +the newsgroup. Gnus will still put all the mail from your boss in the +unsubscribed newsgroup, and so, when your boss mails you "Have that +report ready by Monday or you're fired!", you'll never see it and, come +Tuesday, you'll still beleive that you're gainfully unemplyed while you +really should be out collecting empty bottles to save up for next +month's rent money. + +@node Creating Mail Newsgroups +@subsubsection Creating Mail Newsgroups + +There are two ways of making Gnus read your personal, private, secret +mail. One is pretty easy, and the other requires minor tinkering. + +@kindex M-x gnus-group-make-mail-groups (Summary) +First the easy way: Type @kbd{M-x gnus-group-make-mail-groups}. That +will create a newsgroup called @samp{mail.misc} that will contain all +your mail. + +Then the hard(er) way. + +@vindex nnmail-split-methods +Set the variable @code{nnmail-split-methods} to specify how the incoming +mail is to be split into newsgroups. + +@example +(setq nnmail-split-methods + '(("mail.junk" "^From:.*Lars Ingebrigtsen") + ("mail.crazzy" "^Subject:.*die\\|^Organization:.*flabby") + ("mail.other" ""))) +@end example + +This variable is a list of lists, where the first element of each of +these lists contain the name of the mail newsgroup (they do not have to +be called something beginning with @samp{"mail"}, by the way), and the +second element is a regular expression used on the header of each mail +to determine if it belongs in this mail newsgroup. + +The last of these newsgroups should always be a general one, and the +regular expression should *always* be @samp{""} so that it matches all +mails. + +You should always do a @kbd{M-x gnus-group-make-mail-groups} after +changing this variable to create all the newsgroups you have specified. + +@node Expiring Old Mail Articles +@subsubsection Expiring Old Mail Articles + +Traditional mail readers have a tendency to remove mail articles when +you mark them as read, in some way. Gnus takes a fundamentally different +approach to mail reading. + +Gnus basically considers mail just to be news that has been received in +a rather peculiar manner. It does not think that it has the power to +actually change the mail, or delete any mail messages. If you enter a +mail newsgroup, and mark articles as "read", or kill them in some other +fashion, the mail articles will still exist on the system. I repeat: +Gnus will not delete your old, read mail. Unless you ask it to, of +course. + +To make Gnus get rid of your unwanted mail, you have to mark the +articles as @dfn{expirable}. This does not mean that the articles will +disappear right away, however. In general, a mail article will be +deleted from your system if, 1) it is marked as expirable, AND 2) it is +more than one week old. If you do not mark an article as expirable, it +will remain on your system until hell freezes over. + +@vindex gnus-auto-expirable-newsgroups +You do not have to mark articles as expirable by +hand. Newsgroups that match the regular expression +@code{gnus-auto-expirable-newsgroups} will have all articles that you +read marked as expirable automatically. All articles that are marked as +expirable have an "X" in the third column in the Summary buffer. + +Let's say you subscribe to a couple of mailing lists, and you want the +articles you have read to disappear after a while: + +@example +(setq gnus-auto-expirable-newsgroups + "^mail.nonsense-list\\|^mail.nice-list") +@end example + +@vindex nnmail-expiry-wait +The @code{nnmail-expiry-wait} variable supplies the default time an +expirable article has to live. The default is 7 - seven days. + +Gnus also supplies a function that lets you fine-tune how long articles +are to live, based on what newsgroup they are in. Let's say you want to +have one month expiry period in the @samp{mail.private} newsgroup, a +one day expiry period in the @samp{mail.junk} newsgroup, and a six day +expiry period everywhere else: + +@example +(setq nnmail-expiry-wait-function + '(lambda (group) + (cond ((string= group "mail.private") + 31) + ((string= group "mail.junk") + 1) + (t + 6)))) +@end example + +@node nnmail +@subsubsection nnmail + +@vindex nnmail-active-file +@vindex nnmail-mbox-file +The @dfn{nnmail} backend will use the standard Un*x mbox file to store +mail. The path of the mbox file is given by the @code{nnmail-mbox-file} +variable. In addition, Gnus needs to store information about active +articles. The file specified by @code{nnmail-active-file} will be used +for that. + +@node nnrmail +@subsubsection nnrmail + +@vindex nnrmail-active-file +@vindex nnrmail-mbox-file +The @dfn{nnrmail} backend will use a babyl mail box to store mail. The +path of the rmail mail box file is given by the @code{nnrmail-mbox-file} +variable. In addition, Gnus needs to store information about active +articles. The file specified by @code{nnrmail-active-file} will be used +for that. + +@node nnml +@subsubsection nnml + +The spool mail format (@code{nnml}) isn't compatible with any other +known format. It should be used with some caution. + +@vindex nnml-directory +If you use this backend, Gnus will split all incoming mail into files; +one file for each mail and put the articles into the correct directories +under the directory specified by the @code{nnml-directory} variable. The +default value is @samp{"~/Mail/"}. + +You do not have to create any directories beforehand; Gnus will take +care of all that. + +If you have a strict limit as to how many files you are allowed to store +in your account, you should not use this backend. As each mail gets its +own file, you might very well occupy thousands of inodes within a few +weeks. If this is no problem for you, and it isn't a problem for you +having your friendly systems administrator walking around, madly, +shouting "Who is eating all my inodes?! Who? Who!?!", then you should +know that this is probably the fastest format to use. You do not have to +trudge through a big mbox file just to read your new mail. + +@node Listing Groups +@section Listing Groups + +@table @kbd +@item l +@kindex l (Group) +@findex gnus-group-list-groups +List all subscribed groups that have unread articles +(@code{gnus-group-list-groups}). +If the numeric prefix is used, this command will list only newsgroups of +level ARG and lower. By default, it only lists newsgroups of level five +or lower (ie. just subscribed groups). +@item L +@kindex L (Group) +@findex gnus-group-list-all-groups +List all subscribed and unsubscribed newsgroups, whether they have +unread articles or not (@code{gnus-group-list-all-groups}). +If the numeric prefix is used, this command will list only newsgroups of +level ARG and lower. By default, it lists newsgroups of level seven or +lower (ie. just subscribed and unsubscribed groups). +@item C-c C-k +@kindex C-c C-k (Group) +@findex gnus-group-list-killed +List all killed newsgroups (@code{gnus-group-list-killed}). +@item C-c C-z +@kindex C-c C-z (Group) +@findex gnus-group-list-zombies +List all zombie newsgroups (@code{gnus-group-list-zombies}). +@end table + +@node Newsgroup Maintenance +@section Newsgroup Maintenance + +@table @kbd +@item b +@kindex b (Group) +@findex gnus-group-check-bogus-groups +Check bogus groups and delete them +(@code{gnus-group-check-bogus-groups}). +@item F +@kindex F (Group) +@findex gnus-find-new-newsgroups +Find new newsgroups (@code{gnus-find-new-newsgroups}). +@item C-c C-x +@kindex C-c C-x (Group) +@findex gnus-group-expire-articles +Run all expirable articles in the current newsgroup through the expiry +process (if any) (@code{gnus-group-expire-articles}). +@item C-c M-C-x +@kindex C-c M-C-x (Group) +@findex gnus-group-expire-all-groups +Run all articles in all newsgroups through the expiry process +(@code{gnus-group-expire-all-groups}). +@end table + +@node Browse Foreign Server +@section Browse Foreign Server + +@table @kbd +@item B +@kindex B (Group) +@findex gnus-group-browse-foreign-server +You will be queried for a select method and a server name. Gnus will +then attempt to contact this server and let you browse the newsgroups +there (@code{gnus-group-browse-foreign-server}). +@end table + +A new buffer with a list of available newsgroups will appear. This +buffer will be in the @code{gnus-browse-server-mode}. This buffer looks +a bit (well, a lot) like a normal Newsgroup buffer, but with one major +difference - you can't enter any of the newsgroups. If you want to read +any of the news available on that server, you have to subscribe to the +newsgroups you think may be interesting, and then you have to exit this +buffer. The new groups will be added to the Newsgroup buffer, and then +you can read them as you would any other newsgroup. + +Here's a list of keystrokes available in the browse mode: + +@table @kbd +@item C-n, n +@kindex C-n (Browse) +@kindex n (Browse) +@findex gnus-group-next-group +Go to the next group (@code{gnus-group-next-group}). +@item C-p, p +@kindex C-p (Browse) +@kindex p (Browse) +@findex gnus-group-prev-group +Go to the previous group (@code{gnus-group-prev-group}). +@item u +@kindex u (Browse) +@findex gnus-browse-unsubscribe-current-group +Unsubscribe to the current group, or, as will be the case here, +subscribe to it (@code{gnus-browse-unsubscribe-current-group}). +@item q +@kindex q (Browse) +@findex gnus-browse-exit +Exit browse mode (@code{gnus-browse-exit}). +@item ? +@kindex ? (Browse) +@findex gnus-browse-describe-briefly +Describe browse mode briefly (well, there's not much to describe, is +there) (@code{gnus-browse-describe-briefly}). +@end table + +@node Exiting Gnus +@section Exiting Gnus + +Yes, Gnus is exiting. + +@table @kbd +@item z +@kindex z (Group) +@findex gnus-group-suspend +Suspend Gnus (@code{gnus-group-suspend}). +@item q +@kindex q (Group) +@findex gnus-group-exit +Quit Gnus (@code{gnus-group-exit}). +@item Q +@kindex Q (Group) +@findex gnus-group-quit +Quit Gnus without saving any startup files (@code{gnus-group-quit}). +@end table + +@vindex gnus-exit-gnus-hook +@vindex gnus-suspend-gnus-hook +@code{gnus-suspend-gnus-hook} is called when you suspend Gnus and +@code{gnus-exit-gnus-hook} is called when you quit Gnus. + +@node Misc Newsgroup Stuff +@section Misc Newsgroup Stuff + +@table @kbd +@item g +@kindex g (Group) +@findex gnus-group-get-new-news +Check server for new articles. +If the numeric prefix is used, this command will check only newsgroups of +level ARG and lower (@code{gnus-group-get-new-news}). +@item R +@kindex R (Group) +@findex gnus-group-restart +Restart Gnus (@code{gnus-group-restart}). +@item D +@kindex D (Group) +@findex gnus-group-describe-group +Give a description of the current newsgroup +(@code{gnus-group-describe-group}). +@item a +@kindex a (Group) +@findex gnus-group-post-news +Post an article to a newsgroup (@code{gnus-group-post-news}). +@item m +@kindex m (Group) +@findex gnus-group-mail +Mail a message somewhere (@code{gnus-group-mail}). +@item C-x C-t +@kindex C-x C-t (Group) +@findex gnus-group-transpose-groups +Transpose two newsgroups (@code{gnus-group-transpose-groups}). +@item V +@kindex V (Group) +@findex gnus-version +Display current Gnus version numbers (@code{gnus-version}). +@item ? +@kindex ? (Group) +@findex gnus-group-describe-briefly +Give a very short help message (@code{gnus-group-describe-briefly}). +@item C-c C-i +@kindex C-c C-i (Group) +@findex gnus-info-find-node +Go to the Gnus info node (@code{gnus-info-find-node}). +@end table + +@vindex gnus-group-prepare-hook +@code{gnus-group-prepare-hook} is called after the newsgroup list is +created in the Newsgroup buffer. It may be used to modify the newsgroup +buffer in some strange, unnatural way. + +@node The Summary Buffer +@chapter The Summary Buffer + +A line for each article is displayed in the Summay buffer. You can move +around, read articles, post articles and reply to them. + +@menu +* Summary Buffer Format:: Deciding how the summar buffer is to look +* Summary Manouvering:: Moving around the Summary buffer +* Choosing Articles:: Reading articles +* Paging the Article:: Scrolling the current article +* Reply Followup and Post:: Posting articles +* Cancelling and Superceding:: "Whoops, I shouldn't have called him that" +* Ticking and Marking:: Marking articles as read, expirable, etc. +* Threading:: How threads are made +* Exiting the Summary Buffer:: Returning to the Newsgroup buffer +* Saving Articles:: Ways of customizing article saving +* Decoding Articles:: Gnus can treat series of (uu)encoded articles. +* Various Article Stuff:: Various stuff dealing with articles +* Summary Sorting:: You can sort the summary buffer four ways +* Finding the Parent:: No child support? Get the parent +* Kill Files:: Maintaining a kill file +* Various Summary Stuff:: What didn't fit anywhere else +@end menu + +@node Summary Buffer Format +@section Summary Buffer Format + +@vindex gnus-summary-line-format +You can change the format of the lines in the summary buffer by changing +the @code{gnus-summary-line-format} variable. It works along the same +lines a a normal @code{format} string, with some extensions. + +The default string is @samp{"%U%R%X %I[%3L: %-20,20n]%T %S\n"}. + +The following format specification characters are understood: + +@table @samp +@item N +Article number +@item S +Subject +@item F +From +@item n +The name (from the @code{From} header field) +@item A +The address (from the @code{From} header field) +@item L +Number of lines in the article +@item I +Indentation based on thread level +@item T +Nothing if the article is a root and lots of spaces if it isn't (it +pushes everything after it off the screen) +@item C +Current article +@item U +Unread +@item X +Expirable +@item R +Replied +@item x +Xref +@item D +Date +@item M +Message-ID +@item r +References +@end table + +No elements are required, except the @samp{%U}, @samp{%R} and @samp{%X} +fields which have to be at the beginning of the line for reasons of +efficiency. If you try to remove those, or change them, you'll probably +end up with a mess. + +@vindex gnus-summary-mode-line-format +You can also change the format of the Summary mode bar. Set +@code{gnus-summary-mode-line-format} to whatever you like. Here's what +elements you have to play with: + +@table @samp +@item G +Group name +@item A +Current article number +@item V +Gnus version +@item U +Number of unread articles in this group +@item u +Number of unselected articles in this group +@item Z +A string with the number of unread and unselected articles represented +either as @samp{<%U(+%u) more>} if there are both unselected articles, +and just as @samp{<%U more>} if there are just unread articles and no +unselected ones. +@end table + +@node Summary Manouvering +@section Summary Manouvering + +All the straight movement commands understand the numeric prefix and +behave pretty much as you'd expect. + +None of these commands select articles. + +@table @kbd +@item C-n, down +@kindex C-n (Summary) +@kindex down (Summary) +@findex gnus-summary-next-subject +Go to the next subject line (@code{gnus-summary-next-subject}). +@item C-p, up +@kindex C-p (Summary) +@kindex up (Summary) +@findex gnus-summary-prev-subject +Go to the previous subject line (@code{gnus-summary-prev-subject}). +@item M-n +@kindex M-n (Summary) +@findex gnus-summary-next-unread-subject +Go to the next summary line of an unread article +(@code{gnus-summary-next-unread-subject}). +@item M-p +@kindex M-p (Summary) +@findex gnus-summary-prev-unread-subject +Go to the previous summary line of an unread article +(@code{gnus-summary-prev-unread-subject}). +@item j +@kindex j (Summary) +@findex gnus-summary-goto-subject +Ask for an article number and then go to this summary line +(@code{gnus-summary-goto-subject}). +@item l +@kindex l (Summary) +@findex gnus-summary-goto-last-article +Go to the summary line of the previous article +(@code{gnus-summary-goto-last-article}). +@end table + +@vindex gnus-auto-select-next +If you are at the end of the newsgroup and issue one of the movement +commands, Gnus will offer to go to the next newsgroup. If +@code{gnus-auto-select-next} is t and the next newsgroup is empty, Gnus +will exit Summary mode and return to the Newsgroup buffer. If this +variable is neither t nor nil, Gnus will select the next newsgroup, no +matter if it has any unread articles or not. As a special case, if this +variable equals @code{quietly}, Gnus will select the next newsgroup +without asking for confirmation. Also see @code{gnus-keep-same-level}. + +@vindex gnus-auto-center-summary +If @code{gnus-auto-center-summary} is non-nil, Gnus will keep the point +in the Summary buffer centered at all times. This makes things quite +tidy, but if you have a slow network connection, or do simply not like +this un-Emacsism, you can set this variable to nil to get the normal +Emacs scrolling action. + +@node Choosing Articles +@section Choosing Articles + +All the movement commands understand the numeric prefix. + +All the following commands select an article. + +@table @kbd +@item SPACE +@kindex SPACE (Summary) +@findex gnus-summary-next-page +Select the current article, of, if that one's read already, the next +unread article (@code{gnus-summary-next-page}). +@item n +@kindex n (Summary) +@findex gnus-summary-next-unread-article +Go to next unread article (@code{gnus-summary-next-unread-article}). +@item p +@kindex p (Summary) +@findex gnus-summary-prev-unread-article +Go to previous unread article (@code{gnus-summary-prev-unread-article}). +@item N +@kindex N (Summary) +@findex gnus-summary-next-article +Go to the next article (@code{gnus-summary-next-article}). +@item P +@kindex P (Summary) +@findex gnus-summary-prev-article +Go to the previous article (@code{gnus-summary-prev-article}). +@item M-C-n +@kindex M-C-n (Summary) +@findex gnus-summary-next-same-subject +Go to the next article with the same subject +(@code{gnus-summary-next-same-subject}). +@item M-C-p +@kindex M-C-p (Summary) +@findex gnus-summary-prev-same-subject +Go to the previous article with the same subject +(@code{gnus-summary-prev-same-subject}). +@item . +@kindex . (Summary) +@findex gnus-summary-first-unread-article +Go to the first unread article (@code{gnus-summary-first-unread-article}). +@end table + +@vindex gnus-auto-extend-newsgroup +All the movement commands will try to go to the previous (or next) +article, even if that article isn't displayed in the Summary buffer if +@code{gnus-auto-extend-newsgroup} is non-nil. Gnus will fetch the +article from the server and present it in the Article buffer. + +@vindex gnus-select-article-hook +@code{gnus-select-article-hook} is called whenever an article is +selected. By default it makes any threads hidden under the current +article visible. + +@vindex gnus-mark-article-hook +@code{gnus-mark-article-hook} is called when an article is selected for +the first time. It is intended to be used for marking articles as read +automatically when articles are selected. + +@node Paging the Article +@section Scrolling the Article + +@table @kbd +@item SPACE +@kindex SPACE (Summary) +@findex gnus-summary-next-page +Pressing @kbd{SPACE} will scroll the current article forward one page, +or, if you have come to the end of the current article, will choose the +next article (@code{gnus-summary-next-page}). +@item DEL +@kindex DEL (Summary) +@findex gnus-summary-prev-page +Scoll the current article back one page (@code{gnus-summary-prev-page}). +@item RETURN +@kindex RETURN (Summary) +@findex gnus-summary-scroll-up +Scroll the current article one line forward +(@code{gnus-summary-scroll-up}). +@item < +@kindex < (Summary) +@findex gnus-summary-beginning-of-article +Scroll to the beginning of the article +(@code{gnus-summary-beginning-of-article}). +@item > +@kindex > (Summary) +@findex gnus-summary-end-of-article +Scroll to the end of the article (@code{gnus-summary-end-of-article}). +@end table + +@node Reply Followup and Post +@section Reply Followup and Post + +@kindex C-c C-c (Post) +All the commands for posting and mailing will put you in a post or mail +buffer where you can edit the article all you like, before you send the +article by pressing @kbd{C-c C-c}. + +@table @kbd +@item a +@kindex a (Summary) +@findex gnus-summary-post-news +Post an article to the current newsgroup +(@code{gnus-summary-post-news}). +@item f +@kindex f (Summary) +@findex gnus-summary-followup +Post a followup to the current article (@code{gnus-summary-followup}). +@item F +@kindex F (Summary) +@findex gnus-summary-followup-with-original +Post a followup to the current article and include the original message +(@code{gnus-summary-followup-with-original}). +@item r +@kindex r (Summary) +@findex gnus-summary-reply +Mail a reply to the author of the current article +(@code{gnus-summary-reply}). +@item R +@kindex R (Summary) +@findex gnus-summary-reply-with-original +Mail a reply to the author of the current article and include the +original message (@code{gnus-summary-reply-with-original}). +@item C-c C-f +@kindex C-c C-f (Summary) +@findex gnus-summary-mail-forward +Forward the current article to some other person +(@code{gnus-summary-mail-forward}). +@item m +@kindex m (Summary) +@findex gnus-summary-mail-other-window +Send a mail to some other person +(@code{gnus-summary-mail-other-window}). +@end table + +@vindex gnus-required-headers +Gnus determines which headers it should generate in outgoing posts by +consulting the @code{gnus-required-headers} variable. This is a list of +headers that Gnus makes sure is present in all outgoing posts before it +tries to post them. + +@vindex gnus-followup-to-function +@vindex gnus-reply-to-function +Gnus uses the normal methods to determine where replys and follow-ups +are to go, but you can change the behaviour to suit your need by +fiddling with the @code{gnus-reply-to-function} and +@code{gnus-followup-to-function} variables. + +To take "reply" as an example: If you want the replies to go to the +"sender" instead of the "from" in the newsgroup "mail.stupid-list", you +could do something like this: + +@example +(setq gnus-reply-to-function + '(lambda (group) + (cond ((string= group "mail.stupid-list") + (mail-fetch-field "sender")) + (t + nil)))) +@end example + +These functions will be called with point in the buffer of the article +that is being replied to (or followed up). + +@vindex mail-signature +@vindex gnus-signature-file +If @code{gnus-signature-file} is non-nil, it should be the name of a +file containing a signature (@samp{~/.signature} by default). This +signature will be appended to all outgoing post. Most people find it +more convenient to use @code{mail-signature}, which does the same, but +inserts the signature into the buffer before you start editing the post +(or mail). So - if you have both of these variables set, you will get +two signatures. + +@vindex gnus-post-prepare-function +In any case, @code{gnus-post-prepare-function} is called with the name +of the current newsgroup after the post buffer has been initialized, and +can be used for inserting a signature. Nice if you use different +signatures in different newsgroups. + +@vindex gnus-auto-mail-to-author +If @code{gnus-auto-mail-to-author} is non-nil, Gnus will send a mail +with a copy of all follow-ups to the authors of the articles you follow +up. It's nice in one way - you make sure that the person you are +responding to gets your response. Other people loathe this method and +will hate you dearly for it, because it means that they will first get a +mail, and then have to read the same article later when they read the +news. It is nil by default. + +@vindex gnus-mail-send-method +@code{gnus-mail-send-method} says how a mail should be mailed. It uses +the function in the @code{send-mail-function} as the default. + +@vindex gnus-prepare-article-hook +@code{gnus-prepare-article-hook} is called before the header fields have +been prepared. By default it inserts the signature specified by +@code{gnus-signature-file}. + +@vindex gnus-inews-article-hook +@code{gnus-inews-article-hook} is called right before the article is +posted. By default it handles FCC processing (ie. saving the article to +a file.) + +@node Cancelling and Superceding +@section Cancelling Articles + +Have you ever written something, and then decided that you really, +really, really hadn't posted that? + +Well, you can't cancel mail, but you can cancel posts. + +@findex gnus-summary-cancel-article +@kindex C (Summary) +Find the article you wish to cancel (you can only cancel your own +articles, so don't try any funny stuff). Then press @kbd{C} +(@code{gnus-summary-cancel-article}). Your article will be cancelled. + +Be aware, however, that not all sites honor cancels, so your article may +live on in some parts of the world, while most sites will delete the +cancelled article. + +If you discover that you have made some mistakes and want to do some +corrections, you can post a @dfn{superceding} article that will replace +your original article. + +@findex gnus-summary-supersede-article +@kindex S (Summary) +Go to the original article and press @kbd{S} +(@code{gnus-summary-supersede-article}). You will be put in a buffer +where you can edit the article all you want before sending it off the +usual way. + +The same goes for superceding as for cancelling, only more so: Some +sites do not honor superceding. On those sites, it will appear that you +have posted almost the same article twice. + +If you have just posted the article, and changed your mind right away, +there is a trick yuo can use to cancel/supersede the article without +waiting for the article to appear on your site first. You simply return +to the post buffer (which is called @code{*post-buf*}). There you will +find the article you just posted, with all the headers intact. Change +the @samp{Message-ID} header to a @samp{Cancel} or @samp{Supersedes} +header by substituting one of those words for @samp{Message-ID}. Then +just press @kbd{C-c C-c} to send the article as you would do +normally. The previous article will be cancelled/superseded. + +@node Ticking and Marking +@section Ticking and Marking + +There are four kinds of @dfn{marks}: Tick marks, process marks, read +marks and expiry marks. + +@dfn{Ticked articles} are articles that will remain visible always. If +you see an article that you find interesting, or you want to put off +reading it, or replying to it, until sometime later, you'd typically +tick it. However, articles can be expired, so if you want to keep an +article forever, you'll have to save it. Ticked articles have a @samp{-} +in the first column. + +Articles that are marked as read - are just that. They have a @samp{D} +in the first column. Unread articles have a space in the first column. + +You can also mark articles as @dfn{expirable} (or have them marked as +such automatically). That doesn't make much sense in normal newsgroups, +because a user does not control the expiring of news articles, but in +mail newsgroups, for instance, articles that are marked as +@dfn{expirable} can be deleted by Gnus at any time. Expirable articles +have a @samp{X} in the third column. + +Finally we have the @dfn{process mark}. A variety of commands react to +the presence of the process mark. For instance, @kbd{C-c C-v M-C-v} +(@code{gnus-uu-decode-and-view-marked-articles}) will uudecode and view +all artciles that have been marked with the process mark. Articles +marked with the process mark have a @samp{#} in the third column. + +All the marking commands understand the numeric prefix. + +@table @kbd +@item ' +@kindex ' (Summary) +@findex gnus-summary-mark-as-unread-forward +Tick the current article (@code{gnus-summary-mark-as-unread-forward}). +@item d +@kindex d (Summary) +@findex gnus-summary-mark-as-read-forward +Mark the current article as read +(@code{gnus-summary-mark-as-read-forward}). +@item k +@kindex k (Summary) +@findex gnus-summary-kill-same-subject-and-select +Mark all articles that have the same subject as the current one as read, +and then select the next unread article +(@code{gnus-summary-kill-same-subject-and-select}). +@item C-k +@kindex C-k (Summary) +@findex gnus-summary-kill-same-subject +Mark all articles that have the same subject as the current one as read +(@code{gnus-summary-kill-same-subject}). +@item M-u +@kindex M-u (Summary) +@findex gnus-summary-clear-mark-forward +Clear tick and read marks from the current article +(@code{gnus-summary-clear-mark-forward}). +@item x +@kindex x (Summary) +@findex gnus-summary-mark-as-expirable +Mark the current article as expirable +(@code{gnus-summary-mark-as-expirable}). +@item X +@kindex X (Summary) +@findex gnus-summary-unmark-as-expirable +Remove the expiry mark from the current article +(@code{gnus-summary-unmark-as-expirable}). +@item M-d +@kindex M-d (Summary) +@findex gnus-summary-delete-marked-as-read +Remove all deleted articles from the Summary buffer +(@code{gnus-summary-delete-marked-as-read}). +@item M-C-d +@kindex M-C-d (Summary) +@findex gnus-summary-delete-marked-with +Ask for a mark and then remove all articles that have been marked with +that mark (@code{gnus-summary-delete-marked-with}). +@end table + +There are a few functions for setting the process mark: + +@table @kbd +@item # +@kindex # (Summary) +@findex gnus-summary-mark-article-as-processable +Mark the current article with the process mark +(@code{gnus-summary-mark-article-as-processable}). +@findex gnus-summary-unmark-article-as-processable +@item M-# +@kindex M-# (Summary) +Remove the process mark from the current article +(@code{gnus-summary-unmark-article-as-processable}). +@item C-c M-# +@kindex C-c M-# (Summary) +@findex gnus-summary-unmark-all-articles-as-processable +Remove the process mark from all articles +(@code{gnus-summary-unmark-all-articles-as-processable}). +@item C-c C-v C-r +@kindex C-c C-v C-r (Summary) +@findex gnus-uu-mark-by-regexp +Mark articles by a regular expression (@code{gnus-uu-mark-by-regexp}). +@item C-c C-v r +@kindex C-c C-v r (Summary) +@findex gnus-uu-mark-region +Mark articles in the region (@code{gnus-uu-mark-region}). +@item C-c C-v t +@kindex C-c C-v t (Summary) +@findex gnus-uu-mark-thread +Mark all articles in the current (sub)thread +(@code{gnus-uu-mark-thread}). +@end table + +@findex gnus-uu-marked-universal-argument +@kindex C-c C-v C-u (Summary) +Finally, we have @kbd{C-c C-v C-u} +(@code{gnus-uu-marked-universal-argument}) that will perform any +operation on all articles that have been marked with the process mark. + +@node Threading +@section Threading + +Gnus @dfn{threads} articles by default. @dfn{Threading} is to put +replies to articles directly after the articles they reply to - in a +hierarchial fashion. + +@menu +* Customizing Threading:: Variables you can change to affect the threading +* Threading Commands:: Thread based commands in the Summary Buffer +@end menu + +@node Customizing Threading +@subsection Customizing Threading + +@table @code +@item gnus-show-threads +@vindex gnus-show-threads +If this variable is nil, no threading will be done, and all of the rest +of the variables here will have no effect. Turning threading off will +speed newsgroup selection up a bit, but it is sure to make reading +slower and more awkward. +@item gnus-gather-loose-threads +@vindex gnus-gather-loose-threads +If non-nil, Gnus will gather all loose subtrees into one big tree and +create a dummy root at the top. (Wait a minute. Root at the top? Yup.) +Loose subtrees occur when the real root has expired, or you've read it +in a previous session. +@item gnus-summary-print-dummy-lines +@vindex gnus-summary-print-dummy-lines +If non-nil, Gnus will print those dummy roots described above. It it is +nil, the dummy roots won't be printed, but the gathering will still take +place (if @code{gnus-gather-loose-threads} is non-nil, that is.) +@item gnus-thread-hide-subtree +@vindex gnus-thread-hide-subtree +If non-nil, all subtrees will be hidden when the Summary buffer is +generated. +@item gnus-thread-hide-killed +@vindex gnus-thread-hide-killed +if you kill a thread and this variable is non-nil, the subtree will be +hidden. +@item gnus-thread-ignore-subject +@vindex gnus-thread-ignore-subject +Sometimes somebody changes the subject in the middle of a thread. If +this variable is non-nil, the change in subject is ignored. If it is +nil, which is the default, a change in the subject will result in a new +thread. +@item gnus-thread-indent-level +@vindex gnus-thread-indent-level +This is a number which says how many spaces to indent a thread. The +default is @samp{4}. +@end table + +@node Threading Commands +@subsection Threading Commands + +@table @kbd +@item M-C-k +@kindex M-C-k (Summary) +@findex gnus-summary-kill-thread +Mark all articles under the current one as read +(@code{gnus-summary-kill-thread}). If the prefix argument is positive, +remove all marks. If the prefix argument is negative, tick articles. +@item M-C-t +@kindex M-C-t (Summary) +@findex gnus-summary-toggle-threads +Toggle showing threads (@code{gnus-summary-toggle-threads}). +@item M-C-s +@kindex M-C-s (Summary) +@findex gnus-summary-show-thread +Show the thread hidden under the current article, if any +(@code{gnus-summary-show-thread}). +@item M-C-h +@kindex M-C-h (Summary) +@findex gnus-summary-hide-thread +Hide the current (sub)thread (@code{gnus-summary-hide-thread}). +@end table + +The following commands are all thread movement commands. They all +understand the numeric prefix. + +@table @kbd +@item M-C-f +@kindex M-C-f (Summary) +@findex gnus-summary-next-thread +Go to the next thread (@code{gnus-summary-next-thread}). +@item M-C-b +@kindex M-C-b (Summary) +@findex gnus-summary-prev-thread +Go to the previous thread (@code{gnus-summary-prev-thread}). +@item M-C-d +@kindex M-C-d (Summary) +@findex gnus-summary-down-thread +Descend the thread (@code{gnus-summary-down-thread}). +@item M-C-u +@kindex M-C-u (Summary) +@findex gnus-summary-up-thread +Ascend the thread (@code{gnus-summary-up-thread}). +@end table + +@node Exiting the Summary Buffer +@section Exiting the Summary Buffer + +@table @kbd +@item q +@kindex q (Summary) +@findex gnus-summary-exit +Exit the current newsgroup and update all the information +(@code{gnus-summary-exit}). +@item Q +@kindex Q (Summary) +@findex gnus-summary-quit +Exit the current newsgroup without updating any information +(@code{gnus-summary-quit}). +@item c +@kindex c (Summary) +@findex gnus-summary-catchup-and-exit +Mark all articles in the newsgroup as read and exit +(@code{gnus-summary-catchup-and-exit}). +@end table + +@vindex gnus-exit-group-hook +@code{gnus-exit-group-hook} is called when you exit the current +newsgroup. + +@vindex gnus-use-cross-reference +When you exit the Summary buffer, the data on the current newsgroup will +be updated (which articles you have read, which articles you have +replied to, etc.) If the @code{gnus-use-cross-reference} variable is +non-nil, articles that are cross-referenced to this newsgroup, and are +marked as read, will also be marked as read in the other newsgroups they +were cross-posted to. This ensures that you'll never have to read the +same article more than once. + +Unless, of course, somebody has posted it to several newsgroups +separately. + +One other thing that may cause Gnus to not do the cross-posting thing +correctly is if you use an NNTP server that supports xover (which is +very nice, because it speeds things up considerably) which does not +include the Xref header in its NOV lines. This is Evil, but it's +common. Gnus tries to Do The Right Thing even with xover by registering +the Xref lines of all articles you actually read, but if you kill the +articles, or just mark them as read without reading them, Gnus will not +get a chance to snoop the Xref lines out of these articles, and will be +unable to use the cross reference mechanism. + +@vindex nntp-xover-is-evil +If you want Gnus to get the Xrefs right all the time, you have to set +@code{nntp-xover-is-evil} to t, which slows things down considerably. + +C'est la vie. + +@node Saving Articles +@section Saving Articles + +Gnus can save articles in a number of ways. Below is the documentation +for saving articles in a fairly straight-forward fashion (ie. little +processing of the article is done before it is saved). For a different +approach (uudecoding, unsharing, digesting) see gnus-uu. + +@vindex gnus-save-all-headers +If @code{gnus-save-all-headers} is non-nil, Gnus will not delete +unwanted headers before saving the article. + +@table @kbd +@item o +@kindex o (Summary) +@findex gnus-summary-save-article +Save the current article (@code{gnus-summary-save-article}). +@item C-o +@kindex C-o (Summary) +@findex gnus-summary-save-in-mail +Save the current article in mail format +(@code{gnus-summary-save-in-mail}). +@end table + +@vindex gnus-default-article-saver +You can customize the @code{gnus-default-article-saver} variable to make +Gnus what you want it to. You can use any of the four ready-made +functions below, or you can create your own. + +@table @code +@item gnus-summary-save-in-rmail +@vindex gnus-summary-save-in-rmail +This is the format Gnus uses by default, @dfn{babyl}. +Uses the function in the @code{gnus-rmail-save-name} variable to get a +file name to save the article in. The default is +@code{gnus-plain-save-name}. +@item gnus-summary-save-in-mail +@vindex gnus-summary-save-in-mail +Save in a Unix mail (mbox) file. +Uses the function in the @code{gnus-mail-save-name} variable to get a +file name to save the article in. The default is +@code{gnus-plain-save-name}. +@item gnus-summary-save-in-file +@vindex gnus-summary-save-in-file +Append the article straight to an ordinary file. +Uses the function in the @code{gnus-file-save-name} variable to get a +file name to save the article in. The default is +@code{gnus-numeric-save-name}. +@item gnus-summary-save-in-folder +@vindex gnus-summary-save-in-folder +Save the article to an MH folder using @code{rcvstore} from the MH +library. +@end table + +All of these functions, except for the last one, will save the article +in the @code{gnus-article-save-directory}, which is initialized from the +@samp{SAVEDIR} environment variable. + +As you can see above, the functions use different functions to find a +suitable name of a file to save the article in. Below is a list of +available functions that generates names: + +@table @code +@item gnus-Numeric-save-name +@findex gnus-Numeric-save-name +Generates file names that look like @samp{~/News/Alt.andrea-dworkin/45}. +@item gnus-numeric-save-name +@findex gnus-numeric-save-name +Generates file names that look like @samp{~/News/alt.andrea-dworkin/45}. +@item gnus-Plain-save-name +@findex gnus-Plain-save-name +Generates file names that look like @samp{~/News/Alt.andrea-dworkin}. +@item gnus-plain-save-name +@findex gnus-plain-save-name +Generates file names that look like @samp{~/News/alt.andrea-dworkin}. +@end table + +@vindex gnus-use-long-file-name +Finally, you have the @code{gnus-use-long-file-name} variable. If it is +nil, all the preceding functions will replace all periods (@samp{.}) in +the newsgroup names with slashes (@samp{/}) - which means that the +functions will generate hierarchies of directories instead of having all +the files in the toplevel directory (@samp{~/News/alt/andrea-dworkin} +instead of @samp{~/News/alt.andrea-dworkin}.) + +@node Decoding Articles +@section Decoding Articles + +Gnus has a plethora of functions for handling series of (uu)encoded +articles. Gnus can find out by itself what articles belong to one +series, decode all the articles and unpack/view/save the resulting +file(s). All these functions belong to the `gnus-uu' package and are +reached from the Summary buffer as three-key keystrokes: @key{C-c C-v +KEY}. That last key varies, of course, but all these functions use the +@key{C-c C-v} prefix keystroke. + +Gnus guesses what articles are in the series according to the following +simplish rule: The subjects must be (nearly) identical, except for the +last two numbers of the line. (Spaces are largely ignored, however.) + +For example: If you choose a subject called @samp{cat.gif (2/3)}, Gnus +will find all the articles that match the regexp @samp{^cat.gif +([0-9]+/[0-9]+).*$}. + +Subjects that are nonstandard, like @samp{cat.gif (2/3) Part 6 of a +series}, will not be properly recognized by any of the automatic viewing +commands, and you have to mark the articles manually with @key{#}. + +@menu +* Decoding Commands:: Decoding in various ways. +* Setting the Process Mark:: You can mark which articles to work on. +* Other Related Commands:: Other related commands. +* Viewing Files:: You can view the resulting decoded files. +* Decoding Variables:: No, you do not have to decode any variables. +@end menu + +@node Decoding Commands +@subsection Decoding Commands + +All the keystrokes for decoding follow a strict pattern. + +@table @key +@item C-c C-v C-KEY +This is a function for decoding and viewing. +@item C-c C-v KEY +This is a function for decoding and saving. +@item C-c C-v M-C-KEY +This is a function for decoding and viewing marked articles. +@item C-c C-v M-KEY +This is a function for decoding and saving marked articles. +@end table + +@menu +* Decoding With uudecode:: The most common encoding on the net. +* Decoding With unshar:: This is used some in source groups. +* Decoding With Other Decoders:: Binhex and plain save. +@end menu + +@node Decoding With uudecode +@subsubsection Decoding With uudecode + +@table @key +@item C-c C-v C-v +@kindex C-c C-v C-v (Summary) +@findex gnus-uu-decode-and-view +Decode and view the series of articles that the current article is a +part of (@code{gnus-uu-decode-and-view}). +@item C-c C-v v +@kindex C-c C-v v (Summary) +@findex gnus-uu-decode-and-save +Decode and save the series of articles that the current article is a +part of (@code{gnus-uu-decode-and-save}). +@item C-c C-v M-C-v +@kindex C-c C-v M-C-v (Summary) +@findex gnus-uu-marked-decode-and-view +Decode and view the marked articles +(@code{gnus-uu-marked-decode-and-view}). +@item C-c C-v M-v +@kindex C-c C-v M-v (Summary) +@findex gnus-uu-marked-decode-and-view +Decode and save the marked articles +(@code{gnus-uu-marked-decode-and-view}). +@item C-c C-v C-w +@kindex C-c C-v C-w (Summary) +@findex gnus-uu-decode-and-view-all-articles +Decode and view all articles in the newsgroup +(@code{gnus-uu-decode-and-view-all-articles}). +@item C-c C-v w +@kindex C-c C-v w (Summary) +@findex gnus-uu-decode-and-save-all-articles +Decode and save all articles in the newsgroup +(@code{gnus-uu-decode-and-save-all-articles}). +@item C-c C-v M-C-w +@kindex C-c C-v M-C-w (Summary) +@findex gnus-uu-decode-and-view-all-marked-files +Decode and view all series of articles that are marked +(@code{gnus-uu-decode-and-view-all-marked-files}). +@item C-c C-v M-w +@kindex C-c C-v M-w (Summary) +@findex gnus-uu-decode-and-save-all-marked-files +Decode and save all series of articles that are marked +(@code{gnus-uu-decode-and-save-all-marked-files}). +@item C-c C-v C-a +@kindex C-c C-v C-a (Summary) +@findex gnus-uu-decode-and-view-all-articles +Decode and view all unread articles in the newsgroup +(@code{gnus-uu-decode-and-view-all-articles}). +@item C-c C-v a +@kindex C-c C-v a (Summary) +@findex gnus-uu-decode-and-save-all-articles +Decode and save all unread articles in the newsgroup +(@code{gnus-uu-decode-and-save-all-articles}). +@item C-c C-v C-b +@kindex C-c C-v C-b (Summary) +@findex gnus-uu-decode-and-show-in-buffer +Decode the current article and show the result in the article +buffer. This might be useful if somebody has encoded (parts of) an +article, for some strange reason +(@code{gnus-uu-decode-and-show-in-buffer}). +@end table + +The @code{gnus-uu-decode-and-save-all-marked-files} need some +explanation. It allows you to mark all articles that are part of series +of articles you are interested in in a newsgroup. You only have to mark +one article for each series of articles you want, and then you call this +function, which will find all articles that are part of the series you +want. Is that clear? And they say it's a stupid idea getting drunk +before writing documentation! Bah! + +@node Decoding With unshar +@subsubsection Decoding With unshar + +Using @code{unshar} introduces rather large security holes - it actually +runs the code it finds in the articles. So you should, at least, peek +through the articles you want to unshar before using these functions. + +@table @kbd +@item C-c C-v C-s +@kindex C-c C-v C-s (Summary) +@findex gnus-uu-shar-and-view +@kindex C-c C-v C-s (Summary) +@findex gnus-uu-shar-and-view +Unshar and view the series of articles that the current article is a +part of (@code{gnus-uu-shar-and-view}). +@item C-c C-v s +@kindex C-c C-v s (Summary) +@findex gnus-uu-shar-and-save +@kindex C-c C-v s (Summary) +@findex gnus-uu-shar-and-save +Unshar and save the series of articles that the current article is a +part of (@code{gnus-uu-shar-and-save}). +@item C-c C-v M-C-s +@kindex C-c C-v M-C-s (Summary) +@findex gnus-uu-marked-shar-and-view +@kindex C-c C-v M-C-s (Summary) +@findex gnus-uu-marked-shar-and-view +Unshar and view the marked articles +(@code{gnus-uu-marked-shar-and-view}). +@item C-c C-v M-s +@kindex C-c C-v M-s (Summary) +@findex gnus-uu-marked-shar-and-view +@kindex C-c C-v M-s (Summary) +@findex gnus-uu-marked-shar-and-view +Unshar and save the marked articles +(@code{gnus-uu-marked-shar-and-view}). +@end table + +@node Decoding With Other Decoders +@subsubsection Decoding With Other Decoders + +These commands are entry points to all the decoding methods Gnus knows - +uudecode, unshar, unbinhex and save. You will be prompted for what +method you want to employ. + +@table @kbd +@item C-c C-v C-m +@kindex C-c C-v C-m (Summary) +@findex gnus-uu-multi-decode-and-view +Decode (by some method) and view the series of articles that the current +article is a part of (@code{gnus-uu-multi-decode-and-view}). +@item C-c C-v m +@kindex C-c C-v m (Summary) +@findex gnus-uu-multi-decode-and-save +Decode (by some method) and save the series of articles that the current +article is a part of (@code{gnus-uu-multi-decode-and-save}). +@item C-c C-v M-C-m +@kindex C-c C-v M-C-m (Summary) +@findex gnus-uu-marked-multi-decode-and-view +Decode (by some method) and view the marked articles +(@code{gnus-uu-marked-multi-decode-and-view}). +@item C-c C-v M-m +@kindex C-c C-v M-m (Summary) +@findex gnus-uu-marked-multi-decode-and-view +Decode (by some method) and save the marked articles +(@code{gnus-uu-marked-multi-decode-and-view}). +@item C-c C-v C-j +@kindex C-c C-v C-j (Summary) +@findex gnus-uu-threaded-multi-decode-and-view +Decode (by some method) and view all articles in the current thread +(@code{gnus-uu-threaded-multi-decode-and-view}). +@item C-c C-v C-j +@kindex C-c C-v C-j (Summary) +@findex gnus-uu-threaded-multi-decode-and-view +Decode (by some method) and save all articles in the current thread +(@code{gnus-uu-threaded-multi-decode-and-view}). +@end table + +@node Setting the Process Mark +@subsection Setting the Process Mark + +The process mark is used by other parts of Gnus, not just the `gnus-uu' +package. However, this is where it is most useful, so it adds some +further methods for setting the mark. + +@table @kbd +@item C-c C-v C-r +@kindex C-c C-v C-r (Summary) +@findex gnus-uu-mark-by-regexp +Mark articles by a regular expression (@code{gnus-uu-mark-by-regexp}). +@item C-c C-v r +@kindex C-c C-v r (Summary) +@findex gnus-uu-mark-region +Mark all articles between point and mark (@code{gnus-uu-mark-region}). +@item C-c C-v t +@kindex C-c C-v t (Summary) +@findex gnus-uu-mark-thread +Mark all articles downward in the current thread +(@code{gnus-uu-mark-thread}). +@end table + +@node Other Related Commands +@subsection Other Related Commands + +@table @key +@item C-c C-v f +@kindex C-c C-v f (Summary) +@findex gnus-uu-digest-and-forward +Digest and forward all articles that are part of a series +(@code{gnus-uu-digest-and-forward}). +@item C-c C-v M-f +@kindex C-c C-v M-f (Summary) +@findex gnus-uu-marked-digest-and-forward +Digest and forward all marked articles +(@code{gnus-uu-marked-digest-and-forward}). +@item C-c C-v C-i +@kindex C-c C-v C-i (Summary) +@findex gnus-uu-toggle-interactive-view +Instead of having windows popping up automatically, it can be handy to +view files interactivly, especially when viewing archives +(@code{gnus-uu-toggle-interactive-view}). +@item C-c C-v C-t +@kindex C-c C-v C-t (Summary) +@findex gnus-uu +Toggle any of the most important @code{gnus-uu} variables +(@code{gnus-uu-toggle-any-variable}). +@item C-c C-v C-l +@kindex C-c C-v C-l (Summary) +@findex gnus-uu-edit-begin-line +Edit the @samp{begin} line of an uuencoded article, if any +(@code{gnus-uu-edit-begin-line}). +@item C-c C-v p +@kindex C-c C-v p (Summary) +@findex gnus-uu-post-news +Uuencode and post an file. If the file is large, it will be split into a +series of articles that will be posted (@code{gnus-uu-post-news}). +@end table + +@node Viewing Files +@subsection Viewing Files + +When using the view commands, @code{gnus-uu-decode-and-view} for +instance, Gnus will (normally, see below) try to view the file according +to the rules given in @code{gnus-uu-default-view-rules} and +@code{gnus-uu-user-view-rules}. If it recognizes the file, it will +display it immediately. If the file is some sort of archive, Gnus will +attempt to unpack the archive and see if any of the files in the archive +can be viewed. For instance, if you have a gzipped tar file +@file{pics.tar.gz} containing the files @file{pic1.jpg} and +@file{pic2.gif}, Gnus will uncompress and detar the main file, and then +view the two pictures. This unpacking process is recursive, so if the +archive contains archives of archives, it'll all be unpacked. + +If the view command doesn't recognise the file type, or can't view it +because you don't have the viewer, or can't view *any* of the files in +the archive, the user will be asked if she wishes to have the file saved +somewhere. Note that if the decoded file is an archive, and Gnus +manages to view some of the files in the archive, it won't tell the user +that there were some files that were unviewable. Try interactive view +for a different approach. + +@node Decoding Variables +@subsection Decoding Variables + +@menu +* Rule Variables:: Variables that say how a file is to be viewed. +* Other Decode Variables:: Other decode variables. +@end menu + +@node Rule Variables +@subsubsection Rule Variables + +Gnus uses @dfn{rule} variables to decide how to view a file. All these +variables are on the form + +@example + (list '(regexp1 command2) + '(regexp2 command2) + ...) +@end example + +@table @code +@item gnus-uu-user-view-rules +@vindex gnus-uu-user-view-rules +This variable is consulted first when viewing files. If you wish to use, +for instance, @code{sox} to convert an @samp{.au} sound file, you could +say something like: +@example + (setq gnus-uu-user-view-rules + (list '(\"\\\\.au$\" \"sox %s -t .aiff > /dev/audio\"))) +@end example +@item gnus-uu-user-view-rules-end +@vindex gnus-uu-user-view-rules-end +This variable is consulted if Gnus couldn't make any matches from the +user and default view rules. +@item gnus-uu-user-interactive-view-rules +@vindex gnus-uu-user-interactive-view-rules +This is the variable used instead of @code{gnus-uu-user-view-rules} +when in interactive mode. +@item gnus-uu-user-interactive-view-rules-end +@vindex gnus-uu-user-interactive-view-rules-end +This variable is used instead of @code{gnus-uu-user-view-rules-end} when +in interactive mode. +@item gnus-uu-user-archive-rules +@vindex gnus-uu-user-archive-rules +This variable can be used to say what comamnds should be used to unpack +archives. +@end table + +@node Other Decode Variables +@subsubsection Other Decode Variables + +@table @code +@item gnus-uu-ignore-files-by-name +@vindex gnus-uu-ignore-files-by-name +Files with name matching this regular expression won't be viewed. + +@item gnus-uu-ignore-files-by-type +@vindex gnus-uu-ignore-files-by-type +Files with a MIME type matching this variable won't be viewed. Note +that Gnus tries to guess what type the file is based on the +name. gnus-uu is not a MIME package, so this is slightly kludgy. + +@item gnus-uu-tmp-dir +@vindex gnus-uu-tmp-dir +Where gnus-uu does its work. + +@item gnus-uu-do-not-unpack-archives +@vindex gnus-uu-do-not-unpack-archives +Non-nil means that gnus-uu won't peek inside archives looking for files +to dispay. + +@item gnus-uu-view-and-save +@vindex gnus-uu-view-and-save +Non-nil means that the user will always be asked to save a file after +viewing it. + +@item gnus-uu-asynchronous +@vindex gnus-uu-asynchronous +Non-nil means that files will be viewed asynchronously. This can be +useful if you're viewing long @file{.mod} files, for instance, which +often takes several minutes. Note, however, that since gnus-uu doesn't +ask, and if you are viewing an archive with lots of viewable files, +you'll get them all up more or less at once, which can be confusing, to +say the least. To get gnus-uu to ask you before viewing a file, set the +@code{gnus-uu-ask-before-view} variable. + +@item gnus-uu-ask-before-view +@vindex gnus-uu-ask-before-view +Non-nil means that gnus-uu will ask you before viewing each file. + +@item gnus-uu-ignore-default-view-rules +@vindex gnus-uu-ignore-default-view-rules +Non-nil means that gnus-uu will ignore the default viewing rules. + +@item gnus-uu-ignore-default-archive-rules +@vindex gnus-uu-ignore-default-archive-rules +Non-nil means that gnus-uu will ignore the default archive unpacking +commands. + +@item gnus-uu-kill-carriage-return +@vindex gnus-uu-kill-carriage-return +Non-nil means that gnus-uu will strip all carriage returns from +articles. + +@item gnus-uu-unmark-articles-not-decoded +@vindex gnus-uu-unmark-articles-not-decoded +Non-nil means that gnus-uu will mark articles that were unsuccessfully +decoded as unread. + +@item gnus-uu-output-window-height +@vindex gnus-uu-output-window-height +This variable says how tall the output buffer window is to be when using +interactive view mode. + +@item gnus-uu-correct-stripped-uucode +@vindex gnus-uu-correct-stripped-uucode +Non-nil means that gnus-uu will *try* to fix uuencoded files that have +had traling spaces deleted. + +@item gnus-uu-use-interactive-view +@vindex gnus-uu-use-interactive-view +Non-nil means that gnus-uu will use interactive viewing mode. + +@item gnus-uu-view-with-metamail +@vindex gnus-uu-view-with-metamail +Non-nil means that gnus-uu will ignore the viewing commands defined by +the rule variables and just fudge a MIME content type based on the file +name. The result will be fed to metamail for viewing. + +@item gnus-uu-save-in-digest +@vindex gnus-uu-save-in-digest +Non-nil means that gnus-uu, when asked to save without decoding, will +save in digests. If this variable is nil, gnus-uu will just save +everything in a file without any embellishments. The digesting almost +conforms to RFC1153 - no easy way to specify any meaningful volume and +issue numbers were found, so I simply dropped them. + +@item gnus-uu-post-include-before-composing +@vindex gnus-uu-post-include-before-composing +Non-nil means that gnus-uu will ask for a file to encode before you +compose the article. If this variable is t, you can either include an +encoded file with @key{C-c C-i} or have one included for you when you +post the article. + +@item gnus-uu-post-length +@vindex gnus-uu-post-length +Maximum length of an article. The encoded file will be split into how +many articles it takes to post the entire file. + +@item gnus-uu-post-threaded +@vindex gnus-uu-post-threaded +Non-nil means that gnus-uu will post the encoded file in a thread. This +may not be smart, as no other decoder I have seen are able to follow +threads when collecting uuencoded articles. (Well, I have seen one +package that does that - gnus-uu, but somehow, I don't think that +counts...) Default is nil. + +@item gnus-uu-post-separate-description +@vindex gnus-uu-post-separate-description +Non-nil means that the description will be posted in a separate article. +The first article will typically be numbered (0/x). If this variable is +nil, the description the user enters will be included at the beginning +of the first article, which will be numbered (1/x). Default is t. + +@end table + +@node Various Article Stuff +@section Various Article Stuff + +@table @kbd +@item w +@kindex w (Summary) +@findex gnus-summary-stop-page-breaking +Remove page breaking from the current article +(@code{gnus-summary-stop-page-breaking}). +@item C-c C-r +@kindex C-c C-r (Summary) +@findex gnus-summary-caesar-message +Do a Caesar rotate (rot13) on the article buffer +(@code{gnus-summary-caesar-message}). +@item g +@kindex g (Summary) +@findex gnus-summary-show-article +Select the current article (@code{gnus-summary-show-article}). +@item t +@kindex t (Summary) +@findex gnus-summary-toggle-header +Toggle whether to display all headers in the article buffer +(@code{gnus-summary-toggle-header}). +@item M-t +@kindex M-t (Summary) +@findex gnus-summary-toggle-mime +Toggle whether to run the article through MIME before displaying +(@code{gnus-summary-toggle-mime}). +@item | +@kindex | (Summary) +@findex gnus-summary-pipe-output +Pipe the current article through a filter +(@code{gnus-summary-pipe-output}). +@end table + +@node Summary Sorting +@section Summary Sorting + +You can have the Summary buffer sorted in various ways, even though I +can't really se why you'd want that. + +@table @kbd +@item C-c C-s C-n +@kindex C-c C-s C-n (Summary) +@findex gnus-summary-sort-by-number +Sort by article number (@code{gnus-summary-sort-by-number}). +@item C-c C-s C-a +@kindex C-c C-s C-a (Summary) +@findex gnus-summary-sort-by-author +Sort by author (@code{gnus-summary-sort-by-author}). +@item C-c C-s C-s +@kindex C-c C-s C-s (Summary) +@findex gnus-summary-sort-by-subject +Sort by subject (@code{gnus-summary-sort-by-subject}). +@item C-c C-s C-d +@kindex C-c C-s C-d (Summary) +@findex gnus-summary-sort-by-date +Sort by date (@code{gnus-summary-sort-by-date}). +@end table + +@node Finding the Parent +@section Finding the Parent + +@findex gnus-summary-refer-parent-article +@kindex ^ (Summary) +If you'd like to read the parent of the current article, and it is not +displayed in the article buffer, you might still be able to. That is, if +the current group is fetched by NNTP, the parent hasn't expired and the +References in the current article are not mangled, you can just press +@kbd{^} (@code{gnus-summary-refer-parent-article}). If everything goes +well, you'll get the parent. + +@findex gnus-summary-refer-article +@kindex M-^ (Summary) +You can also ask the NNTP server for an arbitrary article, no matter +what newsgroup it belongs to. @kbd{M-^} +(@code{gnus-summary-refer-article}) will ask you for a message-id, which +is one of those long thingies that look something like +@samp{<38o6up$6f2@@hymir.ifi.uio.no>}. You have to get it all exactly +right. + +@node Kill Files +@section Kill Files + +If a @dfn{kill file} for the current newsgroup exists, Gnus will read it +just after having gotten the article headers from the server. + +The kill files are files that may contain, in general, any elisp +functions. However, it is most common just to put functions that either +delete or undelete articles based on their headers in those files - +in short, killing articles. Hence the name. + +There are several commands reachable from the Summary buffer that +inserts commands for killing articles based on the current article. You +can, for instance, ask Gnus to kill all articles with a certain subject. + +If you get really irrirated with some annoying twit, you can kill the +author. Note that the author won't literally be killed, unless, of +course, he has an SCSI Gun Extension fitted to his machine. + +@menu +* Summary Kill Commands:: Adding simple kill commands to the kill file. +* Kill Mode:: A mode for editing the kill file. +* Kill Variables:: Customize your killing. (My, what terminology). +@end menu + +One note: I have seen a few people confused about what killing an +articles really does. Killing an article does not remove it from the +news server. It does not inhibit other people from reading the +article. It only means that you won't ever see that article, nothing +more. To really remove an article from the news server, you have to send +a cancel message, which you can't do if you haven't written the +article. (Well, you can, but that's Not Nice.) + +@node Summary Kill Commands +@subsection Summary Kill Commands + +@table @kbd +@item C-c C-k C-s +@kindex C-c C-k C-s (Summary) +@findex gnus-kill-file-kill-by-subject +Kill all articles with the current subject +(@code{gnus-kill-file-kill-by-subject}). +@item C-c C-k C-a +@kindex C-c C-k C-a (Summary) +@findex gnus-kill-file-kill-by-author +Kill all articles from the current author +(@code{gnus-kill-file-kill-by-author}). +@item C-c C-k C-t +@kindex C-c C-k C-t (Summary) +@findex gnus-kill-file-kill-by-thread +Kill all articles in the current subthread +(@code{gnus-kill-file-kill-by-thread}). +@item C-c C-k C-o +@kindex C-c C-k C-o (Summary) +@findex gnus-kill-file-kill-by-organization +Kill all articles from the current organization +(@code{gnus-kill-file-kill-by-organization}). +@item C-c C-k C-x +@kindex C-c C-k C-x (Summary) +@findex gnus-kill-file-kill-by-xref +Kill all articles that have similar Xrefs to the current article +(@code{gnus-kill-file-kill-by-xref}). This is one way to get rid of +cross-posts. +@end table + +@node Kill Mode +@subsection Kill Mode + +To enter either the global or local kill file, you can use the following +keystrokes in the Summary buffer: + +@table @kbd +@item M-k +@kindex M-k (Summary) +@findex gnus-summary-edit-local-kill +Edit the kill file for the current newsgroup +(@code{gnus-summary-edit-local-kill}). +@item M-K +@kindex M-K (Summary) +@findex gnus-summary-edit-global-kill +Edit the global kill file (@code{gnus-summary-edit-global-kill}). +@end table + +@node Kill Variables +@subsection Kill Variables + +@table @code +@item gnus-kill-killed +@vindex gnus-kill-killed +If this variable is nil, Gnus will never apply kill files to articles +that have already been through the kill process. While may save you lots +of time, it also means that if you apply a kill file to a newsgroup, and +then change the kill file and want to run it over you newsgroup again to +kill more articles, it won't work. You have to set this variable to t to +do that. +@item gnus-apply-kill-hook +@vindex gnus-apply-kill-hook +This hook is called to do the actual article killing. This hook may do +anything, of course, but it should call the @code{gnus-apply-kill-file} +function, or some equivalent function, to do the killing. +@item gnus-kill-files-directory +@vindex gnus-kill-files-directory +All kill files will be stored in this directory, which is initialized +from the @samp{SAVEDIR} environment variable by default. +@item gnus-kill-file-name +@vindex gnus-kill-file-name +This variable is a string that will be appended to newsgroup names to +make a kill file name. The default is @samp{KILL}. +@end table + +@node Various Summary Stuff +@section Various Summary Stuff + +@table @kbd +@item & +@kindex & (Summary) +@findex gnus-summary-expand-window +This command will prompt you for a header field, a regular expression to +be matched this field, and a command to be executed if the match is +made. +@item = +@kindex = (Summary) +@findex gnus-summary-expand-window +Delete all other windows (@code{gnus-summary-expand-window}). +@item C-x C-s +@kindex C-x C-s (Summary) +@findex gnus-summary-reselect-current-group +Exit this group, and then enter it again +(@code{gnus-summary-reselect-current-group}). +@item V +@kindex V (Summary) +@findex gnus-version +Display the Gnus version numbers (@code{gnus-version}). +@item ? +@kindex ? (Summary) +@findex gnus-summary-describe-briefly +Give a very brief description of the most important Summary keystrokes +(@code{gnus-summary-describe-briefly}). +@item C-c C-i +@kindex C-c C-i (Summary) +@findex gnus-info-find-node +Go to the Gnus info node (@code{gnus-info-find-node}). +@end table + +@vindex gnus-summary-prepare-hook +@code{gnus-summary-prepare-hook} is called after the Summary buffer has +been generated. You might use it to, for instance, hilight lines, modify +the look, or anything else you feel like. I don't care. + +@node The Article Buffer +@chapter The Article Buffer + +The articles are displayed in the Article buffer, of which there is only +one. All the Summary buffer share the same Article buffer. + +@menu +* Hiding Headers:: Deciding what headers should be displayed. +* Using Mime:: Pushing articles through MIME before reading them. +* Customizing Articles:: Tailoring the look of the articles. +* Article Keymap:: Keystrokes available in the Article buffer +* Misc Article:: Other stuff +@end menu + +@node Hiding Headers +@section Hiding Headers + +The top section of each article is the @dfn{header}. (The rest is the +@dfn{body}, but you may have guessed that already.) + +@vindex gnus-show-all-headers +There is a lot of information in the header - the name of the person who +wrote the article, the date and the subject of the article. That might +be very useful, buf there's also lots of information most people do not +want to see - what systems the article has passed through before +reaching you, the message id, the references, etc. ad nauseum - and +you'll probably want to get rid of some of those lines. If you want to +keep all those lines in the Article buffer, you can set +@code{gnus-show-all-headers} to t. + +Gnus provides you with two variables for sifting header lines: + +@table @code +@item gnus-visible-headers +@vindex gnus-visible-headers +If this variable is non-nil, it should be a regular expression that says +what header lines you wish to keep in the Article buffer. All header +lines that does not match this variable will be hidden. + +For instance, if you only want to see the name of the person who wrote +the article and the subject, you'd say: + +@example +(setq gnus-visible-headers "^From:\\^Subject:") +@end example + +@item gnus-ignored-headers +@vindex gnus-ignored-headers +This variable is the reverse of @code{gnus-visible-headers}. If this +variable is set (and @code{gnus-visible-headers} is nil), it should be a +regular expression that matches all lines that you want to hide. All +lines that does not match this variable will remain visible. + +For instance, if you just want to get rid of the references line and the +xref line, you might say: + +@example +(setq gnus-ignored-headers "^References:\\^Xref:") +@end example + +Note that if @code{gnus-visible-headers} is non-nil, this variable will +have no effect. +@end table + +@vindex gnus-sorted-header-list +Gnus can also sort the headers for you. (It does this by default.) You +can control the sorting by setting the @code{gnus-sorted-header-list} +variable. It is a list of regular expressions that says in what order +the header lines are to be displayed. + +For instance, if you want the name of the author of the article first, +and then the subject, you might say something like: + +@example +(setq gnus-sorted-header-list '("^From:" "^Subject:")) +@end example + +Any headers that are to remain visible, but are not listed in this +variable, will be displayed after all the headers that are listed in +this variable. + +@node Using Mime +@section Using Mime + +Mime is a standard for waving your hands through the air, aimlessly, +while people stand around yawning. + +MIME, however, is a standard for encoding your articles, aimlessly, +while all newsreaders die of fear. + +MIME may specify what character set the article uses, the encoding of +the characters, and it also makes it possible to embed pictures and +other naughty stuff in innocent-looking articles. + +@vindex gnus-show-mime +@vindex gnus-show-mime-method +Gnus handles MIME by shoving the articles through +@code{gnus-show-mime-method}, which is @code{metamail-buffer} by +default. Set @code{gnus-show-mime} to t if you want to use MIME all the +time; it might be best just use the toggling functions from the summary +buffer to avoid getting nasty surprises (for instance, you enter the +newsgroup @samp{alt.sing-a-long} and, before you know it, MIME has +decoded the sounds file in the article and some horrible sing-a-long +song comes streaming out out your speakers, and you can't find the +volume button, because there isn't one, and people are starting to look +at you, and you try to stop the program, but you can't, and you can't +find the program to control the volume, and everybody else in the room +suddenly decides to look at you disdainfully, and you'll feel rather +stupid. + +Any similarity between real events and this info page is purely +coincidental. Ahem. + +@node Customizing Articles +@section Customizing Articles + +@vindex gnus-article-display-hook +The @code{gnus-article-display-hook} is called after the article has +been inserted into the Article buffer. It is meant to handle all +treatment of the article before it is displayed. By default it contains +@code{gnus-article-hide-headers}, which hides unwanted headers. + +@findex gnus-article-subcite +@findex gnus-article-hide-signature +@findex gnus-article-hide-citation +Other useful functions you might add to this hook is +@code{gnus-article-hide-citation} (which hides all cited text), +@code{gnus-article-hide-signature} (which, umn, hides the signature) and +@code{gnus-article-subcite} (which tries to clean up the mess supercite +makes in The Hands Of The Mad. + +You can, of course, write your own functions. The functions are called +in the Article buffer, and you can do anything you like, pretty +much. There is no information that you have to keep in the buffer - you +can change everything. + +@node Article Keymap +@section Article Keymap + +Not many keystrokes are available in the Article buffer. You would, +during normal reading, seldom put the point in that buffer. All the +really useful functions are more readily available from the Summary +buffer. + +@table @kbd +@item SPACE +@kindex SPACE (Article) +@findex gnus-article-next-page +Scroll forwards one page (@code{gnus-article-next-page}). +@item DEL +@kindex DEL (Article) +@findex gnus-article-prev-page +Scroll backwards one page (@code{gnus-article-prev-page}). +@item r +@kindex r (Article) +@findex gnus-article-refer-article +If point is in the neighborhood of a message-id and you press @kbd{r}, +Gnus will try to get that article from the server. (Only available with +nntp). (@code{gnus-article-refer-article}). +@item m +@kindex m (Article) +@findex gnus-article-mail +Send a reply to the address near point (@code{gnus-article-mail}). +@item M +@kindex M (Article) +@findex gnus-article-mail-with-original +Send a reply to the address near point and include the original article +(@code{gnus-article-mail-with-original}). +@item s +@kindex s (Article) +@findex gnus-article-show-summary +Reconfigure the buffers so that the Summary buffer becomes visible +(@code{gnus-article-show-summary}). +@item ? +@kindex ? (Article) +@findex gnus-article-describe-briefly +Give a very brief description of the available keystrokes +(@code{gnus-article-describe-briefly}). +@end table + +That's all, folks! + +@node Misc Article +@section Misc Article + +@vindex gnus-article-display-hook +@vindex gnus-article-prepare-hook +The @code{gnus-article-prepare-hook} is called right after the article +has been inserted into the Article buffer. It is mainly intended for +functions that do something depending on the contents; it should +probably not be used for changing the contents of the Article +buffer. Use the @code{gnus-article-display-hook} for that, which is +called after this hook is called. + +@vindex gnus-article-mode-line-format +@code{gnus-article-mode-line-format} is a format string along the same +lines as @code{gnus-summary-mode-line-format}. It accepts exactly the +same format specifications as that variable. + +@vindex gnus-break-pages +The @code{gnus-break-pages} variable controls whether @dfn{page +breaking} is to take place. If this variable is non-nil, the articles +will be divided into pages whenever a @code{gnus-page-delimiter} appears +in the article. If this variable is nil, paging will not be done. + +@vindex gnus-page-delimiter +@code{gnus-page-delimiter} is @samp{^L} (linefeed) by default. + +@node Various +@chapter Various + +@menu +* Interactive:: Making Gnus ask you many questions. +* Windows Configuration:: Configuring the Gnus buffer windows. +* Various Various:: Things that are really various. +@end menu + +@node Interactive +@section Interactive + +@table @code +@item gnus-novice-user +@vindex gnus-novice-user +If this variable is non-nil, you are either a newcomer to the usenet +world, or you are very cautious, which is a nice thing to be, +really. You will be given questions of the type "Are you sure you want +to do this?" before doing anything dangerous. +@item gnus-expert-user +@vindex gnus-expert-user +If this variable is non-nil, you will never ever be asked any questions +by Gnus. It will simply assume you know what your are doing, no matter +how strange. +@item gnus-interactive-catchup +@vindex gnus-interactive-catchup +Require confirmation before catching up a newsgroup if non-nil. +@item gnus-interactive-post +@vindex gnus-interactive-post +If non-nil, the user will be prompted for a newsgroup name when posting +an article. +@item gnus-interactive-exit +@vindex gnus-interactive-exit +Require confirmation before exiting Gnus. +@end table + +@node Windows Configuration +@section Windows Configuration + +No, there's nothing here about X, so be quiet. + +@table @code +@item gnus-use-full-window +@vindex gnus-use-full-window +If non-nil, Gnus will delete all other windows and occupy the entire +Emacs screen by itself. It is t by default. +@item gnus-window-configuration +@vindex gnus-window-configuration +This variable describes how much space each Gnus buffer should be given, +compared to the other Gnus buffers. Here's an example: + +@example +(setq gnus-window-configuration + '((summary (0 1 0)) + (newsgroups (1 0 0)) + (article (0 3 10)))) +@end example + +This variable is a list of lists, where each of these small lists is on +the form @var{(action (g s a))}. As you can see, there are three +possible @var{action}s - @code{newsgroup} (which is what happens when +you first start Gnus, or returns from the Summary buffer), +@code{summary} (which is what happens when there are no unread articles +in the newsgroup, and @code{article} (which is what happens when there +is an unread article in the newsgroup). + +We see that in the first two actions, the respective buffers will fill +the screen, and in the last, the Article buffer will take ten lines for +each three the Summary buffer gets. + +@findex gnus-window-configuration-split +This variable can also have a function as its value. In that case, +whenever Gnus tries to configure the Gnus buffers, that function will be +called with the @var{action} as its parameter. There is one pre-made +function supplied, @code{gnus-window-configuration-split}, which may be +suitable if you have a very wide Emacs window, and wants to have the +Summary buffer and the Article buffer side by side. Here's the +definition of this function, which you may use as a template for your +own function(s): + +@example +(defun gnus-window-configuration-split (action) + ;; The group buffer always exists, so it's nice to use + ;; it as a starting point. + (switch-to-buffer gnus-group-buffer t) + (delete-other-windows) + (split-window-horizontally) + (cond ((or (eq action 'newsgroup) (eq action 'summary)) + (if (and (get-buffer gnus-summary-buffer) + (buffer-name gnus-summary-buffer)) + (switch-to-buffer-other-window gnus-summary-buffer))) + ((eq action 'article) + (switch-to-buffer gnus-summary-buffer t) + (other-window 1) + ;; Create and initialize the Article buffer if it doesn't + ;; exist. + (gnus-article-setup-buffer) + (switch-to-buffer gnus-article-buffer t)))) +@end example +@end table + +@node Various Various +@section Various Various + +@vindex gnus-updated-mode-lines +The @code{gnus-updated-mode-lines} variable is a list of buffers that +should keep their mode lines updated. The list may contain the symbols +`group', `article' and `summary'. If the corresponding symbol is +present, Gnus will keep that mode line updated with information that may +be pertinent. If this variable is nil, screen refresh may be quicker. + +@node Customization +@chapter Customization + +All variables are properly documented elsewhere in this manual. This +section is designed to give general pointers on how to customize Gnus +for some quite common situations. + +@menu +* Slow NNTP Connection:: You run a local Emacs and get the news elsewhere. +* Slow Terminal Connection:: You run a remote Emacs. +* Little Disk Space:: You feel that having large setup files is icky. +* Slow Machine:: You feel like buying a faster machine. +@end menu + +@node Slow NNTP Connection +@section Slow NNTP Connection + +If you run Emacs on a machine locally, and get your news from a machine +over some very thin strings, you want to cut down on the amount of data +Gnus has to get from the NNTP server. + +@table @code +@item gnus-read-active-file +Set this to nil, which will inhibit Gnus from requesting the entire active +file from the server. This file is often v. large. You also have to set +@code{gnus-check-new-news} and @code{gnus-check-bogus-newsgroups} to nil +to make sure that Gnus doesn't suddenly decide to fetch the active file +anyway. Note that this will make it difficult for you to get hold of new +newsgroups. +@item nntp-xover-is-evil +This one has to be nil. If not, grabbing article headers from the NNTP +server will not be very fast. Not all NNTP servers support XOVER; Gnus +will detect this by itself. +@end table + +@node Slow Terminal Connection +@section Slow Terminal Connection + +Let's say you use your home computer for dialling up the system that +runs Emacs and Gnus. If your modem is slow, you want to reduce the +amount of data that is sent over the wires as much as possible. + +@table @code +@item gnus-auto-center-summary +Set this to nil to inhibit Gnus from recentering the Summary buffer all +the time. +@item gnus-visible-headers +Cut down on the headers that are included in the articles to the +minimum. You can, in fact, make do without them altogether - most of the +useful data is in the Summary buffer, anyway. Set this variable to +@samp{""} or @samp{"^Date:"}, or whatever you feel you need. +@item gnus-article-display-hook +Set this hook to all the available hiding commands: +@example +(setq gnus-article-display-hook + '(gnus-article-hide-headers gnus-article-hide-signature + gnus-article-hide-citation)) +@end example +@item gnus-use-full-window +By setting this to nil, you can make all the windows smaller. While this +doesn't really cut down much generally, it means that you have to see +smaller portions of articles before deciding that you didn't want to +read them anyway. +@item gnus-thread-hide-subtree +If this is non-nil, all threads in the Summary buffer will be hidden +initially. +@item gnus-updated-mode-lines +If this is nil, Gnus will not put information in the buffer mode lines, +which might save some time. +@end table + +@node Little Disk Space +@section Little Disk Space + +The startup files can get rather large, so you may want to keep their +sizes down a bit if you are running out of space. + +@table +@item gnus-save-newsrc-file +If this is nil, Gnus will never save @file{.newsrc} - it will only save +@file{.newsrc.eld}. This means that you will not be able to use any +other newsreaders than Gnus. +@item gnus-save-killed-list +If this is nil, Gnus will not save the list of dead newsgroups. That +means that Gnus will not know whether newsgroups are new or old, which +makes automatic handling of new newsgroups impossible. You should also +set @code{gnus-check-new-newsgroups} and +@code{gnus-check-bogus-newsgroups} to nil if you set this variable to +nil. +@end table + +@node Slow Machine +@section Slow Machine + +If you have a slow machine, or are just really impatient, there are a +few things you can do to make Gnus run faster. + +Set @code{gnus-read-active-file}, @code{gnus-check-new-newsgroups}, +@code{gnus-check-bogus-newsgroups} to nil to make startup faster. + +Set @code{gnus-show-threads}, @code{gnus-use-cross-reference} and +@code{nntp-xover-is-evil} to nil to make entering and exiting the +Summary buffer faster. + +Set @code{gnus-article-display-hook} to nil to make article processing a +bit faster. + +@node Troubleshooting +@chapter Troubleshooting + +@node Reporting Bugs +@chapter Reporting Bugs + + + +@node Index +@chapter Index +@printindex cp + +@node Key Index +@chapter Key Index +@printindex ky + +@summarycontents +@contents +@bye + + +@c Local Variables: +@c outline-regexp: "@chap\\|@\\(sub\\)*section\\|@appendix \\|@appendix\\(sub\\)*sec\\|\^L" +@c End: -- 2.34.1