umerin@flab.flab.fujitsu.JUNET (Masanobu UMEDA) (11/11/88)
This is a new version of GNUS, an NNTP-based newsreader for GNU Emacs.
Many kinds of extensions and bug fixes are included in this release.
I'd like to thank all of you who send me valuable comments. I'd also
like to give great thanks to beta-testers here in Fujitsu Lab.
New features of 3.10 version:
+ Understand `options -n XXX !YYY' in .newsrc file.
+ New implementation of KILL file.
+ Commands for searching articles by REGEXP.
+ Commands for executing a command on articles by REGEXP.
+ Rmail saver.
+ Improved RMAIL digest reader.
+ Improved article referencing commands.
+ Customizable article save name.
+ Customizable subject buffer.
+ Supporting external TCP/IP.
+ More hooks for customization.
Other important changes from 3.8 version:
+ Variable gnus-server-host is renamed to gnus-nntp-server.
+ Variable gnus-force-nntp is obsolete. Use gnus-nntp-service instead.
+ Many internal variables are deleted, renamed, or added. Hook
functions must be carefully rewritten if they are used in.
Installation guide is included in the beginning of gnus.el. Please
read it carefully for happy GNUSing.
Please send questions, bug fixes and extensions to:
info-gnus-english@tut.cis.ohio-state.edu
Masanobu UMEDA
umerin@flab.flab.Fujitsu.JUNET
umerin%flab.flab.Fujitsu.JUNET@uunet.uu.NET
----------------------------------------------------------------------
---- Cut Here and unpack ----
#!/bin/sh
# shar: Shell Archiver (v1.22)
#
# This is part 1 of a multipart archive
# do not concatenate these parts, unpack them in order with /bin/sh
#
# Run the following text with /bin/sh to create:
# gnus.el
# mhspool.el
# nnspool.el
# nntp.el
# tcp.el
# tcp.c
#
if test -r s2_seq_.tmp
then echo "Must unpack archives in sequence!"
next=`cat s2_seq_.tmp`; echo "Please unpack part $next next"
exit 1; fi
sed 's/^X//' << 'SHAR_EOF' > gnus.el &&
X;;; GNUS: NNTP-based News Reader for GNU Emacs
X;; Copyright (C) 1987, 1988 Fujitsu Laboratoris LTD.
X;; Copyright (C) 1987, 1988 Masanobu UMEDA (umerin@flab.flab.Fujitsu.JUNET)
X;; $Header: gnus.el,v 3.10 88/11/11 14:58:29 umerin Exp $
X
X;; This file is part of GNU Emacs.
X
X;; GNU Emacs is distributed in the hope that it will be useful,
X;; but WITHOUT ANY WARRANTY. No author or distributor
X;; accepts responsibility to anyone for the consequences of using it
X;; or for whether it serves any particular purpose or works at all,
X;; unless he says so in writing. Refer to the GNU Emacs General Public
X;; License for full details.
X
X;; Everyone is granted permission to copy, modify and redistribute
X;; GNU Emacs, but only under the conditions described in the
X;; GNU Emacs General Public License. A copy of this license is
X;; supposed to have been given to you along with GNU Emacs so you
X;; can know your rights and responsibilities. It should be in a
X;; file named COPYING. Among other things, the copyright notice
X;; and this notice must be preserved on all copies.
X
X;; How to Install GNUS:
X;; (0) First of all, remove GNUS related OLD *.elc files (at least nntp.elc).
X;; (1) Unshar gnus.el, nntp.el, and nnspool.el.
X;; (2) byte-compile-file nntp.el, nnspool.el, and gnus.el.
X;; (3) Define three environment variables in .login file as follows:
X;;
X;; setenv NNTPSERVER flab
X;; setenv DOMAINNAME "stars.flab.Fujitsu.JUNET"
X;; setenv ORGANIZATION "Fujitsu Laboratories Ltd., Kawasaki, Japan."
X;;
X;; Or instead define lisp variables in your .emacs, site-init.el,
X;; or default.el as follows:
X;;
X;; (setq gnus-nntp-server "flab")
X;; (setq gnus-your-domain "stars.flab.Fujitsu.JUNET")
X;; (setq gnus-your-organization "Fujitsu Laboratories Ltd., ...")
X;;
X;; If lisp function (system-name) returns full internet name, you
X;; don't have to define domain name.
X;;
X;; (4) You may have to define NNTP service name as number 119.
X;;
X;; (setq gnus-nntp-service 119)
X;;
X;; Or, if you'd like to use local news spool directly in stead of
X;; via NNTP, set the variable to nil as follows:
X;;
X;; (setq gnus-nntp-service nil)
X;;
X;; (5) If you'd like to use GENERICFROM feature like Bnews, define
X;; lisp variable as follows:
X;;
X;; (setq gnus-use-generic-from t)
X;;
X;; (6) Define autoload entries in .emacs file as follows:
X;;
X;; (autoload 'gnus "gnus" "Read network news." t)
X;; (autoload 'gnus-post-news "gnus" "Post a news." t)
X;;
X;; (7) Read nntp.el if you have any trouble with NNTP or Kanji handling.
X;;
X;; (8) Install mhspool.el, tcp.el and tcp.c if you think it is necessary.
X;;
X;; mhspool.el is a package for reading articles or mails in your
X;; private directory using GNUS.
X;;
X;; tcp.el and tcp.c are necessary if and only if your Emacs does
X;; not have a function `open-network-stream' which is used for
X;; communicating with NNTP server inside Emacs. tcp.el contains a
X;; few patches for very OOOOOOOLD version of Emacs.
X
X;; GNUS Mailing List:
X;; There are two mailing lists for GNUS lovers in the world:
X;;
X;; info-gnus@flab.fujitsu.junet, and
X;; info-gnus-english@tut.cis.ohio-state.edu.
X;;
X;; Both of them are intended to exchange valuable information about
X;; GNUS, such as bug fixes, useful hooks and extensions. The major
X;; difference of the two lists is what the official language is. Both
X;; Japanese and English are available in info-gnus, while English is
X;; only available in info-gnus-english. There is no need to subscribe
X;; info-gnus if you cannot read Japanese messages, because most of the
X;; discussion and important announcements will be sent to
X;; info-gnus-english. Moreover, if you are able to read gnu.emacs.gnus
X;; newsgroup of USENET, you need not, either. info-gnus-english and
X;; gnu.emacs.gnus are linked each other.
X;;
X;; Please send subscription request to:
X;;
X;; info-gnus-request%flab.fujitsu.junet@uunet.uu.net, or
X;; info-gnus-english-request@cis.ohio-state.edu
X
X;; TO DO:
X;; (1) Incremental update of active info.
X;; (2) GNUS own poster and programmable interface to various mailers.
X;; (3) Multi-GNUS (Talking to many hosts same time).
X;; (4) Asynchronous transmission of large messages.
X
X(provide 'gnus)
X(require 'nntp)
X(require 'mail-utils)
X
X(defvar gnus-nntp-server (getenv "NNTPSERVER")
X "*Host the NNTP server is running.
XIf the value is a string like a `:DIRECTORY', user's private DIRECTORY
Xis used as news spool.
XInitialized from the NNTPSERVER environment variable.")
X
X(defvar gnus-nntp-service "nntp"
X "*NNTP service name (\"nntp\" or 119).
XGo to local news spool if its value is nil.")
X
X(defvar gnus-startup-file "~/.newsrc"
X "*Your .newsrc file. Use `.newsrc-SERVER' instead if it exists.")
X
X(defvar gnus-subject-lines-height 4
X "*Number of subject lines displayed at once.
XIf you'd like to set the height of subject window according to that of
XEmacs window, set the value in gnus-Subject-mode-hook as follows:
X
X(setq gnus-Subject-mode-hook
X '(lambda ()
X (setq gnus-subject-lines-height (/ (window-height) 5))))")
X
X(defvar gnus-author-copy-file (getenv "AUTHORCOPY")
X "*File name saving copy of posted article in Unix mail format.
XInitialized from the AUTHORCOPY environment variable.
X
XIf the first character of the name is `|', the article is piped out to
Xthe named program. It is possible to save an article in MH folder by
Xthe following:
X
X(setq gnus-author-copy-file \"|/usr/local/lib/mh/rcvstore +Article\")")
X
X(defvar gnus-use-long-file-name t
X "*Do not use hierarchical file name (directory form of newsgroup),
Xbut use newsgroup name itself for the name of an article to be saved
Xor local KILL file if non-nil.")
X
X(defvar gnus-article-save-name (function gnus-article-save-name)
X "*Function generating file name saving an article to.
XThe function is called with 2 arguments, NEWSGROUP and HEADERS.
XAccess macros to the headers are defined as nntp-header-FIELD, and
Xfunctions are defined as gnus-header-FIELD.")
X
X(defvar gnus-article-default-saver (function gnus-Subject-save-in-rmail)
X "*Function saving an article in your favorite format.
XThe function must be interactively callable (in other words, it must
Xbe a emacs command).
X
XGNUS provides following functions:
X gnus-Subject-save-in-rmail (in Rmail format)
X gnus-Subject-save-in-mail (in Unix mail format)
X gnus-Subject-save-in-folder (in MH folder)
X gnus-Subject-save-in-file (in plain file).")
X
X(defvar gnus-article-save-directory (getenv "SAVEDIR")
X "*Directory name to save an article to (default to ~/News).
XInitialized from the SAVEDIR environment variable.")
X
X(defvar gnus-article-mh-folder "+News"
X "*MH folder name saving an article in by \\[gnus-Subject-save-in-folder].")
X
X(defvar gnus-kill-file-name "KILL"
X "*File name of a KILL file.")
X
X(defvar gnus-default-distribution "local"
X "*Use the value as distribution if no distribution is specified.")
X
X(defvar gnus-novice-user t
X "*A little bit verbose in posting mode if non-nil.
XAsk newsgroup name, subject, and distribution.")
X
X(defvar gnus-user-login-name (or (getenv "USER") (getenv "LOGNAME") (user-login-name))
X "*The login name of the user.
XInitialized from the USER and LOGNAME environment variable if defined.")
X
X(defvar gnus-user-full-name (or (getenv "NAME") (user-full-name))
X "*The full name of the user.
XInitialized from the NAME environment variable if defined.")
X
X(defvar gnus-show-all-headers nil
X "*Show all headers of an article if non-nil.")
X
X(defvar gnus-save-all-headers nil
X "*Save all headers of an article if non-nil.")
X
X(defvar gnus-auto-select-first t
X "*Select first unread article automagically if non-nil.
XIf you want to prevent auto selection of first unread article in some
Xnewsgroups, set the variable to nil in gnus-Select-group-hook or
Xgnus-Apply-kill-hook.")
X
X(defvar gnus-auto-select-next t
X "*Select next newsgroup automagically if non-nil.
XIf the value is t and the next newsgroup expected is empty, GNUS will
Xexit Subject mode and go back to Group mode.
XIf the value is not nil nor t, GNUS will select following unread
Xnewsgroup. Especially, if the value is `quietly', next unread
Xnewsgroup will be selected without any confirmations.")
X
X(defvar gnus-auto-select-same nil
X "*Select next article with same subject automagically if non-nil.")
X
X(defvar gnus-break-pages t
X "*Break pages of news article if non-nil.
XPage delimiter is specified by variable `gnus-page-delimiter'. Message
Xshow at end of pages is specified by variable `gnus-more-message'.")
X
X(defvar gnus-page-delimiter "^\^L"
X "*Regexp describing line-beginnings that separate pages of news article.")
X
X(defvar gnus-more-message "*** More ***"
X "*Message shown at end of pages in page break mode.")
X
X(defvar gnus-digest-show-summary t
X "*Show summary of digest messages if non-nil.")
X
X(defvar gnus-optional-headers (function gnus-optional-lines-and-from)
X "*Function generating optional string displayed in GNUS Subject mode buffer.
XThe function is called with an article HEADER. The result must be a
Xstring excluding `[' and `]'.")
X
X(defvar gnus-keep-subject-centered t
X "*Always center the current subject in GNUS Subject mode window if non-nil.")
X
X(defvar gnus-Group-mode-hook nil
X "*Hooks for GNUS Group mode.")
X
X(defvar gnus-Subject-mode-hook nil
X "*Hooks for GNUS Subject mode.")
X
X(defvar gnus-Article-mode-hook nil
X "*Hooks for GNUS Article mode.")
X
X(defvar gnus-Kill-file-mode-hook nil
X "*Hooks for GNUS Kill file mode.")
X
X(defvar gnus-Startup-hook nil
X "*Hooks called at startup time.
XThis hook is called after NNTP server is selected. So, it is possible
Xto change the behaver of GNUS according to the server.")
X
X(defvar gnus-Subject-prepare-hook nil
X "*Hooks called after subject list is created.
XIf you'd like to modify the buffer, you can use this hook.")
X
X(defvar gnus-Article-prepare-hook nil
X "*Hooks called after an article is prepared for reading.
XIf you'd like to run special decoding program like nkf, use this hook.")
X
X(defvar gnus-Select-group-hook nil
X "*Hooks called when a newsgroup is selected.
XIf you'd like to sort Subject mode buffer by posted date and then by
Xsubject string, you can use the following hook:
X
X(setq gnus-Select-group-hook
X '(lambda ()
X ;; First of all, sort by date.
X (gnus-sort-headers
X '(lambda (a b)
X (gnus-date-lessp (nntp-header-date a)
X (nntp-header-date b))))
X ;; Then sort by subject string ignoring `Re:'.
X (gnus-sort-headers
X '(lambda (a b)
X (string-lessp (gnus-simplify-subject (nntp-header-subject a) 're)
X (gnus-simplify-subject (nntp-header-subject b) 're)
X )))))
X
XIf you'd like to simplify subjects like the
X`gnus-Subject-next-same-subject' command does, you can use the
Xfollowing hook:
X
X(setq gnus-Select-group-hook
X '(lambda ()
X (mapcar (function
X (lambda (header)
X (nntp-set-header-subject
X header
X (gnus-simplify-subject
X (nntp-header-subject header) 're-only))))
X gnus-newsgroup-headers)))
X
XIn some newsgroups author name of an article is meaningless. It is
Xpossible to prevent listing author name in GNUS Subject mode buffer as
Xfollows:
X
X(setq gnus-Select-group-hook
X '(lambda ()
X (cond ((string-match \"comp.sources.unix\" gnus-newsgroup-name)
X (setq gnus-optional-headers
X (function gnus-optional-lines)))
X (t
X (setq gnus-optional-headers
X (function gnus-optional-lines-and-from))))))")
X
X(defvar gnus-Select-article-hook nil
X "*Hooks called when an article is selected.
XIf you'd like to run RMAIL on a digest article automagically, you can
Xuse the following hook:
X
X(setq gnus-Select-article-hook
X '(lambda ()
X (cond ((string-equal \"comp.sys.sun\" gnus-newsgroup-name)
X (gnus-Subject-rmail-digest))
X ((and (string-equal \"comp.text\" gnus-newsgroup-name)
X (string-match \"^TeXhax Digest\"
X (nntp-header-subject gnus-current-headers)))
X (gnus-Subject-rmail-digest)
X ))))")
X
X(defvar gnus-Select-digest-hook nil
X "*Hooks called when reading digest messages using Rmail.
XThis hook can be used to modify incomplete digest articles as follows:
X
X(setq gnus-Select-digest-hook
X '(lambda ()
X ;; Reply-To: is required by `undigestify-rmail-message'.
X (or (mail-position-on-field \"Reply-to\" t)
X (progn
X (mail-position-on-field \"Reply-to\")
X (insert (gnus-fetch-field \"From\"))))))")
X
X(defvar gnus-Rmail-digest-hook nil
X "*Hooks called when reading digest messages using Rmail.
XThis hook is intended to customize Rmail mode for reading digest articles.")
X
X(defvar gnus-Apply-kill-hook (function gnus-Kill-file-apply)
X "*Hooks called when a newsgroup is selected and subject list is prepared.
XThis hook is intended to apply a KILL file to selected newsgroup.
XFunction `gnus-Kill-file-apply' is binded to this hook defaultly.
X
XSince general KILL file is too heavy to use only for a few newsgroups,
XI recommend you to use much light hook function. For example, if you'd
Xlike to apply kills to articles which contains a string `rmgroup' in
Xsubject field in newsgroup `control', you can use the following hook:
X
X(setq gnus-Apply-kill-hook
X '(lambda ()
X (cond ((string-match \"control\" gnus-newsgroup-name)
X (gnus-kill \"Subject\" \"rmgroup\" \"d\")))))")
X
X(defvar gnus-Mark-article-hook
X (function
X (lambda ()
X (or (memq gnus-current-article gnus-newsgroup-marked)
X (gnus-Subject-mark-as-read gnus-current-article))))
X "*Hooks called when an article is selected at first time.
XThe hook is intended to mark an article as read (or unread)
Xautomatically when it is selected.
X
XIf you'd like to mark as unread (-) instead, use the following hook:
X
X(setq gnus-Mark-article-hook
X '(lambda ()
X (gnus-Subject-mark-as-unread gnus-current-article)))")
X
X(defvar gnus-Inews-article-hook nil
X "*Hooks called before posting an article.
XIf you'd like to run special encoding program, use this hook.")
X
X(defvar gnus-Exit-group-hook nil
X "*Hooks called when exiting (not quitting) GNUS Subject mode.
XIf your machine is so slow that exiting from Subject mode takes very
Xlong time, set variable gnus-newsgroup-headers to nil. This inhibits
Xmarking articles as read using cross-references.")
X
X(defvar gnus-Exit-gnus-hook nil
X "*Hooks called when exiting GNUS.")
X
X(defvar gnus-Save-newsrc-hook nil
X "*Hooks for saving the newsrc file.
XThis hook is called before writing to .newsrc file.")
X
X;; Site dependent variables. You have to define these variables in
X;; site-init.el, default.el or your .emacs.
X
X(defvar gnus-your-domain "stars.flab.Fujitsu.JUNET"
X "*Your domain name without your host name.
XIf environment variable `DOMAINNAME' is defined, it's instead used.
XIf lisp function (system-name) returns full internet name, there is no
Xneed to define the name.")
X
X(defvar gnus-your-organization "Fujitsu Laboratories Ltd., Kawasaki, Japan."
X "*Your organization.
XIf environment variable `ORGANIZATION' is defined, it's instead used.")
X
X(defvar gnus-use-generic-from nil
X "*Don't insert local host name to From: field if non-nil.")
X
X;; Internal variables.
X
X(defconst gnus-version "GNUS 3.10"
X "Version numbers of this version of GNUS.")
X
X(defvar gnus-ignored-headers
X "^Path:\\|^Posting-Version:\\|^Article-I.D.:\\|^Expires:\\|^Date-Received:\\|^References:\\|^Control:\\|^Xref:\\|^Lines:\\|^Posted:\\|^Relay-Version:\\|^Message-ID:\\|^Nf-ID:\\|^Nf-From:\\|^Approved:\\|^Sender:"
X "All random fields within the header of a message.")
X
X(defvar gnus-current-startup-file nil
X "Startup file for current host.")
X
X;; Names of the following five variables should not be changed since
X;; they are contained in quickly loadable .newsrc file.
X
X(defvar gnus-newsrc-options nil
X "Options line in .newsrc file.")
X
X(defvar gnus-newsrc-options-n-yes nil
X "Regexp representing subscribed newsgroups.")
X
X(defvar gnus-newsrc-options-n-no nil
X "Regexp representing unsubscribed newsgroups.")
X
X(defvar gnus-newsrc-assoc nil
X "Assoc list of read articles.")
X
X(defvar gnus-marked-assoc nil
X "Assoc list of articles marked as unread.")
X
X(defvar gnus-unread-hashtb nil
X "Hashtable of unread articles.")
X
X(defvar gnus-active-hashtb nil
X "Hashtable of active articles.")
X
X(defvar gnus-octive-hashtb nil
X "Hashtable of OLD active articles.")
X
X(defvar gnus-Group-buffer "*Newsgroup*")
X(defvar gnus-Subject-buffer "*Subject*")
X(defvar gnus-Article-buffer "*Article*")
X(defvar gnus-Digest-buffer "GNUS Digest")
X(defvar gnus-Digest-summary-buffer "GNUS Digest-summary")
X
X(defvar gnus-last-search nil
X "Default regexp for article search command.")
X
X(defvar gnus-newsgroup-name nil)
X(defvar gnus-newsgroup-begin nil)
X(defvar gnus-newsgroup-end nil)
X(defvar gnus-newsgroup-last-file nil)
X
X(defvar gnus-newsgroup-unreads nil
X "List of unread articles in current newsgroup.")
X
X(defvar gnus-newsgroup-marked nil
X "List of marked articles in current newsgroup.")
X
X(defvar gnus-newsgroup-headers nil
X "List of article headers in current newsgroup.")
X
X(defvar gnus-current-article nil)
X(defvar gnus-current-headers nil)
X(defvar gnus-current-history nil)
X(defvar gnus-have-all-headers nil)
X(defvar gnus-last-article nil)
X
X(defvar gnus-Group-mode-map nil)
X(defvar gnus-Subject-mode-map nil)
X(defvar gnus-Article-mode-map nil)
X(defvar gnus-Kill-file-mode-map nil)
X
X(defvar rmail-last-file (expand-file-name "~/XMBOX"))
X(defvar rmail-last-rmail-file (expand-file-name "~/XNEWS"))
X
X(autoload 'rmail-output "rmailout"
X "Append this message to Unix mail file named FILE-NAME." t)
X(autoload 'news-mail-reply "rnewspost")
X(autoload 'news-mail-other-window "rnewspost")
X(autoload 'news-reply-mode "rnewspost")
X(autoload 'mail-position-on-field "sendmail")
X(autoload 'mh-find-path "mh-e")
X(autoload 'mh-prompt-for-folder "mh-e")
X
X(put 'gnus-Group-mode 'mode-class 'special)
X(put 'gnus-Subject-mode 'mode-class 'special)
X(put 'gnus-Article-mode 'mode-class 'special)
X
X
X;;(put 'eval-in-buffer-window 'lisp-indent-hook 1)
X
X(defmacro eval-in-buffer-window (buffer &rest forms)
X "Pop to BUFFER, evaluate FORMS, and then returns to original window."
X (` (let ((StartBufferWindow (selected-window)))
X (unwind-protect
X (progn
X (pop-to-buffer (, buffer))
X (,@ forms))
X (select-window StartBufferWindow)))))
X
X(defmacro gnus-make-hashtable ()
X '(make-abbrev-table))
X
X(defmacro gnus-gethash (string hashtable)
X "Get hash value of STRING in HASHTABLE."
X ;;(` (symbol-value (abbrev-symbol (, string) (, hashtable))))
X (` (abbrev-expansion (, string) (, hashtable))))
X
X(defmacro gnus-sethash (string value hashtable)
X "Set hash value. Arguments are STRING, VALUE, and HASHTABLE."
X ;; We cannot use define-abbrev since it only accepts string as value.
X (` (set (intern (, string) (, hashtable)) (, value))))
X
X;; Note: Macros defined here are also defined in nntp.el. I don't like
X;; to put them here, but many users got troubles with the old
X;; definitions in nntp.elc. These codes are NNTP 3.7 version.
X
X(defmacro nntp-header-number (header)
X "Return article number in HEADER."
X (` (aref (, header) 0)))
X
X(defmacro nntp-set-header-number (header number)
X "Set article number of HEADER to NUMBER."
X (` (aset (, header) 0 (, number))))
X
X(defmacro nntp-header-subject (header)
X "Return subject string in HEADER."
X (` (aref (, header) 1)))
X
X(defmacro nntp-set-header-subject (header subject)
X "Set article subject of HEADER to SUBJECT."
X (` (aset (, header) 1 (, subject))))
X
X(defmacro nntp-header-from (header)
X "Return author string in HEADER."
X (` (aref (, header) 2)))
X
X(defmacro nntp-set-header-from (header from)
X "Set article author of HEADER to FROM."
X (` (aset (, header) 2 (, from))))
X
X(defmacro nntp-header-xref (header)
X "Return xref string in HEADER."
X (` (aref (, header) 3)))
X
X(defmacro nntp-set-header-xref (header xref)
X "Set article xref of HEADER to xref."
X (` (aset (, header) 3 (, xref))))
X
X(defmacro nntp-header-lines (header)
X "Return lines in HEADER."
X (` (aref (, header) 4)))
X
X(defmacro nntp-set-header-lines (header lines)
X "Set article lines of HEADER to LINES."
X (` (aset (, header) 4 (, lines))))
X
X(defmacro nntp-header-date (header)
X "Return date in HEADER."
X (` (aref (, header) 5)))
X
X(defmacro nntp-set-header-date (header date)
X "Set article date of HEADER to DATE."
X (` (aset (, header) 5 (, date))))
X
X(defmacro nntp-header-id (header)
X "Return date in HEADER."
X (` (aref (, header) 6)))
X
X(defmacro nntp-set-header-id (header id)
X "Set article ID of HEADER to ID."
X (` (aset (, header) 6 (, id))))
X
X
X;;;
X;;; GNUS Group mode
X;;;
X
X(if gnus-Group-mode-map
X nil
X (setq gnus-Group-mode-map (make-keymap))
X (suppress-keymap gnus-Group-mode-map)
X (define-key gnus-Group-mode-map " " 'gnus-Group-read-group)
X (define-key gnus-Group-mode-map "=" 'gnus-Group-select-group)
X (define-key gnus-Group-mode-map "j" 'gnus-Group-jump-to-group)
X (define-key gnus-Group-mode-map "n" 'gnus-Group-next-unread-group)
X (define-key gnus-Group-mode-map "p" 'gnus-Group-prev-unread-group)
X (define-key gnus-Group-mode-map "\177" 'gnus-Group-prev-unread-group)
X (define-key gnus-Group-mode-map "N" 'gnus-Group-next-group)
X (define-key gnus-Group-mode-map "P" 'gnus-Group-prev-group)
X (define-key gnus-Group-mode-map "\C-n" 'gnus-Group-next-group)
X (define-key gnus-Group-mode-map "\C-p" 'gnus-Group-prev-group)
X (define-key gnus-Group-mode-map "/" 'isearch-forward)
X (define-key gnus-Group-mode-map "<" 'beginning-of-buffer)
X (define-key gnus-Group-mode-map ">" 'end-of-buffer)
X (define-key gnus-Group-mode-map "u" 'gnus-Group-unsubscribe-current-group)
X (define-key gnus-Group-mode-map "U" 'gnus-Group-unsubscribe-group)
X (define-key gnus-Group-mode-map "c" 'gnus-Group-catch-up)
X (define-key gnus-Group-mode-map "l" 'gnus-Group-list-groups)
X (define-key gnus-Group-mode-map "L" 'gnus-Group-list-all-groups)
X (define-key gnus-Group-mode-map "g" 'gnus-Group-get-new-news)
X (define-key gnus-Group-mode-map "b" 'gnus-Group-check-bogus-groups)
X (define-key gnus-Group-mode-map "a" 'gnus-Group-post-news)
X (define-key gnus-Group-mode-map "K" 'gnus-Kill-file-edit-global)
X (define-key gnus-Group-mode-map "V" 'gnus-version)
X (define-key gnus-Group-mode-map "?" 'describe-mode)
X (define-key gnus-Group-mode-map "x" 'gnus-Group-force-update)
X (define-key gnus-Group-mode-map "s" 'gnus-Group-force-update)
X (define-key gnus-Group-mode-map "q" 'gnus-Group-exit)
X (define-key gnus-Group-mode-map "Q" 'gnus-Group-quit))
X
X(defun gnus-Group-mode ()
X "Major mode for reading news using NNTP server.
XAll normal editing commands are turned off.
XInstead, these commands are available:
X
X\\[gnus-Group-read-group] Read news in this newsgroup.
X\\[gnus-Group-select-group] Select this newsgroup.
X\\[gnus-Group-jump-to-group] Move to specified newsgroup.
X\\[gnus-Group-next-unread-group] Move to next unread newsgroup.
X\\[gnus-Group-prev-unread-group] Move to previous unread newsgroup.
X\\[gnus-Group-next-group] Move to next newsgroup.
X\\[gnus-Group-prev-group] Move to previous newsgroup.
X\\[isearch-forward] Do incremental search forward.
X\\[beginning-of-buffer] Move point to beginning of this buffer.
X\\[end-of-buffer] Move point to end of this buffer.
X\\[gnus-Group-unsubscribe-current-group] Toggle this newsgroup unsubscribe from/to subscribe.
X\\[gnus-Group-unsubscribe-group] Toggle newsgroup unsubscribe from/to subscribe.
X\\[gnus-Group-catch-up] Mark all articles in this newsgroup as read.
X\\[gnus-Group-list-groups] Revert this buffer.
X\\[gnus-Group-list-all-groups] List all of newsgroups.
X\\[gnus-Group-get-new-news] Get new news.
X\\[gnus-Group-check-bogus-groups] Check bogus newsgroups.
X\\[gnus-Group-post-news] Post an article to JUNET (USENET).
X\\[gnus-Kill-file-edit-global] Edit global KILL file.
X\\[gnus-version] Show version number of this GNUS.
X\\[describe-mode] Describe this mode.
X\\[gnus-Group-force-update] Save .newsrc file.
X\\[gnus-Group-exit] Quit reading news.
X\\[gnus-Group-quit] Quit reading news without saving .newsrc file.
X
XName of the host NNTP server is running is asked if no default host is
Xdefined. It is also possible to choose some other host even when
Xdefault host is defined by giving an argument to command `\\[gnus]'.
X
XIt is possible to read mails in MH folder or articles saved by GNUS by
Xspecifying `:' followed by the directory name to NNTP server name. For
Xexample, the name of the server is `:Mail', directory ~/Mail is
Xtreated as news spool. File name of mails or articles must consist of
Xnumbers. Otherwise, they are ignored.
X
XIf there exists a file named `~/.newsrc-SERVER', it is used as startup
Xfile instead of standard one when talking to SERVER. It is possible
Xto talk to many hosts by using different startup files for each.
X
XOption `-n' of options line in .newsrc file is recognized as same as
Xstandard Bnews system. For example, if options line looks like a
X`options -n !talk talk.rumors', newsgroups under `talk' hierarchy
Xexcept for `talk.rumors' are ignored while checking new newsgroups.
XThis is the only way for keeping .newsrc file small.
X
XIf there exists a file named `~/.signature-DISTRIBUTION', it is used
Xas signature file instead of standard one when posting a news in
XDISTRIBUTION.
X
XVariable `gnus-version', `nntp-version' and `nnspool-version' have
Xversion number of this version of gnus.el, nntp.el and nnspool.el,
Xrespectively.
X
XUser customizable variables:
X gnus-nntp-server
X Specifies host name NNTP server is running. If that value is a
X string like a `:DIRECTORY', user's private DIRECTORY is used as
X news spool. The variable is initialized from the NNTPSERVER
X environment variable.
X
X [gnus-server-host is obsolete. It is renamed to gnus-nntp-server.]
X
X gnus-nntp-service
X Specifies NNTP service name. The value is usually \"nntp\" or 119.
X Nil forces GNUS to use local news spool if value of
X `gnus-nntp-server' is local host name.
X
X [gnus-force-nntp is obsolete. Use gnus-nntp-service, instead.]
X
X gnus-startup-file
X Specifies .newsrc file. If there is a file named `.newsrc-SERVER',
X it's instead used when talking to SERVER. I recommend you to use
X server specific file, if you'd like to talk to many servers.
X Especially if you'd like to use your private directory as news
X spool, the name of the file must be `.newsrc-:DIRECTORY'.
X
X gnus-author-copy-file
X Specifies file name saving an article posted using GNUS to. If
X the first character of the value is `|', contents of the article
X will be piped out to a program specified by the rest of the value.
X The variable is initialized from the AUTHORCOPY environment
X variable.
X
X gnus-kill-file-name
X Use specified file name as KILL file (default to `KILL').
X
X gnus-novice-user
X Non-nil means newsgroup, subject and distribution are asked
X interactively when posting a new news. It is recommended to set it
X to non-nil, if you are novice to network news.
X
XVarious hooks for customization:
X gnus-Group-mode-hook
X Entry to this mode calls the value with no arguments, if that
X value is non-nil. This hook is called before connecting to NNTP
X server. So, you can change or define NNTP server host in it.
X
X gnus-Startup-hook
X Called with no arguments after NNTP server is selected. It is
X possible to change the behaver of GNUS or initialize the variables
X according to the server.
X
X gnus-Save-newsrc-hook
X Called with no arguments when saving newsrc file if that value is
X non-nil.
X
X gnus-Inews-article-hook
X Called with no arguments when posting an article if that value is
X non-nil. This hook is called just before posting an article, while
X news-inews-hook is called before preparing article headers. If
X you'd like to convert Kanji code of the article, this hook is recommended.
X
X gnus-Exit-gnus-hook
X Called with no arguments when exiting GNUS, if that value is non-nil."
X (interactive)
X (kill-all-local-variables)
X (if (boundp 'mode-line-modified)
X (setq mode-line-modified "--- ")
X (setq mode-line-format
X (cons "--- " (cdr (default-value 'mode-line-format)))))
X (setq major-mode 'gnus-Group-mode)
X (setq mode-name "GNUS Newsgroup")
X (setq mode-line-buffer-identification "GNUS: List of Newsgroups")
X (setq mode-line-process nil)
X (use-local-map gnus-Group-mode-map)
X (buffer-flush-undo (current-buffer))
X (setq buffer-read-only t) ;Disable modification
X (run-hooks 'gnus-Group-mode-hook))
X
X(defun gnus (&optional confirm)
X "Read network news.
XIf optional argument CONFIRM is non-nil, ask host NNTP server is running."
X (interactive "P")
X (unwind-protect
X (progn
X (switch-to-buffer (get-buffer-create gnus-Group-buffer))
X (gnus-Group-mode)
X (gnus-start-news-server confirm))
X (if (not (nntp-server-opened))
X (gnus-Group-quit)
X ;; NNTP server is successfully open.
X (setq mode-line-process (format " {%s}" gnus-nntp-server))
X (let ((buffer-read-only nil))
X (erase-buffer)
X (gnus-Group-startup-message)
X (sit-for 0))
X (run-hooks 'gnus-Startup-hook)
X (gnus-setup-news-info)
X (gnus-Group-list-groups nil))
X ))
X
X(defun gnus-Group-startup-message ()
X (insert "\n\n\n\n
X GNUS Version 3.10
X
X NNTP-based News Reader for GNU Emacs
X
X
X If you have any trouble with this software, please let me
X know. I will fix your problems in the next release.
X
X Comments, suggestions, and bug fixes are welcome.
X
X Masanobu UMEDA
X umerin@flab.Fujitsu.JUNET
X umerin%flab.Fujitsu.JUNET@uunet.UU.NET"))
X
X(defun gnus-Group-list-groups (show-all)
X "List newsgroups in group selection buffer.
XIf argument SHOW-ALL is non-nil, unsubscribed groups are also listed."
X (interactive "P")
X (gnus-Group-prepare show-all)
X (if (zerop (buffer-size))
X (message "No news is good news")
X ;; Adjust cursor point.
X (goto-char (point-min))
X (search-forward ":" nil t)
X ))
X
X(defun gnus-Group-prepare (&optional all)
X "Prepare list of newsgroups in current buffer.
XIf optional argument ALL is non-nil, unsubscribed groups are also listed."
X (let ((buffer-read-only nil)
X (newsrc gnus-newsrc-assoc)
X (group-info nil)
X (group-name nil)
X (unread-count 0)
X ;; This specifies format of Group display buffer.
X (cntl "%s%s%5d: %s\n"))
X (erase-buffer)
X ;; List newsgroups.
X (while newsrc
X (setq group-info (car newsrc))
X (setq group-name (car group-info))
X (setq unread-count (nth 1 (gnus-gethash group-name gnus-unread-hashtb)))
X (if (or all
X (and (nth 1 group-info) ;Subscribed.
X (> unread-count 0))) ;There are unread articles.
X (insert
X (format cntl
X ;; Subscribed or not.
X (if (nth 1 group-info) " " "U")
X ;; Exists new news?
X (if (and (> unread-count 0)
X (>= 0
X (- unread-count
X (length
X (cdr (assoc group-name
X gnus-marked-assoc))))))
X "*" " ")
X ;; Number of unread articles.
X unread-count
X ;; Newsgroup name.
X group-name))
X )
X (setq newsrc (cdr newsrc))
X )))
X
X(defun gnus-Group-update-group (group &optional visible-only)
X "Update newsgroup info of GROUP.
XIf optional argument VISIBLE-ONLY is non-nil, non displayed group is ignored."
X (let ((buffer-read-only nil)
X (modified nil)
X (visible nil)
X (unread-count 0)
X ;; This specifies format of Group display buffer.
X (cntl "%s%s%5d: %s\n"))
X (save-excursion
X (set-buffer (get-buffer gnus-Group-buffer))
X ;; Search point to modify.
X (goto-char (point-min))
X (if (re-search-forward (concat "^.+: " (regexp-quote group) "$") nil t)
X ;; GROUP is listed in current buffer.
X (progn
X (setq visible t)
X (beginning-of-line)
X (kill-line 1) ;Delete old line.
X ))
X (if (or visible (not visible-only))
X (progn
X (setq modified (point))
X (setq unread-count (nth 1 (gnus-gethash group gnus-unread-hashtb)))
X (insert
X (format cntl
X ;; Subscribed or not.
X (if (nth 1 (assoc group gnus-newsrc-assoc)) " " "U")
X ;; Exists new news?
X (if (and (> unread-count 0)
X (>= 0
X (- unread-count
X (length
X (cdr (assoc group gnus-marked-assoc))))))
X "*" " ")
X ;; Number of unread articles.
X (nth 1 (gnus-gethash group gnus-unread-hashtb))
X ;; Newsgroup name.
X group))
X ))
X )
X ;; Move point of group display buffer to GROUP.
X (if (not visible-only)
X (let ((buffer (current-buffer)))
X (set-buffer (get-buffer gnus-Group-buffer))
X (goto-char modified)
X (set-buffer buffer)))
X ))
X
X;; GNUS Group mode command
X
X(defun gnus-Group-group-name ()
X "Get newsgroup name around point."
X (save-excursion
X (beginning-of-line)
X (if (looking-at ".[* \t]*[0-9]+:[ \t]+\\([^ \t\n]+\\)$")
X (buffer-substring (match-beginning 1) (match-end 1))
X )))
X
X(defun gnus-Group-read-group (all &optional no-article)
X "Read news in this newsgroup.
XIf argument ALL is non-nil, already read articles become readable.
XIf optional argument NO-ARTICLE is non-nil, no article body is displayed."
X (interactive "P")
X (let ((group (gnus-Group-group-name))) ;Newsgroup name to read.
X (if group
X (gnus-Subject-read-group
X group
X (or all
X ;;(not (nth 1 (assoc group gnus-newsrc-assoc))) ;Unsubscribed
X (zerop
X (nth 1 (gnus-gethash group gnus-unread-hashtb)))) ;No unread
X no-article
X ))
X ))
X
X(defun gnus-Group-select-group (all)
X "Select this newsgroup.
XNo article is selected automatically.
XIf argument ALL is non-nil, already read articles become readable."
X (interactive "P")
X (gnus-Group-read-group all t))
X
X(defun gnus-Group-jump-to-group (group)
X "Jump to newsgroup GROUP."
X (interactive
X (list (completing-read "Newsgroup: " gnus-newsrc-assoc nil 'require-match)))
X (if (assoc group gnus-newsrc-assoc)
X (progn
X (goto-char (point-min))
X (or (re-search-forward (concat "^.+: " (regexp-quote group) "$") nil t)
X ;; Add GROUP entry, then seach again.
X (gnus-Group-update-group group))
X ;; Adjust cursor point.
X (beginning-of-line)
X (search-forward ":" nil t))
X ))
X
X(defun gnus-Group-search-forward (backward any-group)
X "Search for newsgroup forward.
XIf 1st argument BACKWARD is non-nil, search backward instead.
XIf 2nd argument ANY-GROUP is non-nil, unsubscribed or empty group
Xmay be selected."
X (let ((func (if backward 're-search-backward 're-search-forward))
X (regexp
X (format "^%s[ \t]*\\(%s\\):"
X (if any-group ".." " [ \t]")
X (if any-group "[0-9]+" "[1-9][0-9]*")))
X (found nil))
X (if backward
X (beginning-of-line)
X (end-of-line))
X (if (funcall func regexp nil t)
X (setq found t))
X ;; Adjust cursor point.
X (beginning-of-line)
X (search-forward ":" nil t)
X ;; Return T if found.
X found
X ))
X
X(defun gnus-Group-next-group (n)
X "Go to next N'th newsgroup."
X (interactive "p")
X (while (and (> n 1)
X (gnus-Group-search-forward nil t))
X (setq n (1- n)))
X (or (gnus-Group-search-forward nil t)
X (message "No more newsgroup")))
X
X(defun gnus-Group-next-unread-group (n)
X "Go to next N'th unread newsgroup."
X (interactive "p")
X (while (and (> n 1)
X (gnus-Group-search-forward nil nil))
X (setq n (1- n)))
X (or (gnus-Group-search-forward nil nil)
X (message "No more unread newsgroup")))
X
X(defun gnus-Group-prev-group (n)
X "Go to previous N'th newsgroup."
X (interactive "p")
X (while (and (> n 1)
X (gnus-Group-search-forward t t))
X (setq n (1- n)))
X (or (gnus-Group-search-forward t t)
X (message "No more newsgroup")))
X
X(defun gnus-Group-prev-unread-group (n)
X "Go to previous N'th unread newsgroup."
X (interactive "p")
X (while (and (> n 1)
X (gnus-Group-search-forward t nil))
X (setq n (1- n)))
X (or (gnus-Group-search-forward t nil)
X (message "No more unread newsgroup")))
X
X(defun gnus-Group-catch-up (no-confirm)
X "Mark all articles in current newsgroup as read.
XIf argument NO-CONFIRM is non-nil, do without confirmations.
XCross references (Xref: field) of articles are ignored."
X (interactive "P")
X (let ((group (gnus-Group-group-name)))
X (if (and group
X (or no-confirm
X (y-or-n-p "Do you really want to mark everything as read? ")))
X (progn
X (gnus-update-unread-articles group nil nil)
X (gnus-Group-update-group group)
X (gnus-Group-next-group 1))
X )))
X
X(defun gnus-Group-unsubscribe-current-group ()
X "Toggle subscribe from/to unsubscribe current group."
X (interactive)
X (gnus-Group-unsubscribe-group (gnus-Group-group-name))
X (gnus-Group-next-group 1))
X
X(defun gnus-Group-unsubscribe-group (group)
X "Toggle subscribe from/to unsubscribe GROUP."
X ;; BUGS: Completing read with gnus-active-hashtb is much better
X ;; since it is possible to add new newsgroup which is ignored by
X ;; options line in .newsrc file. This may be supported in 4.*
X ;; version.
X (interactive
X (list (completing-read "Newsgroup: " gnus-newsrc-assoc nil 'require-match)))
X (let ((newsrc (assoc group gnus-newsrc-assoc)))
X (if newsrc
X (progn
X (setcar (nthcdr 1 newsrc) (not (nth 1 newsrc)))
X (gnus-update-newsrc-buffer group)
X (gnus-Group-update-group group)
X ;; Adjust cursor point.
X (beginning-of-line)
X (search-forward ":" nil t)
X )
X (ding) (message "No such newsgroup: %s" group))
X ))
X
X(defun gnus-Group-list-all-groups ()
X "List all of newsgroups in group selection buffer."
X (interactive)
X (gnus-Group-list-groups t))
X
X(defun gnus-Group-get-new-news (all)
X "Re-read active file.
XIf argument ALL is non-nil, unsubscribed or empty group is also listed."
X (interactive "P")
X (gnus-setup-news-info)
X (gnus-Group-list-groups all))
X
X(defun gnus-Group-check-bogus-groups ()
X "Check bogus newsgroup."
X (interactive)
X (gnus-delete-bogus-newsgroup t) ;Require confirmation.
X (gnus-Group-list-groups nil))
X
X(defun gnus-Group-post-news ()
X "Post an article."
X (interactive)
X (if (get-buffer gnus-Subject-buffer)
X (bury-buffer gnus-Subject-buffer))
X (if (get-buffer gnus-Article-buffer)
X (bury-buffer gnus-Article-buffer))
X (gnus-post-news))
X
X(defun gnus-Group-force-update ()
X "Update .newsrc file."
X (interactive)
X (gnus-save-newsrc-file))
X
X(defun gnus-Group-exit ()
X "Quit reading news after updating .newsrc."
X (interactive)
X (if (or (zerop (buffer-size))
X (not (nntp-server-opened))
X (y-or-n-p "Are you sure you want to quit reading news? "))
X (progn
X (gnus-save-newsrc-file)
X (gnus-clear-system)
X (nntp-close-server)
X (run-hooks 'gnus-Exit-gnus-hook))
X ))
X
X(defun gnus-Group-quit ()
X "Quit reading news without updating .newsrc."
X (interactive)
X (if (or (zerop (buffer-size))
X (not (nntp-server-opened))
X (yes-or-no-p
X (format "Quit reading news without saving %s? "
X (file-name-nondirectory gnus-current-startup-file))))
X (progn
X (gnus-clear-system)
X (nntp-close-server)
X (run-hooks 'gnus-Exit-gnus-hook))
X ))
X
X
X;;;
X;;; GNUS Subject mode
X;;;
X
X(if gnus-Subject-mode-map
X nil
X (setq gnus-Subject-mode-map (make-keymap))
X (suppress-keymap gnus-Subject-mode-map)
X (define-key gnus-Subject-mode-map " " 'gnus-Subject-next-page)
X (define-key gnus-Subject-mode-map "\177" 'gnus-Subject-prev-page)
X (define-key gnus-Subject-mode-map "\r" 'gnus-Subject-scroll-up)
X (define-key gnus-Subject-mode-map "n" 'gnus-Subject-next-unread-article)
X (define-key gnus-Subject-mode-map "p" 'gnus-Subject-prev-unread-article)
X (define-key gnus-Subject-mode-map "N" 'gnus-Subject-next-article)
X (define-key gnus-Subject-mode-map "P" 'gnus-Subject-prev-article)
X (define-key gnus-Subject-mode-map "\e\C-n" 'gnus-Subject-next-same-subject)
X (define-key gnus-Subject-mode-map "\e\C-p" 'gnus-Subject-prev-same-subject)
X ;;(define-key gnus-Subject-mode-map "\e\C-n" 'gnus-Subject-next-unread-same-subject)
X ;;(define-key gnus-Subject-mode-map "\e\C-p" 'gnus-Subject-prev-unread-same-subject)
X (define-key gnus-Subject-mode-map "\C-c\C-n" 'gnus-Subject-next-digest)
X (define-key gnus-Subject-mode-map "\C-c\C-p" 'gnus-Subject-prev-digest)
X (define-key gnus-Subject-mode-map "\C-n" 'gnus-Subject-next-subject)
X (define-key gnus-Subject-mode-map "\C-p" 'gnus-Subject-prev-subject)
X (define-key gnus-Subject-mode-map "\en" 'gnus-Subject-next-unread-subject)
X (define-key gnus-Subject-mode-map "\ep" 'gnus-Subject-prev-unread-subject)
X ;;(define-key gnus-Subject-mode-map "\C-cn" 'gnus-Subject-next-group)
X ;;(define-key gnus-Subject-mode-map "\C-cp" 'gnus-Subject-prev-group)
X (define-key gnus-Subject-mode-map "." 'gnus-Subject-first-unread-article)
X (define-key gnus-Subject-mode-map "/" 'isearch-forward)
X (define-key gnus-Subject-mode-map "s" 'gnus-Subject-isearch-article)
X (define-key gnus-Subject-mode-map "\es" 'gnus-Subject-search-article-forward)
X (define-key gnus-Subject-mode-map "\eS" 'gnus-Subject-search-article-backward)
X (define-key gnus-Subject-mode-map "<" 'gnus-Subject-beginning-of-article)
X (define-key gnus-Subject-mode-map ">" 'gnus-Subject-end-of-article)
X (define-key gnus-Subject-mode-map "j" 'gnus-Subject-goto-subject)
X (define-key gnus-Subject-mode-map "J" 'gnus-Subject-goto-article)
X (define-key gnus-Subject-mode-map "l" 'gnus-Subject-goto-last-article)
X (define-key gnus-Subject-mode-map "^" 'gnus-Subject-refer-parent-article)
X (define-key gnus-Subject-mode-map "\er" 'gnus-Subject-refer-article)
X (define-key gnus-Subject-mode-map "u" 'gnus-Subject-mark-as-unread-forward)
X (define-key gnus-Subject-mode-map "U" 'gnus-Subject-mark-as-unread-backward)
X (define-key gnus-Subject-mode-map "d" 'gnus-Subject-mark-as-read-forward)
X (define-key gnus-Subject-mode-map "D" 'gnus-Subject-mark-as-read-backward)
X (define-key gnus-Subject-mode-map "\eu" 'gnus-Subject-clear-mark-forward)
X (define-key gnus-Subject-mode-map "\eU" 'gnus-Subject-clear-mark-backward)
X (define-key gnus-Subject-mode-map "k" 'gnus-Subject-kill-same-subject-and-select)
X (define-key gnus-Subject-mode-map "\C-k" 'gnus-Subject-kill-same-subject)
X (define-key gnus-Subject-mode-map "&" 'gnus-Subject-execute-command)
X ;;(define-key gnus-Subject-mode-map "c" 'gnus-Subject-catch-up)
X (define-key gnus-Subject-mode-map "c" 'gnus-Subject-catch-up-and-exit)
X (define-key gnus-Subject-mode-map "\C-t" 'gnus-Subject-toggle-truncation)
X (define-key gnus-Subject-mode-map "x" 'gnus-Subject-delete-marked-as-read)
X (define-key gnus-Subject-mode-map "X" 'gnus-Subject-delete-marked)
X (define-key gnus-Subject-mode-map "\C-c\C-sn" 'gnus-Subject-sort-by-number)
X (define-key gnus-Subject-mode-map "\C-c\C-sa" 'gnus-Subject-sort-by-author)
X (define-key gnus-Subject-mode-map "\C-c\C-ss" 'gnus-Subject-sort-by-subject)
X (define-key gnus-Subject-mode-map "\C-c\C-sd" 'gnus-Subject-sort-by-date)
X (define-key gnus-Subject-mode-map "\C-c\C-s\C-n" 'gnus-Subject-sort-by-number)
X (define-key gnus-Subject-mode-map "\C-c\C-s\C-a" 'gnus-Subject-sort-by-author)
X (define-key gnus-Subject-mode-map "\C-c\C-s\C-s" 'gnus-Subject-sort-by-subject)
X (define-key gnus-Subject-mode-map "\C-c\C-s\C-d" 'gnus-Subject-sort-by-date)
X (define-key gnus-Subject-mode-map "=" 'delete-other-windows)
X (define-key gnus-Subject-mode-map "G" 'gnus-Subject-show-all-subjects)
X (define-key gnus-Subject-mode-map "w" 'gnus-Subject-stop-page-breaking)
X (define-key gnus-Subject-mode-map "\C-c\C-r" 'gnus-Subject-caesar-message)
X (define-key gnus-Subject-mode-map "g" 'gnus-Subject-show-article)
X (define-key gnus-Subject-mode-map "t" 'gnus-Subject-toggle-header)
X (define-key gnus-Subject-mode-map "v" 'gnus-Subject-show-all-headers)
X (define-key gnus-Subject-mode-map "\C-d" 'gnus-Subject-rmail-digest)
X (define-key gnus-Subject-mode-map "a" 'gnus-Subject-post-news)
X (define-key gnus-Subject-mode-map "f" 'gnus-Subject-post-reply)
X (define-key gnus-Subject-mode-map "C" 'gnus-Subject-cancel)
X (define-key gnus-Subject-mode-map "r" 'gnus-Subject-mail-reply)
X (define-key gnus-Subject-mode-map "m" 'gnus-Subject-mail-other-window)
X (define-key gnus-Subject-mode-map "o" 'gnus-Subject-save-article)
X (define-key gnus-Subject-mode-map "\C-o" 'gnus-Subject-save-in-mail)
X (define-key gnus-Subject-mode-map "|" 'gnus-Subject-pipe-output)
X (define-key gnus-Subject-mode-map "K" 'gnus-Kill-file-edit-local)
X (define-key gnus-Subject-mode-map "V" 'gnus-version)
X (define-key gnus-Subject-mode-map "?" 'describe-mode)
X (define-key gnus-Subject-mode-map "q" 'gnus-Subject-exit)
X (define-key gnus-Subject-mode-map "Q" 'gnus-Subject-quit))
X
X(defun gnus-Subject-mode ()
X "Major mode for reading news in this newsgroup.
XAll normal editing commands are turned off.
XInstead, these commands are available:
X
X\\[gnus-Subject-next-page] Scroll to next page of current article.
X Next unread article's selected automatically at the end of the message.
X\\[gnus-Subject-prev-page] Scroll to previous page of current article.
X\\[gnus-Subject-scroll-up] Scroll up (or down) one line current article.
X\\[gnus-Subject-next-unread-article] Move to next unread article.
X\\[gnus-Subject-prev-unread-article] Move to previous unread article.
X\\[gnus-Subject-next-article] Move to next article whether read or not.
X\\[gnus-Subject-prev-article] Move to previous article whether read or not.
X\\[gnus-Subject-next-same-subject] Move to next article which has same subject as current article.
X\\[gnus-Subject-prev-same-subject] Move to previous article which has same subject as current article.
X\\[gnus-Subject-next-unread-same-subject] Move to next unread article which has same subject as current article.
X\\[gnus-Subject-prev-unread-same-subject] Move to previous unread article which has same subject as current article.
X\\[gnus-Subject-next-digest] Scroll to next digested message of current article.
X\\[gnus-Subject-prev-digest] Scroll to previous digested message of current article.
X\\[gnus-Subject-next-subject] Move to next subject line.
X\\[gnus-Subject-prev-subject] Move to previous subject line.
X\\[gnus-Subject-next-unread-subject] Move to next unread article's subject.
X\\[gnus-Subject-prev-unread-subject] Move to previous unread article's subject.
X\\[gnus-Subject-next-group] Exit current newsgroup and select next unread newsgroup.
X\\[gnus-Subject-prev-group] Exit current newsgroup and select previous unread newsgroup.
X\\[gnus-Subject-first-unread-article] Jump to first unread article in current newsgroup.
X\\[isearch-forward] Do incremental search forward on subjects.
X\\[gnus-Subject-isearch-article] Do incremental search forward on current article.
X\\[gnus-Subject-search-article-forward] Search for an article containing regexp forward.
X\\[gnus-Subject-search-article-backward] Search for an article containing regexp backward.
X\\[gnus-Subject-beginning-of-article] Move point to beginning of current article.
X\\[gnus-Subject-end-of-article] Move point to end of current article.
X\\[gnus-Subject-goto-subject] Jump to article specified by numeric article ID.
X\\[gnus-Subject-goto-article] Jump to article specified by numeric article ID, then read it.
X\\[gnus-Subject-goto-last-article] Jump to article you read last.
X\\[gnus-Subject-refer-parent-article] Refer parent article of current article.
X\\[gnus-Subject-refer-article] Refer article specified by message-id.
X\\[gnus-Subject-mark-as-unread-forward] Mark current article as unread, and go forward.
X\\[gnus-Subject-mark-as-unread-backward] Mark current article as unread, and go backward.
X\\[gnus-Subject-mark-as-read-forward] Mark current article as read, and go forward.
X\\[gnus-Subject-mark-as-read-backward] Mark current article as read, and go backward.
X\\[gnus-Subject-clear-mark-forward] Clear current article's mark, and go forward.
X\\[gnus-Subject-clear-mark-backward] Clear current article's mark, and go backward.
SHAR_EOF
echo "End of part 1, continue with part 2"
echo "2" > s2_seq_.tmp
exit 0
--
Masanobu UMEDA
umerin@flab.flab.Fujitsu.JUNET
umerin%flab.flab.Fujitsu.JUNET@uunet.uu.NETumerin@flab.flab.fujitsu.JUNET (Masanobu UMEDA) (11/11/88)
---- Cut Here and unpack ----
#!/bin/sh
# this is part 2 of a multipart archive
# do not concatenate these parts, unpack them in order with /bin/sh
# file gnus.el continued
#
CurArch=2
if test ! -r s2_seq_.tmp
then echo "Please unpack part 1 first!"
exit 1; fi
( read Scheck
if test "$Scheck" != $CurArch
then echo "Please unpack part $Scheck next!"
exit 1;
else exit 0; fi
) < s2_seq_.tmp || exit 1
sed 's/^X//' << 'SHAR_EOF' >> gnus.el
X\\[gnus-Subject-kill-same-subject-and-select] Mark articles which has same subject as current article as read,
X and then select next unread article.
X\\[gnus-Subject-kill-same-subject] Mark articles which has same subject as current article as read.
X\\[gnus-Subject-execute-command] Execute a command for each article conditionally.
X\\[gnus-Subject-catch-up] Mark all of articles of current newsgroup as read.
X\\[gnus-Subject-catch-up-and-exit] Catch up and then exit current newsgroup.
X\\[gnus-Subject-toggle-truncation] Toggle truncation of subject lines.
X\\[gnus-Subject-delete-marked-as-read] Delete subject lines marked as read.
X\\[gnus-Subject-delete-marked] Delete subject lines with specified marks.
X\\[gnus-Subject-sort-by-number] Sort subjects by article number.
X\\[gnus-Subject-sort-by-author] Sort subjects by article author name.
X\\[gnus-Subject-sort-by-subject] Sort subjects alphabetically.
X\\[gnus-Subject-sort-by-date] Sort subjects by posted date.
X\\[delete-other-windows] Show subjects (delete article display window).
X\\[gnus-Subject-show-all-subjects] Show all subjects of current newsgroup.
X\\[gnus-Subject-stop-page-breaking] Stop page breaking by linefeed.
X\\[gnus-Subject-caesar-message] Caesar rotates letters by 13/47 places.
X\\[gnus-Subject-show-article] Force to show current article.
X\\[gnus-Subject-toggle-header] Show original article header if pruned header currently shown, or vice versa.
X\\[gnus-Subject-show-all-headers] Show original article header.
X\\[gnus-Subject-rmail-digest] Run RMAIL on current digest article.
X\\[gnus-Subject-post-news] Post an article.
X\\[gnus-Subject-post-reply] Post a reply article.
X\\[gnus-Subject-cancel] Cancel current article. (The article must be yours).
X\\[gnus-Subject-mail-reply] Mail a message to the author.
X\\[gnus-Subject-mail-other-window] Mail a message in other window.
X\\[gnus-Subject-save-article] Save current article in your favorite format.
X\\[gnus-Subject-save-in-mail] Append current article to file in Unix mail format.
X\\[gnus-Subject-pipe-output] Pipe contents of current article to subprocess.
X\\[gnus-Kill-file-edit-local] Edit local KILL file.
X\\[gnus-version] Show version number of this GNUS.
X\\[describe-mode] Describe this mode.
X\\[gnus-Subject-exit] Quit reading news in current newsgroup.
X\\[gnus-Subject-quit] Quit reading news without updating read articles information.
X
XUser customizable variables:
X gnus-subject-lines-height
X Height of subject display window.
X
X gnus-article-save-name
X Specifies function generating file name saving an article to. This
X function is called with 2 arguments, NEWSGROUP and HEADERS. Access
X macros to the headers are defined as nntp-header-FIELD, and
X functions are defined as gnus-header-FIELD.
X
X gnus-article-default-saver
X Specifies your favorite article saver which is interactively
X funcallable. Following functions are available:
X
X gnus-Subject-save-in-rmail (in Rmail format)
X gnus-Subject-save-in-mail (in Unix mail format)
X gnus-Subject-save-in-folder (in MH folder)
X gnus-Subject-save-in-file (in plain file).
X
X gnus-article-save-directory
X Specifies directory name to save an article to using the command
X gnus-Subject-save-in-rmail, gnus-Subject-save-in-mail and
X gnus-Subject-save-in-file. The variable is initialized from the
X SAVEDIR environment variable.
X
X gnus-use-long-file-name
X Non-nil means newsgroup name of an article to be saved is used as
X file name. Directory form of the newsgroup is used instead if nil.
X
X gnus-article-mh-folder
X Specifies MH folder name saving an article in using the command
X gnus-Subject-save-in-folder.
X
X gnus-show-all-headers
X Non-nil means all headers of an article are shown.
X
X gnus-save-all-headers
X Non-nil means all headers of an article are saved in a file.
X
X gnus-auto-select-first
X Non-nil means first unread article is selected automagically when
X a newsgroup is selected normally (by gnus-Group-read-group). If
X you'd like to prevent auto selection of first unread article in
X some newsgroups, set the variable to nil in gnus-Select-group-hook
X or gnus-Apply-kill-hook.
X
X gnus-auto-select-next
X Non-nil means next newsgroup is selected automagically at the end
X of the newsgroup. If the value is t and the next newsgroup is
X empty (no unread articles), GNUS will exit Subject mode and go
X back to Group mode. If the value is not nil nor t, GNUS won't exit
X Subject mode but select following unread newsgroup. Especially, if
X the value is a symbol `quietly', next unread newsgroup will be
X selected without any confirmations.
X
X gnus-auto-select-same
X Non-nil means an article with same subject as current article is
X selected automagically like `rn -S'.
X
X gnus-break-pages
X Non-nil means an article is broken in pages at page delimiter.
X This may not work with some version of GNU Emacs before 18.50.
X
X gnus-page-delimiter
X Specifies regexp describing line-beginnings that separate pages of
X news article.
X
X gnus-more-message
X Specifies message shown at end of pages in page break mode.
X Length of the message string must be shorter than or equal to that
X of page delimiter if GNU Emacs is earlier than 18.52.
X
X gnus-digest-show-summary
X Non-nil means summary of digest messages is shown when reading
X digest article using `gnus-Subject-rmail-digest' command.
X
X gnus-optional-headers
X Specifies a function which generate a string displayed in GNUS
X Subject mode buffer. The function is called with an article
X headers. The result must be a string without `[' nor `]'.
X Standard function returns a string like NNN:AUTHOR, where NNN is
X lines of an article and AUTHOR is its author name.
X
X gnus-keep-subject-centered
X Non-nil means a point of GNUS Subject mode window is always kept
X centered.
X
XVarious hooks for customization:
X gnus-Subject-mode-hook
X Entry to this mode calls the value with no arguments, if that
X value is non-nil.
X
X gnus-Select-group-hook
X Called with no arguments when newsgroup is selected, if that value
X is non-nil. It is possible to sort subjects in this hook. See
X documentation of this variable for more information.
X
X gnus-Subject-prepare-hook
X Called with no arguments after subject list is created, if that
X value is non-nil. If you'd like to modify the buffer, you can use
X this hook.
X
X gnus-Select-article-hook
X Called with no arguments when article is selected, if that value
X is non-nil. See documentation of this variable for more information.
X
X gnus-Select-digest-hook
X Called with no arguments when reading digest messages using Rmail,
X if that value is non-nil. The hook can be used to modify an
X article so that Rmail can work with it. See documentation of the
X variable for more information.
X
X gnus-Rmail-digest-hook
X Called with no arguments when reading digest messages using Rmail,
X if that value is non-nil. The hook is intended to customize Rmail mode.
X
X gnus-Apply-kill-hook
X Called with no arguments when a newsgroup is selected and GNUS
X Subject mode buffer is prepared. This hook is intended to apply a
X KILL file to selected newsgroup. Format of KILL file is completely
X different from that of 3.8 version. You need to rewrite them in
X the new format. See documentation of Kill file mode for more
X information.
X
X gnus-Mark-article-hook
X Called with no arguments when an article is selected at first
X time. The hook is intended to mark an article as read (or unread)
X automatically when it is selected. See documentation of the
X variable for more information.
X
X gnus-Exit-group-hook
X Called with no arguments when exiting current newsgroup, if that
X value is non-nil. If your machine is so slow that exiting from
X Subject mode takes very long time, inhibit marking articles as
X read using cross-references by setting variable
X gnus-newsgroup-headers to nil."
X (interactive)
X (kill-all-local-variables)
X (if (boundp 'mode-line-modified)
X (setq mode-line-modified "--- ")
X (setq mode-line-format
X (cons "--- " (cdr (default-value 'mode-line-format)))))
X (make-local-variable 'global-mode-string)
X (setq global-mode-string nil)
X (setq major-mode 'gnus-Subject-mode)
X (setq mode-name "GNUS Subject")
X ;;(setq mode-line-process '(" " gnus-newsgroup-name))
X (gnus-Subject-set-mode-line)
X (use-local-map gnus-Subject-mode-map)
X (buffer-flush-undo (current-buffer))
X (setq buffer-read-only t) ;Disable modification
X (setq truncate-lines t) ;Stop folding of lines.
X (setq case-fold-search nil) ;Don't ignore case.
X (run-hooks 'gnus-Subject-mode-hook))
X
X(defun gnus-Subject-setup-buffer ()
X "Initialize subject display buffer."
X (if (get-buffer gnus-Subject-buffer)
X (set-buffer gnus-Subject-buffer)
X (set-buffer (get-buffer-create gnus-Subject-buffer))
X (gnus-Subject-mode)
X ))
X
X(defun gnus-Subject-read-group (group &optional show-all no-article)
X "Start reading news in newsgroup GROUP.
XIf optional 1st argument SHOW-ALL is non-nil, already read articles are
Xalso listed.
XIf optional 2nd argument NO-ARTICLE is non-nil, no article is selected
Xinitially."
X (message "Retrieving newsgroup: %s..." group)
X (if (gnus-select-newsgroup group show-all)
X (progn
X ;; Don't switch-to-buffer to prevent displaying old contents
X ;; of the buffer until new subjects list is created.
X ;; Suggested by Juha Heinanen <jh@tut.fi>
X (gnus-Subject-setup-buffer)
X ;; You can change the order of subjects in this hook.
X (run-hooks 'gnus-Select-group-hook)
X (gnus-Subject-prepare)
X ;; Function `gnus-Kill-file-apply' must be called in this hook.
X (run-hooks 'gnus-Apply-kill-hook)
X (if (zerop (buffer-size))
X ;; This newsgroup is empty.
X (progn
X (setq gnus-newsgroup-unreads nil)
X (gnus-Subject-exit)
X (message "No unread news"))
X ;; Show first unread article if requested.
X (goto-char (point-min))
X (if (and (not no-article)
X gnus-auto-select-first
X (gnus-Subject-first-unread-article))
X ;; Window is configured automatically.
X ;; Current buffer may be changed as a result of hook
X ;; evaluation, especially by gnus-Subject-rmail-digest
X ;; command, so we should not adjust cursor point here.
X nil
X (switch-to-buffer gnus-Subject-buffer)
X (gnus-Subject-set-mode-line)
X ;; Kill article display buffer because I sometime get
X ;; confused by old article buffer.
X (if (get-buffer gnus-Article-buffer)
X (let ((article-window
X (get-buffer-window gnus-Article-buffer)))
X (if article-window
X (delete-window article-window))
X (kill-buffer gnus-Article-buffer)))
X ;; Adjust cursor point.
X (beginning-of-line)
X (search-forward ":" nil t))
X ))
X ;; Cannot select newsgroup GROUP.
X (ding) (message "No such newsgroup: %s" group)
X (sit-for 0)
X ;; Run checking bogus newsgroups.
X (gnus-delete-bogus-newsgroup t) ;Confirm
X ))
X
X(defun gnus-Subject-prepare ()
X "Prepare subject list of current newsgroup in Subject mode buffer."
X (let* ((buffer-read-only nil)
X (number 0)
X (headers gnus-newsgroup-headers)
X (header nil)
X ;; This defines format of Subject mode buffer.
X (cntl
X (format "%%s %%%dd: [%%s] %%s\n"
X (length (prin1-to-string gnus-newsgroup-end)))))
X (erase-buffer)
X (while headers
X (setq header (car headers))
X (if header
X (progn
X (setq number (nntp-header-number header))
X (insert
X (format cntl
X ;; Read or not.
X (cond ((memq number gnus-newsgroup-marked) "-")
X ((memq number gnus-newsgroup-unreads) " ")
X (t "D"))
X ;; Article number.
X number
X ;; Optional headers.
X (or (and gnus-optional-headers
X (funcall gnus-optional-headers header)) "")
X ;; Its subject string.
X (nntp-header-subject header)))
X ))
X (setq headers (cdr headers))
X )
X ;; Erase header retrieval message.
X (message "")
X ;; Call hooks for modifying Subject mode buffer.
X ;; Suggested by sven@tde.LTH.Se (Sven Mattisson).
X (goto-char (point-min))
X (run-hooks 'gnus-Subject-prepare-hook)
X ))
X
X(defun gnus-Subject-set-mode-line ()
X "Set Subject mode line string."
X (setq mode-line-buffer-identification
X (list 17
X (concat "GNUS: "
X (if gnus-current-headers
X (nntp-header-subject gnus-current-headers)
X gnus-newsgroup-name))))
X (set-buffer-modified-p t))
X
X;;(defun gnus-Subject-set-mode-line ()
X;; "Set Subject mode line string."
X;; (let ((subject (if gnus-current-headers
X;; (nntp-header-subject gnus-current-headers)
X;; gnus-newsgroup-name)))
X;; (setq mode-line-process (concat " " gnus-newsgroup-name))
X;; (setq mode-line-buffer-identification
X;; (concat "GNUS: "
X;; subject
X;; ;; Enough spaces to pad subject to 17 positions.
X;; (substring " "
X;; 0 (max 0 (- 17 (length subject))))))
X;; (set-buffer-modified-p t)
X;; ))
X
X;; GNUS Subject mode command.
X
X(defun gnus-Subject-search-group (&optional backward)
X "Search for next unread newsgroup.
XIf optional argument BACKWARD is non-nil, search backward instead."
X (save-excursion
X (set-buffer gnus-Group-buffer)
X (save-excursion
X ;; We don't want to alter current point of Group mode buffer.
X (if (gnus-Group-search-forward backward nil)
X (gnus-Group-group-name))
X )))
X
X(defun gnus-Subject-search-subject (backward unread subject)
X "Search for article forward.
XIf 1st argument BACKWARD is non-nil, search backward.
XIf 2nd argument UNREAD is non-nil, only unread article is selected.
XIf 3rd argument SUBJECT is non-nil, the article which has
Xthe same subject will be searched for."
X (let ((func (if backward 're-search-backward 're-search-forward))
X (article nil)
X (regexp
X (format "^%s[ \t]+\\([0-9]+\\):[ \t]+\\[.*\\][ \t]+%s"
X ;;(if unread " " ".")
X (cond ((eq unread t) " ") (unread "[ ---]") (t "."))
X (if subject
X (concat "\\([Rr][Ee]:[ \t]+\\)*"
X (regexp-quote (gnus-simplify-subject subject))
X ;; Ignore words in parentheses.
X "\\([ \t]*(.*)\\)*[ \t]*$")
X "")
X )))
X (if backward
X (beginning-of-line)
X (end-of-line))
X (if (funcall func regexp nil t)
X (setq article
X (string-to-int
X (buffer-substring (match-beginning 1) (match-end 1)))))
X ;; Adjust cursor point.
X (beginning-of-line)
X (search-forward ":" nil t)
X ;; This is the result.
X article
X ))
X
X(defun gnus-Subject-search-forward (&optional unread subject)
X "Search for article forward.
XIf 1st optional argument UNREAD is non-nil, only unread article is selected.
XIf 2nd optional argument SUBJECT is non-nil, the article which has
Xthe same subject will be searched for."
X (gnus-Subject-search-subject nil unread subject))
X
X(defun gnus-Subject-search-backward (&optional unread subject)
X "Search for article backward.
XIf 1st optional argument UNREAD is non-nil, only unread article is selected.
XIf 2nd optional argument SUBJECT is non-nil, the article which has
Xthe same subject will be searched for."
X (gnus-Subject-search-subject t unread subject))
X
X(defun gnus-Subject-article-number ()
X "Article number around point. If nothing, return current number."
X (save-excursion
X (beginning-of-line)
X (if (looking-at ".[ \t]+\\([0-9]+\\):")
X (string-to-int
X (buffer-substring (match-beginning 1) (match-end 1)))
X ;; If search fail, return current article number.
X gnus-current-article
X )))
X
X(defun gnus-Subject-subject-string ()
X "Return current subject string or nil if nothing."
X (save-excursion
X ;; It is possible to implement this function using
X ;; `gnus-Subject-article-number' and `gnus-newsgroup-headers'.
X (beginning-of-line)
X (if (looking-at ".[ \t]+[0-9]+:[ \t]+\\[.*\\][ \t]+\\(.*\\)$")
X (buffer-substring (match-beginning 1) (match-end 1)))
X ))
X
X(defun gnus-Subject-goto-subject (article)
X "Move point to ARTICLE's subject."
X (interactive
X (list
X (string-to-int
X (completing-read "Article number: "
X (mapcar
X (function
X (lambda (headers)
X (list
X (int-to-string (nntp-header-number headers)))))
X gnus-newsgroup-headers)
X nil 'require-match))))
X (let ((current (point)))
X (goto-char (point-min))
X (or (and article (re-search-forward (format "^.[ \t]+%d:" article) nil t))
X (progn (goto-char current) nil))
X ))
X
X(defun gnus-Subject-recenter ()
X "Center point in Subject mode window."
X ;; Scroll window so as to cursor comes center of Subject mode window
X ;; only when article is displayed.
X ;; Suggested by earle@mahendo.JPL.NASA.GOV (Greg Earle).
X ;; Recenter only when requested.
X ;; Subbested by popovich@park.cs.columbia.edu
X (and gnus-keep-subject-centered
X (get-buffer-window gnus-Article-buffer)
X (< (/ (- (window-height) 1) 2)
X (count-lines (point) (point-max)))
X (recenter (/ (- (window-height) 2) 2))))
X
X;; Walking around Group mode buffer.
X
X(defun gnus-Subject-next-group (no-article)
X "Exit current newsgroup and then select next unread newsgroup.
XIf prefix argument NO-ARTICLE is non-nil, no article is selected initially."
X (interactive "P")
X (let ((group (gnus-Subject-search-group)))
X (if (null group)
X (progn
X (message "Exiting %s..." gnus-newsgroup-name)
X (gnus-Subject-exit)
X (message ""))
X (message "Selecting %s..." group)
X (gnus-Subject-exit t) ;Exit Subject mode temporary.
X ;; Now current point of Group mode buffer is pointing GROUP.
X (gnus-Subject-read-group group nil no-article)
X (or (eq (current-buffer)
X (get-buffer gnus-Subject-buffer))
X (eq gnus-auto-select-next t)
X ;; Expected newsgroup has nothing to read since the articles
X ;; are marked as read by cross-referencing. So, try next
X ;; newsgroup. (Make sure we are in Group mode buffer now.)
X (and (eq (current-buffer)
X (get-buffer gnus-Group-buffer))
X (gnus-Group-group-name)
X (gnus-Subject-read-group
X (gnus-Group-group-name) nil no-article))
X )
X )))
X
X(defun gnus-Subject-prev-group (no-article)
X "Exit current newsgroup and then select previous unread newsgroup.
XIf prefix argument NO-ARTICLE is non-nil, no article is selected initially."
X (interactive "P")
X (let ((group (gnus-Subject-search-group t)))
X (if (null group)
X (progn
X (message "Exiting %s..." gnus-newsgroup-name)
X (gnus-Subject-exit)
X (message ""))
X (message "Selecting %s..." group)
X (gnus-Subject-exit t) ;Exit Subject mode temporary.
X ;; We have to adjust point of Group mode buffer because current
X ;; point is moved to next unread newsgroup by exiting.
X (gnus-Group-jump-to-group group)
X (gnus-Subject-read-group group nil no-article)
X (or (eq (current-buffer)
X (get-buffer gnus-Subject-buffer))
X (eq gnus-auto-select-next t)
X ;; Expected newsgroup has nothing to read since the articles
X ;; are marked as read by cross-referencing. So, try next
X ;; newsgroup. (Make sure we are in Group mode buffer now.)
X (and (eq (current-buffer)
X (get-buffer gnus-Group-buffer))
X (gnus-Subject-search-group t)
X (gnus-Subject-read-group
X (gnus-Subject-search-group t) nil no-article))
X )
X )))
X
X;; Walking around subject lines.
X
X(defun gnus-Subject-next-subject (n &optional unread)
X "Go to next N'th subject line.
XIf optional argument UNREAD is non-nil, only unread article is selected."
X (interactive "p")
X (while (and (> n 1)
X (gnus-Subject-search-forward unread))
X (setq n (1- n)))
X (cond ((gnus-Subject-search-forward unread)
X (gnus-Subject-recenter))
X (unread
X (message "No more unread articles"))
X (t
X (message "No more articles"))
X ))
X
X(defun gnus-Subject-next-unread-subject (n)
X "Go to next N'th unread subject line."
X (interactive "p")
X (gnus-Subject-next-subject n t))
X
X(defun gnus-Subject-prev-subject (n &optional unread)
X "Go to previous N'th subject line.
XIf optional argument UNREAD is non-nil, only unread article is selected."
X (interactive "p")
X (while (and (> n 1)
X (gnus-Subject-search-backward unread))
X (setq n (1- n)))
X (cond ((gnus-Subject-search-backward unread)
X (gnus-Subject-recenter))
X (unread
X (message "No more unread articles"))
X (t
X (message "No more articles"))
X ))
X
X(defun gnus-Subject-prev-unread-subject (n)
X "Go to previous N'th unread subject line."
X (interactive "p")
X (gnus-Subject-prev-subject n t))
X
X;; Walking around subject lines with displaying articles.
X
X(defun gnus-Subject-configure-window ()
X "Configure Subject mode and Article mode windows.
XOne is for reading subjects and the other is for articles."
X (interactive)
X (if (or (one-window-p t)
X (null (get-buffer-window gnus-Article-buffer))
X (null (get-buffer-window gnus-Subject-buffer)))
X (progn
X ;; We have to prepare Article mode buffer first to prevent
X ;; displaying subject buffer twice.
X ;; Suggested by Juha Heinanen <jh@tut.fi>
X (gnus-Article-setup-buffer)
X (switch-to-buffer gnus-Subject-buffer)
X (delete-other-windows)
X (split-window-vertically
X (max window-min-height (1+ gnus-subject-lines-height)))
X (other-window 1)
X (switch-to-buffer gnus-Article-buffer)
X (other-window 1)
X )))
X
X(defun gnus-Subject-display-article (article &optional all-header)
X "Display ARTICLE in Article mode buffer."
X (if (null article)
X nil
X (gnus-Subject-configure-window)
X (gnus-Article-prepare article all-header)
X (gnus-Subject-recenter)
X (gnus-Subject-set-mode-line)
X (run-hooks 'gnus-Select-article-hook)
X ;; Successfully display article.
X t
X ))
X
X(defun gnus-Subject-select-article (&optional all-headers force)
X "Select current article.
XOptional argument ALL-HEADERS is non-nil, show all headers."
X (let ((article (gnus-Subject-article-number)))
X (if (or (null gnus-current-article)
X (/= article gnus-current-article)
X (and force (not (eq all-headers gnus-have-all-headers))))
X ;; Selected subject is different from current article's.
X (gnus-Subject-display-article article all-headers)
X (gnus-Subject-configure-window))
X ))
X
X;;(defun gnus-Subject-next-article (unread &optional subject)
X;; "Select article after current one.
X;;If argument UNREAD is non-nil, only unread article is selected."
X;; (interactive "P")
X;; (cond ((gnus-Subject-display-article
X;; (gnus-Subject-search-forward unread subject)))
X;; (unread
X;; (message "No more unread articles"))
X;; (t
X;; (message "No more articles"))
X;; ))
X
X(defun gnus-Subject-next-article (unread &optional subject)
X "Select article after current one.
XIf argument UNREAD is non-nil, only unread article is selected."
X (interactive "P")
X (cond ((gnus-Subject-display-article
X (gnus-Subject-search-forward unread subject)))
X ((and subject
X gnus-auto-select-same
X (gnus-set-difference gnus-newsgroup-unreads
X gnus-newsgroup-marked)
X (memq this-command
X '(gnus-Subject-next-unread-article
X gnus-Subject-next-page
X gnus-Subject-kill-same-subject-and-select
X ;;gnus-Subject-next-article
X ;;gnus-Subject-next-same-subject
X ;;gnus-Subject-next-unread-same-subject
X )))
X ;; Hook function, such as gnus-Subject-rmail-digest, may
X ;; change current buffer, so need check.
X (let ((buffer (current-buffer))
X (last-point (point)))
X ;; No more articles with same subject, so jump to the first
X ;; unread article.
X (gnus-Subject-first-unread-article)
X ;;(and (eq buffer (current-buffer))
X ;; (= (point) last-point)
X ;; ;; Ignore given SUBJECT, and try again.
X ;; (gnus-Subject-next-article unread nil))
X (and (eq buffer (current-buffer))
X (< (point) last-point)
X (message "Wrapped"))
X ))
X (t
X (let ((cmd (string-to-char (this-command-keys)))
X (group (gnus-Subject-search-group))
X (auto-select
X (and gnus-auto-select-next
X ;;(null (gnus-set-difference gnus-newsgroup-unreads
X ;; gnus-newsgroup-marked))
X (memq this-command
X '(gnus-Subject-next-unread-article
X gnus-Subject-next-article
X gnus-Subject-next-page
X gnus-Subject-next-same-subject
X gnus-Subject-next-unread-same-subject
X gnus-Subject-kill-same-subject
X gnus-Subject-kill-same-subject-and-select
X ))
X ;; Ignore characters typed ahead.
X (not (input-pending-p))
X )))
X (message "No more%s articles%s"
X (if unread " unread" "")
X (if (and auto-select
X (not (eq gnus-auto-select-next 'quietly)))
X (if group
X (format " (Type %s to %s [%d])"
X (key-description (char-to-string cmd))
X group
X (nth 1 (gnus-gethash group
X gnus-unread-hashtb)))
X (format " (Type %s to exit %s)"
X (key-description (char-to-string cmd))
X gnus-newsgroup-name
X ))
X ""))
X ;; Select next unread newsgroup automagically.
X (cond ((and auto-select
X (eq gnus-auto-select-next 'quietly))
X ;; Select quietly.
X (gnus-Subject-next-group nil))
X (auto-select
X ;; Confirm auto selection.
X (let ((char (read-char)))
X (if (= char cmd)
X (gnus-Subject-next-group nil)
X (setq unread-command-char char))))
X )
X ))
X ))
X
X(defun gnus-Subject-next-unread-article ()
X "Select unread article after current one."
X (interactive)
X (gnus-Subject-next-article t (and gnus-auto-select-same
X (gnus-Subject-subject-string))))
X
X(defun gnus-Subject-prev-article (unread &optional subject)
X "Select article before current one.
XIf argument UNREAD is non-nil, only unread article is selected."
X (interactive "P")
X (cond ((gnus-Subject-display-article
X (gnus-Subject-search-backward unread subject)))
X ((and subject
X gnus-auto-select-same
X (gnus-set-difference gnus-newsgroup-unreads
X gnus-newsgroup-marked)
X (memq this-command
X '(gnus-Subject-prev-unread-article
X ;;gnus-Subject-prev-page
X ;;gnus-Subject-prev-article
X ;;gnus-Subject-prev-same-subject
X ;;gnus-Subject-prev-unread-same-subject
X )))
X ;; Ignore given SUBJECT, and try again.
X (gnus-Subject-prev-article unread nil))
X (unread
X (message "No more unread articles"))
X (t
X (message "No more articles"))
X ))
X
X(defun gnus-Subject-prev-unread-article ()
X "Select unred article before current one."
X (interactive)
X (gnus-Subject-prev-article t (and gnus-auto-select-same
X (gnus-Subject-subject-string))))
X
X(defun gnus-Subject-next-page (lines)
X "Show next page of selected article.
XIf end of artile, select next article.
XArgument LINES specifies lines to be scrolled up."
X (interactive "P")
X (let ((article (gnus-Subject-article-number))
X (endp nil))
X (if (or (null gnus-current-article)
X (/= article gnus-current-article))
X ;; Selected subject is different from current article's.
X (gnus-Subject-display-article article)
X (gnus-Subject-configure-window)
X (eval-in-buffer-window gnus-Article-buffer
X (setq endp (gnus-Article-next-page lines)))
X (cond ((and endp lines)
X (message "End of message"))
X ((and endp (null lines))
X (gnus-Subject-next-unread-article)))
X )))
X
X(defun gnus-Subject-prev-page (lines)
X "Show previous page of selected article.
XArgument LINES specifies lines to be scrolled down."
X (interactive "P")
X (let ((article (gnus-Subject-article-number)))
X (if (or (null gnus-current-article)
X (/= article gnus-current-article))
X ;; Selected subject is different from current article's.
X (gnus-Subject-display-article article)
X (gnus-Subject-configure-window)
X (eval-in-buffer-window gnus-Article-buffer
X (gnus-Article-prev-page lines))
X )))
X
X(defun gnus-Subject-scroll-up (lines)
X "Scroll up (or down) one line current article.
XArgument LINES specifies lines to be scrolled up (or down if negative)."
X (interactive "p")
X (gnus-Subject-select-article)
X (eval-in-buffer-window gnus-Article-buffer
X (cond ((> lines 0)
X (if (gnus-Article-next-page lines)
X (message "End of message")))
X ((< lines 0)
X (gnus-Article-prev-page (- 0 lines))))
X ))
X
X(defun gnus-Subject-next-same-subject ()
X "Select next article which has the same subject as current one."
X (interactive)
X (gnus-Subject-next-article nil (gnus-Subject-subject-string)))
X
X(defun gnus-Subject-prev-same-subject ()
X "Select previous article which has the same subject as current one."
X (interactive)
X (gnus-Subject-prev-article nil (gnus-Subject-subject-string)))
X
X(defun gnus-Subject-next-unread-same-subject ()
X "Select next unread article which has the same subject as current one."
X (interactive)
X (gnus-Subject-next-article t (gnus-Subject-subject-string)))
X
X(defun gnus-Subject-prev-unread-same-subject ()
X "Select previous unread article which has the same subject as current one."
X (interactive)
X (gnus-Subject-prev-article t (gnus-Subject-subject-string)))
X
X(defun gnus-Subject-refer-parent-article (child)
X "Refer parent article of current article.
XIf argument CHILD is non-nil, go back to the child article using
Xinternally maintained articles history.
XNOTE: This command may not work with nnspool.el."
X (interactive "P")
X (gnus-Subject-select-article t t) ;Request all headers.
X (let ((referenced-id nil)) ;Message-id of parent or child article.
X (if child
X ;; Go back to child article using history.
X (gnus-Subject-refer-article nil)
X (eval-in-buffer-window gnus-Article-buffer
X ;; Look for parent Message-ID.
X (let ((references (gnus-fetch-field "References")))
X ;; Get message-id referenced last because the references may
X ;; be edited.
X (and references
X (string-match "\\(<[^<>]+>\\)[ \t]*$" references)
X (setq referenced-id
X (substring references
X (match-beginning 1) (match-end 1))))
X ))
X (if (stringp referenced-id)
X (gnus-Subject-refer-article referenced-id)
X (ding) (message "No more parents"))
X )))
X
X(defun gnus-Subject-refer-article (message-id)
X "Refer article specified by MESSAGE-ID.
XIf message-id is nil, message-id is poped from internally maintained
Xarticles history.
XNOTE: This command may not work with nnspool.el."
X (interactive "sMessage-ID: ")
X ;; Make sure that this command depends on the fact that article
X ;; related information is not updated when an article is retrieved
X ;; by message-id.
X (gnus-Subject-select-article t t) ;Request all headers.
X (if (and (stringp message-id)
X (string-match "<.*>" message-id))
X (eval-in-buffer-window gnus-Article-buffer
X ;; Push current message-id on history.
X ;; We cannot use gnus-current-headers to get current
X ;; message-id because we may be looking at parent or refered
X ;; article.
X (let ((current (gnus-fetch-field "Message-ID")))
X (or (equal current message-id) ;Nothing to do.
X (equal current (car gnus-current-history))
X (setq gnus-current-history
X (cons current gnus-current-history)))
X ))
X ;; Pop message-id from history.
X (setq message-id (car gnus-current-history))
X (setq gnus-current-history (cdr gnus-current-history)))
X (if (stringp message-id)
X ;; Retrieve article by message-id. This may not work with nnspool.
X (gnus-Article-prepare message-id t)
X (ding) (message "No such references"))
X )
X
X(defun gnus-Subject-next-digest (nth)
X "Move to head of NTH next digested message."
X (interactive "p")
X (gnus-Subject-select-article)
X (eval-in-buffer-window gnus-Article-buffer
X (gnus-Article-next-digest (or nth 1))
X ))
X
X(defun gnus-Subject-prev-digest (nth)
X "Move to head of NTH previous digested message."
X (interactive "p")
X (gnus-Subject-select-article)
X (eval-in-buffer-window gnus-Article-buffer
X (gnus-Article-prev-digest (or nth 1))
X ))
X
X(defun gnus-Subject-first-unread-article ()
X "Select first unread article. Return non-nil if successfully selected."
X (interactive)
X (let ((begin (point)))
X (goto-char (point-min))
X (if (re-search-forward "^ [ \t]+[0-9]+:" nil t)
X (gnus-Subject-display-article (gnus-Subject-article-number))
X ;; If there is no unread articles, stay there.
X (goto-char begin)
X ;;(gnus-Subject-display-article (gnus-Subject-article-number))
X (message "No more unread articles")
X nil
X )
X ))
X
X(defun gnus-Subject-isearch-article ()
X "Do incremental search forward on current article."
X (interactive)
X (gnus-Subject-select-article)
X (eval-in-buffer-window gnus-Article-buffer
X (call-interactively 'isearch-forward)
X ))
X
X(defun gnus-Subject-search-article-forward (regexp)
X "Search for an article containing REGEXP forward.
Xgnus-Select-article-hook is not called during the search."
X (interactive "sSearch forward (regexp): ")
X (if (string-equal regexp "")
X (setq regexp (or gnus-last-search ""))
X (setq gnus-last-search regexp))
X (if (gnus-Subject-search-article regexp nil)
X (progn
X (message "")
X (eval-in-buffer-window gnus-Article-buffer
X (recenter 0)
X ;;(sit-for 1)
X ))
X (ding) (message "Search failed: \"%s\"" regexp)
X ))
X
X(defun gnus-Subject-search-article-backward (regexp)
X "Search for an article containing REGEXP backward.
Xgnus-Select-article-hook is not called during the search."
X (interactive "sSearch backward (regexp): ")
X (if (string-equal regexp "")
X (setq regexp (or gnus-last-search ""))
X (setq gnus-last-search regexp))
X (if (gnus-Subject-search-article regexp t)
X (progn
X (message "")
X (eval-in-buffer-window gnus-Article-buffer
X (recenter 0)
X ;;(sit-for 1)
X ))
X (ding) (message "Search failed: \"%s\"" regexp)
X ))
X
X(defun gnus-Subject-search-article (regexp &optional backward)
X "Search for an article containing REGEXP.
XOptional argument BACKWARD means do seach for backward.
Xgnus-Select-article-hook is not called during the search."
X (let ((gnus-Select-article-hook nil) ;Disable hook.
X (gnus-Mark-article-hook nil) ;Inhibit marking as read.
X (re-search
X (if backward
X (function re-search-backward) (function re-search-forward)))
X (found nil)
X (last nil))
X ;; First of all, search current article.
X (message "Searching article: %d..." gnus-current-article)
X ;; We don't want to read article again from NNTP server nor reset
X ;; current point.
X (gnus-Subject-select-article)
X (setq last gnus-current-article)
X (eval-in-buffer-window gnus-Article-buffer
X (save-restriction
X (widen)
X ;; Begin search from current point.
X (setq found (funcall re-search regexp nil t))))
X ;; Then search next articles.
X (while (and (not found)
X (gnus-Subject-display-article
X (gnus-Subject-search-subject backward nil nil)))
X (message "Searching article: %d..." gnus-current-article)
X (eval-in-buffer-window gnus-Article-buffer
X (save-restriction
X (widen)
X (goto-char (if backward (point-max) (point-min)))
X (setq found (funcall re-search regexp nil t)))
X ))
X ;; Adjust article pointer.
X (or (eq last gnus-current-article)
X (setq gnus-last-article last))
X ;; Return T if found such article.
X found
X ))
X
X(defun gnus-Subject-execute-command (field regexp command &optional backward)
X "If FIELD of article header matches REGEXP, execute COMMAND string.
XIf FIELD is an empty string (or nil), entire article body is searched for.
XIf optional (prefix) argument BACKWARD is non-nil, do backward instead."
X (interactive
X (list (let ((completion-ignore-case t))
X (completing-read "Field name: "
X '(("Number")("Subject")("From")
X ("Xref")("Lines")("Date")("Id"))
X nil 'require-match))
X (read-string "Regexp: ")
X (read-key-sequence "Command: ")
X current-prefix-arg))
X ;; We don't want to change current point nor window configuration.
X (save-excursion
X (save-window-excursion
X (message "Executing %s..." (key-description command))
X ;; We'd like to execute COMMAND interactively so as to give arguments.
X (gnus-execute field regexp
X (` (lambda ()
X (call-interactively '(, (key-binding command)))))
X backward)
X (message "Executing %s... done" (key-description command)))))
X
X(defun gnus-Subject-beginning-of-article ()
X "Go to beginning of article body"
X (interactive)
X (gnus-Subject-select-article)
X (eval-in-buffer-window gnus-Article-buffer
X (widen)
X (beginning-of-buffer)
X (if gnus-break-pages
X (gnus-narrow-to-page))
X ))
X
X(defun gnus-Subject-end-of-article ()
X "Go to end of article body"
X (interactive)
X (gnus-Subject-select-article)
X (eval-in-buffer-window gnus-Article-buffer
X (widen)
X (end-of-buffer)
X (if gnus-break-pages
X (gnus-narrow-to-page))
X ))
X
X(defun gnus-Subject-goto-article (article &optional all-headers)
X "Read ARTICLE if exists.
XOptional argument ALL-HEADERS means all headers are shown."
X (interactive
X (list
X (string-to-int
X (completing-read "Article number: "
X (mapcar
X (function
X (lambda (headers)
X (list
X (int-to-string (nntp-header-number headers)))))
X gnus-newsgroup-headers)
X nil 'require-match))))
X (if (gnus-Subject-goto-subject article)
X (gnus-Subject-display-article article all-headers)))
X
X(defun gnus-Subject-goto-last-article ()
X "Go to last subject line."
X (interactive)
X (if gnus-last-article
X (gnus-Subject-goto-article gnus-last-article)))
X
X(defun gnus-Subject-show-article ()
X "Force to show current article."
X (interactive)
X (setq gnus-current-article nil) ;Force update.
X (gnus-Subject-select-article gnus-have-all-headers t))
X
X(defun gnus-Subject-toggle-header (arg)
X "Show original header if pruned header currently shown, or vice versa.
XWith arg, show original header iff arg is positive."
X (interactive "P")
X ;; Variable gnus-show-all-headers must be NIL to toggle really.
X (let ((gnus-show-all-headers nil)
X (all-headers
X (if (null arg) (not gnus-have-all-headers)
X (> (prefix-numeric-value arg) 0))))
X (gnus-Subject-select-article all-headers t)))
X
X(defun gnus-Subject-show-all-headers ()
X "Show original article header."
X (interactive)
X (gnus-Subject-select-article t t))
X
X(defun gnus-Subject-stop-page-breaking ()
X "Stop page breaking by linefeed temporary (Widen article buffer)."
X (interactive)
X (gnus-Subject-select-article)
X (eval-in-buffer-window gnus-Article-buffer
X (set-marker overlay-arrow-position nil)
X (widen)
X ))
X
X(defun gnus-Subject-kill-same-subject-and-select (unmark)
X "Mark articles which has the same subject as read, and then select next.
XIf argument UNMARK is positive, remove any kinds of marks.
XIf argument UNMARK is negative, mark articles as unread instead."
X (interactive "P")
X (if unmark
X (setq unmark (prefix-numeric-value unmark)))
X (let ((count
X (gnus-Subject-mark-same-subject
X (gnus-Subject-subject-string) unmark)))
X ;; Select next unread article. If auto-select-same mode, should
X ;; select the first unread article.
X (gnus-Subject-next-article t (and gnus-auto-select-same
X (gnus-Subject-subject-string)))
X (message "%d articles are marked as %s"
X count (if unmark "unread" "read"))
X ))
X
X(defun gnus-Subject-kill-same-subject (unmark)
X "Mark articles which has the same subject as read.
XIf argument UNMARK is positive, remove any kinds of marks.
XIf argument UNMARK is negative, mark articles as unread instead."
X (interactive "P")
X (if unmark
X (setq unmark (prefix-numeric-value unmark)))
X (let ((count
X (gnus-Subject-mark-same-subject
X (gnus-Subject-subject-string) unmark)))
X (gnus-Subject-next-subject 1 (not unmark))
X (message "%d articles are marked as %s"
X count (if unmark "unread" "read"))
X ))
X
X(defun gnus-Subject-mark-same-subject (subject &optional unmark)
X "Mark articles with same SUBJECT as read, and return marked number.
XIf optional argument UNMARK is positive, remove any kinds of marks.
XIf optional argument UNMARK is negative, mark articles as unread instead."
X (save-excursion
X (let ((count 1))
X (cond ((null unmark)
X (gnus-Subject-mark-as-read nil "K"))
X ((> unmark 0)
X (gnus-Subject-mark-as-unread nil t))
X (t
X (gnus-Subject-mark-as-unread)))
X (while (and subject
X (gnus-Subject-search-forward nil subject))
X (cond ((null unmark)
X (gnus-Subject-mark-as-read nil "K"))
X ((> unmark 0)
X (gnus-Subject-mark-as-unread nil t))
X (t
X (gnus-Subject-mark-as-unread)))
X (setq count (1+ count))
X )
X ;; Return number of articles marked as read.
X count
X )))
X
X(defun gnus-Subject-mark-as-unread-forward (count)
X "Mark current article as unread, and then go forward.
XArgument COUNT specifies number of articles marked as unread."
X (interactive "p")
X (while (> count 0)
X (gnus-Subject-mark-as-unread nil nil)
X (gnus-Subject-next-subject 1 nil)
X (setq count (1- count))))
X
X(defun gnus-Subject-mark-as-unread-backward (count)
X "Mark current article as unread, and then go backward.
XArgument COUNT specifies number of articles marked as unread."
X (interactive "p")
X (while (> count 0)
X (gnus-Subject-mark-as-unread nil nil)
X (gnus-Subject-prev-subject 1 nil)
X (setq count (1- count))))
X
X(defun gnus-Subject-mark-as-unread (&optional article clear-mark)
X "Mark current article as unread.
XOptional 1st argument ARTICLE specifies article number to be marked as unread.
XOptional 2nd argument CLEAR-MARK remove any kinds of mark."
X (save-excursion
X (set-buffer gnus-Subject-buffer)
X (let* ((buffer-read-only nil)
X (current (gnus-Subject-article-number))
X (article (or article current)))
X (gnus-mark-article-as-unread article clear-mark)
X (if (or (eq article current)
X (gnus-Subject-goto-subject article))
X (progn
X (beginning-of-line)
X (delete-char 1)
X (insert (if clear-mark " " "-"))))
X )))
X
X(defun gnus-Subject-mark-as-read-forward (count)
X "Mark current article as read, and then go forward.
XArgument COUNT specifies number of articles marked as read"
X (interactive "p")
X (while (> count 0)
X (gnus-Subject-mark-as-read)
X (gnus-Subject-next-subject 1 'marked)
X (setq count (1- count))))
X
X(defun gnus-Subject-mark-as-read-backward (count)
X "Mark current article as read, and then go backward.
XArgument COUNT specifies number of articles marked as read"
X (interactive "p")
X (while (> count 0)
X (gnus-Subject-mark-as-read)
X (gnus-Subject-prev-subject 1 'marked)
X (setq count (1- count))))
X
X(defun gnus-Subject-mark-as-read (&optional article mark)
X "Mark current article as read.
XOptional 1st argument ARTICLE specifies article number to be marked as read.
XOptional 2nd argument MARK specifies a string inserted at beginning of line.
XAny kind of string (length 1) except for a space and `-' is ok."
X (save-excursion
X (set-buffer gnus-Subject-buffer)
X (let* ((buffer-read-only nil)
X (mark (or mark "D")) ;Default mark is `D'.
X (current (gnus-Subject-article-number))
X (article (or article current)))
X (gnus-mark-article-as-read article)
X (if (or (eq article current)
X (gnus-Subject-goto-subject article))
X (progn
X (beginning-of-line)
X (delete-char 1)
X (insert mark)))
X )))
X
X(defun gnus-Subject-clear-mark-forward (count)
X "Remove current article's mark, and go forward.
XArgument COUNT specifies number of articles unmarked"
X (interactive "p")
X (while (> count 0)
X (gnus-Subject-mark-as-unread nil t)
X (gnus-Subject-next-subject 1 nil)
X (setq count (1- count))))
X
X(defun gnus-Subject-clear-mark-backward (count)
X "Remove current article's mark, and go backward.
XArgument COUNT specifies number of articles unmarked"
X (interactive "p")
X (while (> count 0)
X (gnus-Subject-mark-as-unread nil t)
X (gnus-Subject-prev-subject 1 nil)
X (setq count (1- count))))
X
X(defun gnus-Subject-catch-up ()
X "Mark all articles in this newsgroup as read."
X (interactive)
X (if (y-or-n-p "Do you really want to mark everything as read? ")
X (let ((unreads gnus-newsgroup-unreads))
X (while unreads
X (gnus-Subject-mark-as-read (car unreads) "C")
X (setq unreads (cdr unreads))
X ))
X ))
X
X(defun gnus-Subject-catch-up-and-exit ()
X "Mark all articles in this newsgroup as read, and then exit."
X (interactive)
X (if (y-or-n-p "Do you really want to mark everything as read? ")
X (progn
X (setq gnus-newsgroup-unreads nil)
X (setq gnus-newsgroup-marked nil)
X (gnus-Subject-exit))
X ))
X
X(defun gnus-Subject-toggle-truncation (arg)
X "Toggle truncation of subject lines.
XWith arg, turn line truncation on iff arg is positive."
X (interactive "P")
X (setq truncate-lines
X (if (null arg) (not truncate-lines)
X (> (prefix-numeric-value arg) 0)))
X (redraw-display))
X
X(defun gnus-Subject-delete-marked-as-read ()
X "Delete lines which is marked as read."
X (interactive)
X (if gnus-newsgroup-unreads
X (let ((buffer-read-only nil))
X (save-excursion
X (goto-char (point-min))
X (delete-non-matching-lines "^[ ---]"))
X ;; Adjust point.
X (if (eobp)
X (gnus-Subject-prev-subject 1)
X (beginning-of-line)
X (search-forward ":" nil t)))
X ;; It is not so good idea to make the buffer empty.
X (message "All articles are marked as read")
X ))
X
X(defun gnus-Subject-delete-marked (marks)
X "Delete lines which matches MARKS (Example: \"DK\")."
X (interactive "sMarks: ")
X (let ((buffer-read-only nil))
X (save-excursion
X (goto-char (point-min))
X (delete-matching-lines (concat "^[" marks "]")))
X ;; Adjust point.
X (or (zerop (buffer-size))
X (if (eobp)
X (gnus-Subject-prev-subject 1)
X (beginning-of-line)
X (search-forward ":" nil t)))
X ))
X
X(defun gnus-Subject-sort-by-number (reverse)
X "Sort subject display buffer by article number.
XArgument REVERSE means reverse order."
X (interactive "P")
X (gnus-Subject-sort-subjects
X (function
X (lambda (a b)
X (< (nntp-header-number a) (nntp-header-number b))))
X reverse
X ))
X
X(defun gnus-Subject-sort-by-author (reverse)
X "Sort subject display buffer by author name alphabetically.
XArgument REVERSE means reverse order."
X (interactive "P")
X (gnus-Subject-sort-subjects
X (function
X (lambda (a b)
X (string-lessp (nntp-header-from a) (nntp-header-from b))))
X reverse
X ))
X
X(defun gnus-Subject-sort-by-subject (reverse)
X "Sort subject display buffer by subject alphabetically. `Re:'s are ignored.
XArgument REVERSE means reverse order."
X (interactive "P")
X (gnus-Subject-sort-subjects
X (function
X (lambda (a b)
X (string-lessp (gnus-simplify-subject (nntp-header-subject a) 're-only)
X (gnus-simplify-subject (nntp-header-subject b) 're-only))))
X reverse
X ))
X
X(defun gnus-Subject-sort-by-date (reverse)
X "Sort subject display buffer by posted date.
XArgument REVERSE means reverse order."
X (interactive "P")
X (gnus-Subject-sort-subjects
X (function
X (lambda (a b)
X (gnus-date-lessp (nntp-header-date a) (nntp-header-date b))))
X reverse
X ))
X
X(defun gnus-Subject-sort-subjects (predicate &optional reverse)
X "Sort subject display buffer by PREDICATE.
XOptional argument REVERSE means reverse order."
X (let ((current (gnus-Subject-article-number)))
X (gnus-sort-headers predicate reverse)
X (gnus-Subject-prepare)
X (gnus-Subject-goto-subject current)
X ))
X
X(defun gnus-Subject-show-all-subjects ()
X "Show all subjects in this newsgroup.
Xgnus-Apply-kill-hook is not called."
X (interactive)
X (let ((current-subject (gnus-Subject-article-number))
X (current-unreads gnus-newsgroup-unreads)
X (current-marked gnus-newsgroup-marked))
X (message "Retrieving newsgroup: %s..." gnus-newsgroup-name)
X (if (gnus-select-newsgroup gnus-newsgroup-name t)
X (progn
X (setq gnus-newsgroup-unreads current-unreads)
X (setq gnus-newsgroup-marked current-marked)
X (run-hooks 'gnus-Select-group-hook)
X (gnus-Subject-prepare)
X ;;(run-hooks 'gnus-Apply-kill-hook)
SHAR_EOF
echo "End of part 2, continue with part 3"
echo "3" > s2_seq_.tmp
exit 0
--
Masanobu UMEDA
umerin@flab.flab.Fujitsu.JUNET
umerin%flab.flab.Fujitsu.JUNET@uunet.uu.NETumerin@flab.flab.fujitsu.JUNET (Masanobu UMEDA) (11/11/88)
---- Cut Here and unpack ----
#!/bin/sh
# this is part 3 of a multipart archive
# do not concatenate these parts, unpack them in order with /bin/sh
# file gnus.el continued
#
CurArch=3
if test ! -r s2_seq_.tmp
then echo "Please unpack part 1 first!"
exit 1; fi
( read Scheck
if test "$Scheck" != $CurArch
then echo "Please unpack part $Scheck next!"
exit 1;
else exit 0; fi
) < s2_seq_.tmp || exit 1
sed 's/^X//' << 'SHAR_EOF' >> gnus.el
X (gnus-Subject-goto-subject current-subject))
X ;; What's happening now?
X (setq gnus-newsgroup-unreads current-unreads)
X (setq gnus-newsgroup-marked current-marked))
X ))
X
X(defun gnus-Subject-caesar-message (rotnum)
X "Caesar rotates all letters of current message by 13/47 places.
XWith prefix arg, specifies the number of places to rotate each letter forward.
XCaesar rotates Japanese letters by 47 places in any case."
X (interactive "P")
X (gnus-Subject-select-article)
X (eval-in-buffer-window gnus-Article-buffer
X (require 'rnews)
X (gnus-rebind-functions)
X (save-restriction
X (widen)
X ;; We don't want to jump to the beginning of the message.
X ;; `save-excursion' does not do its job.
X (move-to-window-line 0)
X (let ((last (point)))
X (news-caesar-buffer-body rotnum)
X (goto-char last)
X (recenter 0)
X ))
X ))
X
X(defun gnus-Subject-rmail-digest ()
X "Run RMAIL on current digest article.
Xgnus-Select-digest-hook will be called with no arguments, if that
Xvalue is non-nil. It is possible to modify the article so that Rmail
Xcan work with it.
Xgnus-Rmail-digest-hook will be called with no arguments, if that value
Xis non-nil. The hook is intended to customize Rmail mode."
X (interactive)
X (gnus-Subject-select-article)
X (require 'rmail)
X (let ((artbuf gnus-Article-buffer)
X (tmpbuf (get-buffer-create gnus-Digest-buffer))
X (mail-header-separator ""))
X (set-buffer tmpbuf)
X (buffer-flush-undo (current-buffer))
X (setq buffer-read-only nil)
X (erase-buffer)
X (insert-buffer-substring artbuf)
X (run-hooks 'gnus-Select-digest-hook)
X (gnus-convert-article-to-rmail)
X (goto-char (point-min))
X ;; Rmail initializations.
X (rmail-insert-rmail-file-header)
X (rmail-mode)
X (rmail-set-message-counters)
X (rmail-show-message)
X (condition-case ()
X (progn
X (undigestify-rmail-message)
X (rmail-expunge) ;Delete original message.
X ;; File name is meaningless but `save-buffer' requires it.
X (setq buffer-file-name "GNUS Digest")
X (setq mode-line-buffer-identification
X (concat "Digest: "
X (nntp-header-subject gnus-current-headers)))
X ;; There is no need to write this buffer to a file.
X (make-local-variable 'write-file-hooks)
X (setq write-file-hooks
X (list (function
X (lambda ()
X (set-buffer-modified-p nil)
X (message "(No changes need to be saved)")
X 'no-need-to-write-this-buffer))))
X ;; Default file name saving digest messages.
X (setq rmail-last-rmail-file
X (funcall gnus-article-save-name
X gnus-newsgroup-name
X gnus-current-headers))
X (setq rmail-last-file rmail-last-rmail-file)
X ;; Prevent generating new buffer named ***<N> each time.
X (setq rmail-summary-buffer
X (get-buffer-create gnus-Digest-summary-buffer))
X (run-hooks 'gnus-Rmail-digest-hook)
X (if gnus-digest-show-summary
X (progn
X (pop-to-buffer (current-buffer))
X (rmail-summary)
X (message (substitute-command-keys
X "Type \\[rmail-summary-quit] to return to GNUS"))
X )
X (switch-to-buffer (current-buffer))
X (delete-other-windows)
X (message (substitute-command-keys
X "Type \\[rmail-quit] to return to GNUS"))
X ))
X (error (set-buffer-modified-p nil)
X (kill-buffer (current-buffer))
X (ding) (message "Article is not a digest")))
X ))
X
X(defun gnus-Subject-post-news ()
X "Post an article."
X (interactive)
X (gnus-Subject-select-article)
X (switch-to-buffer gnus-Article-buffer)
X (set-marker overlay-arrow-position nil)
X (widen)
X (delete-other-windows)
X (bury-buffer gnus-Article-buffer)
X (gnus-post-news))
X
X(defun gnus-Subject-post-reply ()
X "Post a reply article."
X (interactive)
X (gnus-Subject-select-article)
X (switch-to-buffer gnus-Article-buffer)
X (set-marker overlay-arrow-position nil)
X (widen)
X (delete-other-windows)
X (bury-buffer gnus-Article-buffer)
X (gnus-news-reply))
X
X(defun gnus-Subject-cancel ()
X "Cancel an article you posted."
X (interactive)
X (gnus-Subject-select-article)
X (eval-in-buffer-window gnus-Article-buffer
X (if (yes-or-no-p "Do you really want to cancel this article? ")
X (gnus-inews-cancel))
X ))
X
X(defun gnus-Subject-mail-reply ()
X "Reply mail to news author."
X (interactive)
X (gnus-Subject-select-article)
X (switch-to-buffer gnus-Article-buffer)
X (set-marker overlay-arrow-position nil)
X (widen)
X (delete-other-windows)
X (bury-buffer gnus-Article-buffer)
X (news-mail-reply)
X (gnus-rebind-functions))
X
X(defun gnus-Subject-mail-other-window ()
X "Reply mail to news author in other window."
X (interactive)
X (gnus-Subject-select-article)
X (switch-to-buffer gnus-Article-buffer)
X (set-marker overlay-arrow-position nil)
X (widen)
X (delete-other-windows)
X (bury-buffer gnus-Article-buffer)
X (news-mail-other-window)
X (gnus-rebind-functions))
X
X(defun gnus-Subject-save-article ()
X "Save this article using default saver function.
XVariable `gnus-article-default-saver' specifies the saver function."
X (interactive)
X (gnus-Subject-select-article
X (not (null gnus-save-all-headers)) gnus-save-all-headers)
X (if (and gnus-article-default-saver
X (fboundp gnus-article-default-saver))
X (call-interactively gnus-article-default-saver)
X (error "No default saver function is defined.")))
X
X(defun gnus-Subject-save-in-rmail ()
X "Append this article to Rmail file.
XDirectory to save to is default to `gnus-article-save-directory' which
Xis initialized from the SAVEDIR environment variable."
X (interactive)
X (gnus-Subject-select-article
X (not (null gnus-save-all-headers)) gnus-save-all-headers)
X (eval-in-buffer-window gnus-Article-buffer
X (save-excursion
X (save-restriction
X (widen)
X (let* ((overlay-arrow-position nil)
X (default-name
X (funcall gnus-article-save-name
X gnus-newsgroup-name
X gnus-current-headers))
X (file (read-file-name
X (concat "Save article in Rmail file: (default "
X (file-name-nondirectory default-name)
X ") ")
X (file-name-directory default-name)
X default-name)))
X (gnus-make-directory (file-name-directory file))
X (gnus-output-to-rmail file)
X ;; Remember the directory name to save articles.
X (setq gnus-newsgroup-last-file file)
X )))
X ))
X
X(defun gnus-Subject-save-in-mail ()
X "Append this article to Unix mail file.
XDirectory to save to is default to `gnus-article-save-directory' which
Xis initialized from the SAVEDIR environment variable."
X (interactive)
X (gnus-Subject-select-article
X (not (null gnus-save-all-headers)) gnus-save-all-headers)
X (eval-in-buffer-window gnus-Article-buffer
X (save-excursion
X (save-restriction
X (widen)
X (let* ((overlay-arrow-position nil)
X (default-name
X (funcall gnus-article-save-name
X gnus-newsgroup-name
X gnus-current-headers))
X (file (read-file-name
X (concat "Save article in Unix mail file: (default "
X (file-name-nondirectory default-name)
X ") ")
X (file-name-directory default-name)
X default-name)))
X (gnus-make-directory (file-name-directory file))
X (rmail-output file)
X ;; Remember the directory name to save articles.
X (setq gnus-newsgroup-last-file file)
X )))
X ))
X
X(defun gnus-Subject-save-in-file ()
X "Append this article to file.
XDirectory to save to is default to `gnus-article-save-directory' which
Xis initialized from the SAVEDIR environment variable."
X (interactive)
X (gnus-Subject-select-article
X (not (null gnus-save-all-headers)) gnus-save-all-headers)
X (eval-in-buffer-window gnus-Article-buffer
X (save-excursion
X (save-restriction
X (widen)
X (let* ((overlay-arrow-position nil)
X (default-name
X (funcall gnus-article-save-name
X gnus-newsgroup-name
X gnus-current-headers))
X (file (read-file-name
X (concat "Save article in file: (default "
X (file-name-nondirectory default-name)
X ") ")
X (file-name-directory default-name)
X default-name)))
X (gnus-make-directory (file-name-directory file))
X (gnus-output-to-file file)
X ;; Remember the directory name to save articles.
X (setq gnus-newsgroup-last-file file)
X )))
X ))
X
X(defun gnus-Subject-save-in-folder ()
X "Save this article to MH folder (using `rcvstore' in MH library).
XFolder to save in is default to `gnus-article-mh-folder'."
X (interactive)
X (gnus-Subject-select-article
X (not (null gnus-save-all-headers)) gnus-save-all-headers)
X (eval-in-buffer-window gnus-Article-buffer
X (save-restriction
X (widen)
X (let ((overlay-arrow-position nil))
X ;; Thanks to yuki@flab.Fujitsu.JUNET and ohm@kaba.junet.
X (mh-find-path)
X (shell-command-on-region
X (point-min) (point-max)
X (concat (expand-file-name "rcvstore" mh-lib) " "
X (mh-prompt-for-folder "Save article in"
X gnus-article-mh-folder t))
X nil)
X ))
X ))
X
X(defun gnus-Subject-pipe-output ()
X "Pipe this article to subprocess."
X (interactive)
X ;; Ignore `gnus-save-all-headers' since this is not save command.
X (gnus-Subject-select-article)
X (eval-in-buffer-window gnus-Article-buffer
X (save-restriction
X (widen)
X (let ((overlay-arrow-position nil))
X (shell-command-on-region
X (point-min) (point-max)
X (read-string "Shell command on article: ") nil)
X ))
X ))
X
X(defun gnus-Subject-exit (&optional temporary)
X "Exit reading current newsgroup, and then return to group selection mode.
Xgnus-Exit-group-hook is called with no arguments if that value is non-nil."
X (interactive)
X (run-hooks 'gnus-Exit-group-hook)
X (let ((updated nil))
X (gnus-update-unread-articles gnus-newsgroup-name
X gnus-newsgroup-unreads
X gnus-newsgroup-marked)
X (setq updated
X (gnus-mark-as-read-by-xref gnus-newsgroup-name
X gnus-newsgroup-headers
X gnus-newsgroup-unreads))
X (if temporary
X ;; Do not switch windows but change the buffer to work.
X (set-buffer gnus-Group-buffer)
X ;; Return to Group selection mode.
X (if (get-buffer gnus-Subject-buffer)
X (bury-buffer gnus-Subject-buffer))
X (if (get-buffer gnus-Article-buffer)
X (bury-buffer gnus-Article-buffer))
X (switch-to-buffer gnus-Group-buffer)
X (delete-other-windows))
X ;; Update cross referenced group info.
X (while updated
X (gnus-Group-update-group (car updated) t) ;Ignore invisible group.
X (setq updated (cdr updated)))
X (gnus-Group-update-group gnus-newsgroup-name)
X (gnus-Group-next-unread-group 1)
X ))
X
X(defun gnus-Subject-quit ()
X "Quit reading current newsgroup without updating read article info."
X (interactive)
X (if (y-or-n-p "Do you really wanna quit reading this group? ")
X (progn
X ;; Return to Group selection mode.
X (if (get-buffer gnus-Subject-buffer)
X (bury-buffer gnus-Subject-buffer))
X (if (get-buffer gnus-Article-buffer)
X (bury-buffer gnus-Article-buffer))
X (switch-to-buffer gnus-Group-buffer)
X (delete-other-windows)
X (gnus-Group-next-unread-group 1)
X )))
X
X
X;;;
X;;; GNUS Article mode
X;;;
X
X(if gnus-Article-mode-map
X nil
X (setq gnus-Article-mode-map (make-keymap))
X (suppress-keymap gnus-Article-mode-map)
X (define-key gnus-Article-mode-map " " 'gnus-Article-next-page)
X (define-key gnus-Article-mode-map "\177" 'gnus-Article-prev-page)
X (define-key gnus-Article-mode-map "r" 'gnus-Article-refer-article)
X (define-key gnus-Article-mode-map "o" 'gnus-Article-pop-article)
X (define-key gnus-Article-mode-map "h" 'gnus-Article-show-subjects)
X (define-key gnus-Article-mode-map "s" 'gnus-Article-show-subjects)
X (define-key gnus-Article-mode-map "?" 'describe-mode)
X ;; gnus-Exit-group-hook should be evaluated in Subject mode buffer.
X ;;(define-key gnus-Article-mode-map "q" 'gnus-Subject-exit)
X ;;(define-key gnus-Article-mode-map "Q" 'gnus-Subject-quit)
X )
X
X(defun gnus-Article-mode ()
X "Major mode for reading news articles.
XAll normal editing commands are turned off.
XInstead, these commands are available:
X\\{gnus-Article-mode-map}
X
XVarious hooks for customization:
X gnus-Article-mode-hook
X Entry to this mode calls the value with no arguments, if that
X value is non-nil.
X
X gnus-Article-prepare-hook
X Called with no arguments after an article is prepared for reading,
X if that value is non-nil."
X (interactive)
X (kill-all-local-variables)
X (if (boundp 'mode-line-modified)
X (setq mode-line-modified "--- ")
X (setq mode-line-format
X (cons "--- " (cdr (default-value 'mode-line-format)))))
X (make-local-variable 'global-mode-string)
X (setq global-mode-string nil)
X (setq major-mode 'gnus-Article-mode)
X (setq mode-name "GNUS Article")
X (gnus-Article-set-mode-line)
X (use-local-map gnus-Article-mode-map)
X (make-local-variable 'page-delimiter)
X (setq page-delimiter gnus-page-delimiter)
X (make-local-variable 'mail-header-separator)
X (setq mail-header-separator "") ;For caesar function.
X ;; Overlay arrow does not work if it's buffer local.
X (setq overlay-arrow-string gnus-more-message)
X (setq overlay-arrow-position (make-marker))
X (buffer-flush-undo (current-buffer))
X (setq buffer-read-only t) ;Disable modification
X (run-hooks 'gnus-Article-mode-hook))
X
X(defun gnus-Article-setup-buffer ()
X "Initialize Article mode buffer."
X (or (get-buffer gnus-Article-buffer)
X (save-excursion
X (set-buffer (get-buffer-create gnus-Article-buffer))
X (gnus-Article-mode))
X ))
X
X(defun gnus-Article-prepare (article &optional all-headers)
X "Prepare ARTICLE in Article mode buffer.
XIf optional argument ALL-HEADERS is non-nil, all headers are inserted."
X (save-excursion
X (set-buffer gnus-Article-buffer)
X (let ((buffer-read-only nil))
X ;; Marker may slow down editing command of Emacs.
X (set-marker overlay-arrow-position nil)
X (erase-buffer)
X (if (nntp-request-article article)
X (progn
X ;; Prepare article buffer
X (insert-buffer-substring nntp-server-buffer)
X (setq gnus-have-all-headers (or all-headers gnus-show-all-headers))
X (if (and (numberp article)
X (not (eq article gnus-current-article)))
X (progn
X ;; gnus-current-article must be an article number.
X (setq gnus-last-article gnus-current-article)
X (setq gnus-current-article article)
X (setq gnus-current-headers
X (gnus-find-header-by-number gnus-newsgroup-headers
X gnus-current-article))
X ;; Clear articles history only when articles are
X ;; retrieved by article numbers.
X (setq gnus-current-history nil)
X (run-hooks 'gnus-Mark-article-hook)
X ))
X ;; Hooks for modifying contents of the article. This hook
X ;; must be called before being narrowed.
X (run-hooks 'gnus-Article-prepare-hook)
X ;; Delete unnecessary headers.
X (or gnus-have-all-headers
X (gnus-Article-delete-headers))
X ;; Do page break.
X (goto-char (point-min))
X (if gnus-break-pages
X (gnus-narrow-to-page))
X ;; Next function must be called after setting
X ;; `gnus-current-article' variable and narrowed to page.
X (gnus-Article-set-mode-line)
X )
X (if (numberp article)
X (gnus-Subject-mark-as-read article))
X (ding) (message "No such article (may be canceled)"))
X )))
X
X(defun gnus-Article-show-all-headers ()
X "Show all article headers in Article mode buffer."
X (gnus-Article-setup-buffer)
X (gnus-Article-prepare gnus-current-article t))
X
X(defun gnus-Article-set-mode-line ()
X "Set Article mode line string."
X (setq mode-line-buffer-identification
X (list 17
X (format "GNUS: %s {%d-%d} %d"
X gnus-newsgroup-name
X gnus-newsgroup-begin
X gnus-newsgroup-end
X gnus-current-article)))
X (set-buffer-modified-p t))
X
X;;(defun gnus-Article-set-mode-line ()
X;; "Set Article mode line string."
X;; (let ((string (format "%s {%d-%d} %d"
X;; gnus-newsgroup-name
X;; gnus-newsgroup-begin
X;; gnus-newsgroup-end
X;; gnus-current-article)))
X;; (setq mode-line-buffer-identification
X;; (concat "GNUS: "
X;; string
X;; ;; Enough spaces to pad group name to 17 positions.
X;; (substring " "
X;; 0 (max 0 (- 17 (length string))))))
X;; (set-buffer-modified-p t)
X;; ))
X
X(defun gnus-Article-delete-headers ()
X "Delete unnecessary headers."
X (save-excursion
X (save-restriction
X (goto-char (point-min))
X (narrow-to-region (point-min)
X (condition-case ()
X (progn (search-forward "\n\n") (point))
X (error (point-max))))
X (goto-char (point-min))
X (and (stringp gnus-ignored-headers)
X (while (re-search-forward gnus-ignored-headers nil t)
X (beginning-of-line)
X (delete-region (point)
X (progn (re-search-forward "\n[^ \t]")
X (forward-char -1)
X (point)))))
X )))
X
X;; Working on article's buffer
X
X(defun gnus-Article-next-page (lines)
X "Show next page of current article.
XIf end of article, return non-nil. Otherwise return nil.
XArgument LINES specifies lines to be scrolled up."
X (interactive "P")
X (move-to-window-line -1)
X (if (eobp)
X (if (or (not gnus-break-pages)
X (save-restriction (widen) (eobp))) ;Real end-of-buffer?
X t
X (gnus-narrow-to-page 1) ;Go to next page.
X nil
X )
X (scroll-up lines)
X nil
X ))
X
X(defun gnus-Article-prev-page (lines)
X "Show previous page of current article.
XArgument LINES specifies lines to be scrolled down."
X (interactive "P")
X (move-to-window-line 0)
X (if (and gnus-break-pages
X (bobp)
X (not (save-restriction (widen) (bobp)))) ;Real beginning-of-buffer?
X (progn
X (gnus-narrow-to-page -1) ;Go to previous page.
X (goto-char (point-max))
X (recenter -1))
X (scroll-down lines)))
X
X(defun gnus-Article-next-digest (nth)
X "Move to head of NTH next digested message.
XSet mark at end of digested message."
X ;; Stop page breaking in digest mode.
X (set-marker overlay-arrow-position nil)
X (widen)
X (end-of-line)
X ;; Skip NTH - 1 digest.
X ;; This feature is suggested by Khalid Sattar <admin@cs.exeter.ac.uk>.
X (while (and (> nth 1)
X (re-search-forward "^Subject:[ \t]" nil 'move))
X (setq nth (1- nth)))
X (if (re-search-forward "^Subject:[ \t]" nil t)
X (let ((begin (point)))
X ;; Search for end of this message.
X (end-of-line)
X (if (re-search-forward "^Subject:[ \t]" nil t)
X (progn
X (search-backward "\n\n")
X (forward-line 1))
X (goto-char (point-max)))
X (push-mark) ;Set mark at end of digested message.
X (goto-char begin)
X (beginning-of-line)
X ;; Show From: and Subject: fields.
X (recenter 1))
X (message "End of message")
X ))
X
X(defun gnus-Article-prev-digest (nth)
X "Move to head of NTH previous digested message."
X ;; Stop page breaking in digest mode.
X (set-marker overlay-arrow-position nil)
X (widen)
X (beginning-of-line)
X ;; Skip NTH - 1 digest.
X ;; This feature is suggested by Khalid Sattar <admin@cs.exeter.ac.uk>.
X (while (and (> nth 1)
X (re-search-backward "^Subject:[ \t]" nil 'move))
X (setq nth (1- nth)))
X (if (re-search-backward "^Subject:[ \t]" nil t)
X (let ((begin (point)))
X ;; Search for end of this message.
X (end-of-line)
X (if (re-search-forward "^Subject:[ \t]" nil t)
X (progn
X (search-backward "\n\n")
X (forward-line 1))
X (goto-char (point-max)))
X (push-mark) ;Set mark at end of digested message.
X (goto-char begin)
X ;; Show From: and Subject: fields.
X (recenter 1))
X (goto-char (point-min))
X (message "Top of message")
X ))
X
X(defun gnus-Article-refer-article ()
X "Read article specified by message-id around point."
X (interactive)
X (save-excursion
X (re-search-forward ">" nil t) ;Move point to end of "<....>".
X (if (re-search-backward "\\(<[^<> \t\n]+>\\)" nil t)
X (let ((message-id
X (buffer-substring (match-beginning 1) (match-end 1))))
X (set-buffer gnus-Subject-buffer)
X (gnus-Subject-refer-article message-id))
X (message "No references around point"))
X ))
X
X(defun gnus-Article-pop-article ()
X "Pop up article history."
X (interactive)
X (set-buffer gnus-Subject-buffer)
X (gnus-Subject-refer-article nil))
X
X(defun gnus-Article-show-subjects ()
X "Reconfigure windows in order to show subjects."
X (interactive)
X (delete-other-windows) ;Force re-configure windows.
X (gnus-Subject-configure-window)
X (gnus-Subject-goto-subject gnus-current-article))
X
X
X;;;
X;;; GNUS Kill file mode
X;;;
X
X(if gnus-Kill-file-mode-map
X nil
X (setq gnus-Kill-file-mode-map (copy-keymap emacs-lisp-mode-map))
X (define-key gnus-Kill-file-mode-map "\C-c\C-s" 'save-buffer)
X (define-key gnus-Kill-file-mode-map "\C-c\C-c" 'gnus-Kill-file-exit))
X
X(defun gnus-Kill-file-mode ()
X "Major mode for editing KILL file.
X
X\\[save-buffer] Save current KILL file.
X\\[gnus-Kill-file-exit] Exit editing KILL file.
X
XKILL file is a file which contains lisp expressions to be applied to
Xselected newsgroup. The purpose of a KILL file is to mark articles as
Xread on the basis of some set of regexps. Global KILL file is applied
Xto every newsgroup while local KILL file is applied to specified
Xnewsgroup. Since global KILL file is applied to every newsgroup, you'd
Xbetter not use global KILL file but local one for better performance.
X
XKILL file can contain any kind of Emacs lisp expressions which is
Xexpected to be evaluated in GNUS Subject mode buffer. Writing lisp
Xprograms for this purpose, however, is not so easy because internals
Xof GNUS must be well-known. For this reason, GNUS provides a general
Xfunction doing this easily for non-Lisp programmers.
X
XFunction `gnus-kill' is a function to execute commands available in
XGNUS Subject mode by their key sequences. `gnus-kill' should be called
Xwith FIELD, REGEXP and optional COMMAND. FIELD must be a string
Xrepresenting header field or an empty string. If FIELD is an empty
Xstring, entire article body is searched for. REGEXP is a string which
Xis compared with FIELD value. COMMAND is a string representing valid
Xkey sequence in GNUS Subject mode, or Lisp expression. COMMAND is
Xdefault to '(gnus-Subject-mark-as-read nil \"X\"). Make sure that
XCOMMAND is executed in GNUS Subject mode buffer.
X
XFor example, if you'd like to mark articles of which subject contains
Xa string `AI' as read, KILL file looks like:
X
X (gnus-kill \"Subject\" \"AI\" \"d\")
X
XIn this example it is assumed that `gnus-Subject-mark-as-read-forward'
Xis assigned to `d' in GNUS Subject mode.
X
XIf you want to put a special marks like a `@' instead of `D' or `K',
Xyou can use the following expression:
X
X (gnus-kill \"Subject\" \"AI\" '(gnus-Subject-mark-as-read nil \"@\"))
X
XIt is possible to delete unnecessary lines which is marked with `@' in
XKILL file as follows:
X
X (gnus-Subject-delete-marked \"@\")
X
XIf the buffer is empty, GNUS will exit selected newsgroup normally.
XIf you delete lines which is marked `D', it is impossible to read
Xarticles which is marked as read in previous GNUS sessions. You'd
Xbetter set different marks other than `D' to articles which should be
Xdeleted.
X
XEntry to this mode calls emacs-lisp-mode-hook and
Xgnus-Kill-file-mode-hook with no arguments, if that value is non-nil."
X (interactive)
X (kill-all-local-variables)
X (use-local-map gnus-Kill-file-mode-map)
X (set-syntax-table emacs-lisp-mode-syntax-table)
X (setq major-mode 'gnus-Kill-file-mode)
X (setq mode-name "Edit KILL File")
X (lisp-mode-variables nil)
X (run-hooks 'emacs-lisp-mode-hook 'gnus-Kill-file-mode-hook))
X
X(defun gnus-Kill-file-edit-global ()
X "Edit global KILL file.
XGlobal KILL file is applied to every newsgroup. Since KILL file makes
XGNUS slower, you'd better not use global KILL file but local one."
X (interactive)
X (gnus-Kill-file-edit (gnus-Kill-file-pathname t))
X (message
X (substitute-command-keys
X "Editing global KILL file (Type \\[gnus-Kill-file-exit] to exit)")))
X
X(defun gnus-Kill-file-edit-local ()
X "Edit local KILL file.
XLocal KILL file is applied to current newsgroup only."
X (interactive)
X (gnus-Kill-file-edit (gnus-Kill-file-pathname nil))
X (message
X (substitute-command-keys
X "Editing local KILL file (Type \\[gnus-Kill-file-exit] to exit)")))
X
X(defun gnus-Kill-file-edit (file)
X "Edit kill FILE."
X (interactive "f")
X (gnus-make-directory (file-name-directory file))
X (find-file-other-window file)
X (gnus-Kill-file-mode))
X
X(defun gnus-Kill-file-exit ()
X "Save KILL file, then return to previous buffer."
X (interactive)
X (save-buffer)
X (bury-buffer))
X
X(defun gnus-Kill-file-pathname (global)
X (cond (global
X ;; Put global kill file at top of the directory.
X (expand-file-name gnus-kill-file-name
X (or gnus-article-save-directory "~/News")))
X (gnus-use-long-file-name
X ;; Append ".KILL" to newsgroup name.
X (expand-file-name (concat gnus-newsgroup-name
X "." gnus-kill-file-name)
X (gnus-save-directory)))
X (t
X ;; Put "KILL" under the hierarchical directory.
X (expand-file-name gnus-kill-file-name (gnus-save-directory)))
X ))
X
X(defun gnus-Kill-file-apply ()
X "Apply KILL file to current newsgroup."
X ;; Apply global kill file.
X (let ((global (gnus-Kill-file-pathname t)))
X (if (file-exists-p global)
X (load global t t t)))
X ;; And then apply local kill file.
X (let ((local (gnus-Kill-file-pathname nil)))
X (if (file-exists-p local)
X (load local t t t))))
X
X;;(defun gnus-Kill-file-execute (file)
X;; "Apply kill FILE.
X;;Expression in the kill file is evaluated in current buffer."
X;; (let ((buffer (find-file-noselect file)))
X;; (save-excursion
X;; (set-buffer buffer)
X;; (goto-char (point-min)))
X;; (while (save-excursion
X;; (set-buffer buffer)
X;; (while (progn (skip-chars-forward " \t\n\^l")
X;; (looking-at ";"))
X;; (forward-line 1))
X;; (not (eobp)))
X;; ;; Make Subject mode buffer modifiable.
X;; (let ((buffer-read-only nil))
X;; (eval (read buffer)))
X;; )))
X
X
X;;;
X;;; Utility functions
X;;;
X
X(defun gnus-article-save-name (newsgroup headers)
X "Generate file name from NEWSGROUP and HEADERS.
XIf variable `gnus-use-long-file-name' is nil, it is ~/News/NEWSGROUP.
XOtherwise, it is like ~/News/NEWS/GROUP/NUMBER."
X (let ((default
X (expand-file-name (if gnus-use-long-file-name
X newsgroup
X (int-to-string (nntp-header-number headers)))
X (gnus-save-directory)))
X (last-file gnus-newsgroup-last-file))
X (if (and (not gnus-use-long-file-name)
X last-file
X (string-match "^[0-9]+$" (file-name-nondirectory last-file)))
X ;; We assume the standard name GNUS inserted was used last.
X default
X (or last-file default))
X ))
X
X(defun gnus-save-directory ()
X "Return directory name saving article in current newsgroup."
X (let ((group (if gnus-use-long-file-name "" gnus-newsgroup-name)))
X (file-name-as-directory
X (concat (file-name-as-directory (or gnus-article-save-directory "~/News"))
X (gnus-group-directory-form group)))
X ))
X
X(defun gnus-group-directory-form (group)
X "Make hierarchical directory name from newsgroup GROUP name."
X (let ((group (substring group 0)) ;Copy string.
X (len (length group))
X (idx 0))
X ;; Replace all occurence of `.' with `/'.
X (while (< idx len)
X (if (= (aref group idx) ?.)
X (aset group idx ?/))
X (setq idx (1+ idx)))
X group
X ))
X
X(defun gnus-make-directory (directory)
X "Make DIRECTORY recursively."
X (let ((directory (expand-file-name directory default-directory)))
X (or (file-exists-p directory)
X (gnus-make-directory-1 "" directory))
X ))
X
X(defun gnus-make-directory-1 (head tail)
X (cond ((string-match "^/\\([^/]+\\)" tail)
X (setq head
X (concat (file-name-as-directory head)
X (substring tail (match-beginning 1) (match-end 1))))
X (or (file-exists-p head)
X (call-process "mkdir" nil nil nil head))
X (gnus-make-directory-1 head (substring tail (match-end 1))))
X ((string-equal tail "") t)
X ))
X
X(defun gnus-simplify-subject (subject &optional re-only)
X "Remove `Re:' and words in parentheses.
XIf optional argument RE-ONLY is non-nil, strip `Re:' only."
X (let ((case-fold-search t)) ;Ignore case.
X ;; Remove `Re:'
X (if (string-match "^\\(re:[ \t]+\\)*" subject)
X (setq subject (substring subject (match-end 0))))
X ;; Remove words in parentheses from end.
X (or re-only
X (while (string-match "[ \t]*([^()]*)[ \t]*$" subject)
X (setq subject (substring subject 0 (match-beginning 0)))))
X ;; Return subject string.
X subject
X ))
X
X(defun gnus-optional-lines-and-from (header)
X "Return a string like `NNN:AUTHOR' from HEADER."
X (let ((name-length (length "umerin@photon")))
X (substring (format "%3d:%s"
X ;; Lines of the article.
X ;; Suggested by dana@bellcore.com.
X (nntp-header-lines header)
X ;; Its author.
X (concat (mail-strip-quoted-names
X (nntp-header-from header))
X (make-string name-length ? )))
X ;; 4 stands for length of `NNN:'.
X 0 (+ 4 name-length))))
X
X(defun gnus-optional-lines (header)
X "Return a string like `NNN' from HEADER."
X (format "%4d" (nntp-header-lines header)))
X
X(defun gnus-sort-headers (predicate &optional reverse)
X "Sort current group headers by PREDICATE safely.
X*Safely* means C-g quitting will be disabled during sorting.
XOptional argument REVERSE means reverse order."
X (let ((inhibit-quit t))
X (setq gnus-newsgroup-headers
X (if reverse
X (nreverse (sort (nreverse gnus-newsgroup-headers) predicate))
X (sort gnus-newsgroup-headers predicate)))
X ))
X
X(defun gnus-date-lessp (date1 date2)
X "Return T if DATE1 is earlyer than DATE2."
X (string-lessp (gnus-comparable-date date1)
X (gnus-comparable-date date2)))
X
X(defun gnus-comparable-date (date)
X "Make comparable string by string-lessp from DATE."
X (let* ((month '(("Jan" . " 1")("Feb" . " 2")("Mar" . " 3")
X ("Apr" . " 4")("May" . " 5")("Jun" . " 6")
X ("Jul" . " 7")("Aug" . " 8")("Sep" . " 9")
X ("Oct" . "10")("Nov" . "11")("Dec" . "12")))
X (date (or date "")))
X (if (string-match "^\\([^ ]+\\) \\([^ ]+\\) \\([^ ]+\\) \\([^ ]+\\) " date)
X (concat
X ;; Year
X (substring date (match-beginning 3) (match-end 3))
X ;; Month
X (cdr (assoc (substring date (match-beginning 2) (match-end 2)) month))
X ;; Day
X (format "%2d" (string-to-int
X (substring date
X (match-beginning 1) (match-end 1))))
X ;; Time
X (substring date (match-beginning 4) (match-end 4)))
X ;; Cannot understand DATE string.
X date
X )
X ))
X
X(defun gnus-fetch-field (field)
X "Return the value of the header FIELD of current article."
X (save-excursion
X (save-restriction
X (widen)
X (goto-char (point-min))
X (narrow-to-region (point-min)
X (progn (search-forward "\n\n" nil 'move) (point)))
X (mail-fetch-field field))))
X
X(defun gnus-kill (field regexp &optional command)
X "If FIELD of an article matches REGEXP, execute COMMAND.
XOptional argument COMMAND is default to (gnus-Subject-mark-as-read nil \"X\").
XIf FIELD is an empty string (or nil), entire article body is searched for.
XCOMMAND must be a lisp expression or a string representing a key sequence."
X ;; We don't want to change current point nor window configuration.
X (save-excursion
X (save-window-excursion
X ;; Selected window must be Subject mode buffer to execute
X ;; keyboard macros correctly. See command_loop_1.
X (switch-to-buffer gnus-Subject-buffer)
X (goto-char (point-min)) ;From the beginning.
X (if (null command)
X (setq command '(gnus-Subject-mark-as-read nil "X")))
X (gnus-execute field regexp command))))
X
X(defun gnus-execute (field regexp form &optional backward)
X "If FIELD of article header matches REGEXP, execute lisp FORM (or a string).
XIf FIELD is an empty string (or nil), entire article body is searched for.
XIf optional argument BACKWARD is non-nil, do backward instead."
X (let ((function nil)
X (header nil))
X (if (string-equal field "")
X (setq field nil))
X (if (null field)
X nil
X (or (stringp field)
X (setq field (symbol-name field)))
X ;; Get access function of header filed.
X (setq function (intern-soft (concat "gnus-header-" (downcase field))))
X (if (and function (fboundp function))
X (setq function (symbol-function function))
X (error "Unknown header field: \"%s\"" field)))
X ;; Make FORM funcallable.
X (if (and (listp form) (not (eq (car form) 'lambda)))
X (setq form (list 'lambda nil form)))
X ;; Starting from current article.
X (gnus-execute-1 function regexp form)
X (while (gnus-Subject-search-subject backward nil nil)
X (gnus-execute-1 function regexp form))
X ))
X
X(defun gnus-execute-1 (function regexp form)
X (save-excursion
X ;; Point of Subject mode buffer must be saved during execution.
X (let ((article (gnus-Subject-article-number)))
X (if (null article)
X nil ;Nothing to do.
X (if function
X ;; Compare with header field.
X (let ((header (gnus-find-header-by-number
X gnus-newsgroup-headers article))
X (value nil))
X (and header
X (progn
X (setq value (funcall function header))
X ;; Number (Lines:) or symbol must be converted to string.
X (or (stringp value)
X (setq value (prin1-to-string value)))
X (string-match regexp value))
X (if (stringp form) ;Keyboard macro.
X (execute-kbd-macro form)
X (funcall form))))
X ;; Search article body.
X (let ((gnus-current-article nil) ;Save article pointer.
X (gnus-last-article nil)
X (gnus-break-pages nil) ;No need to break pages.
X (gnus-Mark-article-hook nil)) ;Inhibit marking as read.
X (message "Searching for article: %d..." article)
X (gnus-Article-setup-buffer)
X (gnus-Article-prepare article t)
X (if (save-excursion
X (set-buffer gnus-Article-buffer)
X (goto-char (point-min))
X (re-search-forward regexp nil t))
X (if (stringp form) ;Keyboard macro.
X (execute-kbd-macro form)
X (funcall form))))
X ))
X )))
X
X;;; caesar-region written by phr@prep.ai.mit.edu Nov 86
X;;; modified by tower@prep Nov 86
X;;; Modified by umerin@flab.flab.Fujitsu.JUNET for ROT47.
X
X(defun gnus-caesar-region (&optional n)
X "Caesar rotation of region by N, default 13, for decrypting netnews.
XROT47 will be performed for Japanese text in any case."
X (interactive (if current-prefix-arg ; Was there a prefix arg?
X (list (prefix-numeric-value current-prefix-arg))
X (list nil)))
X (cond ((not (numberp n)) (setq n 13))
X ((< n 0) (setq n (- 26 (% (- n) 26))))
X (t (setq n (% n 26)))) ;canonicalize N
X (if (not (zerop n)) ; no action needed for a rot of 0
X (progn
X (if (or (not (boundp 'caesar-translate-table))
X (/= (aref caesar-translate-table ?a) (+ ?a n)))
X (let ((i 0) (lower "abcdefghijklmnopqrstuvwxyz") upper)
X (message "Building caesar-translate-table...")
X (setq caesar-translate-table (make-vector 256 0))
X (while (< i 256)
X (aset caesar-translate-table i i)
X (setq i (1+ i)))
X (setq lower (concat lower lower) upper (upcase lower) i 0)
X (while (< i 26)
X (aset caesar-translate-table (+ ?a i) (aref lower (+ i n)))
X (aset caesar-translate-table (+ ?A i) (aref upper (+ i n)))
X (setq i (1+ i)))
X ;; ROT47 for Japanese text.
X ;; Thanks to ichikawa@flab.fujitsu.junet.
X (setq i 161)
X (let ((t1 (logior ?O 128))
X (t2 (logior ?! 128))
X (t3 (logior ?~ 128)))
X (while (< i 256)
X (aset caesar-translate-table i
X (let ((v (aref caesar-translate-table i)))
X (if (<= v t1) (if (< v t2) v (+ v 47))
X (if (<= v t3) (- v 47) v))))
X (setq i (1+ i))))
X (message "Building caesar-translate-table... done")))
X (let ((from (region-beginning))
X (to (region-end))
X (i 0) str len)
X (setq str (buffer-substring from to))
X (setq len (length str))
X (while (< i len)
X (aset str i (aref caesar-translate-table (aref str i)))
X (setq i (1+ i)))
X (goto-char from)
X (kill-region from to)
X (insert str)))))
X
X
X;;;
X;;; General functions.
X;;;
X
X(defun gnus-start-news-server (&optional confirm)
X "Open network stream to remote NNTP server.
XIf optional argument CONFIRM is non-nil, ask you host that NNTP server
Xis running even if it is defined."
X (if (nntp-server-opened)
X ;; Stream is already opened.
X nil
X ;; Open NNTP server.
X (if (or confirm
X (null gnus-nntp-server))
X (setq gnus-nntp-server
X (read-string "NNTP server: " gnus-nntp-server)))
X ;; If no server name is given, local host is assumed.
X (if (string-equal gnus-nntp-server "")
X (setq gnus-nntp-server (system-name)))
X ;; BUGS: Compatibility with 3.8 version. This will be remove in
X ;; 4.* version.
X (setq gnus-server-host gnus-nntp-server)
X (cond ((string-match ":" gnus-nntp-server)
X ;; :DIRECTORY
X (require 'mhspool)
X (message "Looking up private directory..."))
X ((and (null gnus-nntp-service)
X (string-equal gnus-nntp-server (system-name)))
X (require 'nnspool)
X (message "Looking up local news spool..."))
X (t
X (message "Connecting to NNTP server on %s..." gnus-nntp-server)))
X (cond ((nntp-open-server gnus-nntp-server gnus-nntp-service))
X ((and (stringp (nntp-status-message))
X (> (length (nntp-status-message)) 0))
X ;; Show valuable message if available.
X (error (nntp-status-message)))
X (t (error "Cannot open NNTP server on %s" gnus-nntp-server)))
X ))
X
X(defun gnus-select-newsgroup (group &optional show-all)
X "Select newsgroup GROUP.
XIf optional argument SHOW-ALL is non-nil, all of articles in the group
Xare selected."
X (if (nntp-request-group group)
X (let ((articles nil))
X (setq gnus-newsgroup-name group)
X (setq gnus-newsgroup-unreads
X (gnus-uncompress-sequence
X (nthcdr 2 (gnus-gethash group gnus-unread-hashtb))))
X (cond (show-all
X ;; Select all active articles.
X (setq articles
X (gnus-uncompress-sequence
X (nthcdr 2 (gnus-gethash group gnus-active-hashtb)))))
X (t
X ;; Select unread articles only.
X (setq articles gnus-newsgroup-unreads)))
X ;; Get headers list.
X (setq gnus-newsgroup-headers (nntp-retrieve-headers articles))
X ;; UNREADS may contain expired articles, so we have to remove
X ;; them from the list.
X (setq gnus-newsgroup-unreads
X (gnus-intersection gnus-newsgroup-unreads
X (mapcar
X (function
X (lambda (header)
X (nntp-header-number header)))
X gnus-newsgroup-headers)))
X ;; Marked article must be a subset of unread articles.
X (setq gnus-newsgroup-marked
X (gnus-intersection gnus-newsgroup-unreads
X (cdr (assoc group gnus-marked-assoc))))
X ;; First and last article in this newsgroup.
X (setq gnus-newsgroup-begin
X (if gnus-newsgroup-headers
X (nntp-header-number (car gnus-newsgroup-headers))
X 0
X ))
X (setq gnus-newsgroup-end
X (if gnus-newsgroup-headers
X (nntp-header-number
X (gnus-last-element gnus-newsgroup-headers))
X 0
X ))
X ;; File name that an article was saved last.
X (setq gnus-newsgroup-last-file nil)
X ;; Reset article pointer etc.
X (setq gnus-current-article nil)
X (setq gnus-current-headers nil)
X (setq gnus-current-history nil)
X (setq gnus-have-all-headers nil)
X (setq gnus-last-article nil)
X ;; GROUP is successfully selected.
X t
X )
X ))
X
X(defun gnus-mark-article-as-read (article)
X "Remember that ARTICLE is marked as read."
X ;; Remove from unread and marked list.
X (setq gnus-newsgroup-unreads
X (delq article gnus-newsgroup-unreads))
X (setq gnus-newsgroup-marked
X (delq article gnus-newsgroup-marked)))
X
X(defun gnus-mark-article-as-unread (article &optional clear-mark)
X "Remember that ARTICLE is marked as unread.
XOptional argument CLEAR-MARK means ARTICLE should not be remembered
Xthat it was marked as read once."
X ;; Add to unread list.
X (or (memq article gnus-newsgroup-unreads)
X (setq gnus-newsgroup-unreads
X (cons article gnus-newsgroup-unreads)))
X ;; If CLEAR-MARK is non-nil, the article must be removed from marked
X ;; list. Otherwise, it must be added to the list.
X (if clear-mark
X (setq gnus-newsgroup-marked
X (delq article gnus-newsgroup-marked))
X (or (memq article gnus-newsgroup-marked)
X (setq gnus-newsgroup-marked
X (cons article gnus-newsgroup-marked)))))
X
X(defun gnus-clear-system ()
X "Clear all variables and buffer."
X ;; Clear variables.
X (setq gnus-newsrc-assoc nil)
X (setq gnus-marked-assoc nil)
X (setq gnus-active-hashtb nil)
X (setq gnus-unread-hashtb nil)
X ;; Kill buffers
X (and gnus-current-startup-file
X (get-file-buffer gnus-current-startup-file)
X (kill-buffer (get-file-buffer gnus-current-startup-file)))
X (setq gnus-current-startup-file nil)
X ;; Kill buffers.
X (if (get-buffer gnus-Digest-buffer)
X (kill-buffer gnus-Digest-buffer))
X (if (get-buffer gnus-Digest-summary-buffer)
X (kill-buffer gnus-Digest-summary-buffer))
X (if (get-buffer gnus-Article-buffer)
X (kill-buffer gnus-Article-buffer))
X (if (get-buffer gnus-Subject-buffer)
X (kill-buffer gnus-Subject-buffer))
X (if (get-buffer gnus-Group-buffer)
X (kill-buffer gnus-Group-buffer)))
X
X(defun gnus-find-header-by-number (headers number)
X "Return a header which is a element of HEADERS and has NUMBER."
X (let ((found nil))
X (while (and headers (not found))
X ;; We cannot use `=' to accept non-numeric NUMBER.
X (if (eq number (nntp-header-number (car headers)))
X (setq found (car headers)))
X (setq headers (cdr headers)))
X found
X ))
X
X(defun gnus-version ()
X "Version numbers of this version of GNUS."
X (interactive)
X (if (boundp 'nnspool-version)
X (message "You're running %s with %s and %s"
X gnus-version nntp-version nnspool-version)
X (message "You're running %s with %s" gnus-version nntp-version)))
X
X(defun gnus-rebind-functions ()
X "Replace functions defined in rnews.el and rnewspost.el."
X ;; Override news-inews function in rnewspost.el.
X (fset 'news-inews 'gnus-inews)
X ;; Override caesar-region function in rnews.el.
X (fset 'caesar-region 'gnus-caesar-region))
X
X(defun gnus-narrow-to-page (&optional arg)
X "Make text outside current page invisible except for page delimiter.
XA numeric arg specifies to move forward or backward by that many pages,
Xthus showing a page other than the one point was originally in."
X (interactive "P")
X (setq arg (if arg (prefix-numeric-value arg) 0))
X (save-excursion
X (forward-page -1) ;Beginning of current page.
X (widen)
X (if (> arg 0)
X (forward-page arg)
X (if (< arg 0)
X (forward-page (1- arg))))
X ;; Find the end of the page.
X (forward-page)
X ;; If we stopped due to end of buffer, stay there.
X ;; If we stopped after a page delimiter, put end of restriction
X ;; at the beginning of that line.
X ;; These are commented out.
X ;; (if (save-excursion (beginning-of-line)
X ;; (looking-at page-delimiter))
X ;; (beginning-of-line))
X (let ((end (point-max)))
X (narrow-to-region (point)
X (progn
X ;; Find the top of the page.
X (forward-page -1)
X ;; If we found beginning of buffer, stay there.
X ;; If extra text follows page delimiter on same line,
X ;; include it.
X ;; Otherwise, show text starting with following line.
X (if (and (eolp) (not (bobp)))
X (forward-line 1))
X (point)))
X (if (and gnus-break-pages overlay-arrow-string)
X ;; Show MORE message at end of the page except for last page.
X (if (/= (point-max) end)
X (set-marker overlay-arrow-position
X (progn (goto-char (point-max))
X (beginning-of-line)
X (point)))
X (set-marker overlay-arrow-position nil)))
X )))
X
X(defun gnus-last-element (list)
X "Return last element of LIST."
X (let ((last nil))
X (while list
X (if (null (cdr list))
X (setq last (car list)))
X (setq list (cdr list)))
X last
X ))
X
X(defun gnus-set-difference (list1 list2)
X "Return a list of elements of LIST1 that do not appear in LIST2."
X (let ((list1 (if list2 (copy-sequence list1) list1)))
X (while list2
X (setq list1 (delq (car list2) list1))
X (setq list2 (cdr list2)))
X list1
X ))
X
X(defun gnus-intersection (list1 list2)
X "Return a list of elements that appear in both LIST1 and LIST2."
X (let ((result nil))
X (while list2
X (if (memq (car list2) list1)
X (setq result (cons (car list2) result)))
X (setq list2 (cdr list2)))
X result
X ))
X
X
X;; Functions accessing headers.
X;; Functions are more convenient than macros in some case.
X
X(defun gnus-header-number (header)
X "Return article number in HEADER."
X (nntp-header-number header))
X
X(defun gnus-header-subject (header)
X "Return subject string in HEADER."
X (nntp-header-subject header))
X
X(defun gnus-header-from (header)
X "Return author string in HEADER."
X (nntp-header-from header))
X
X(defun gnus-header-xref (header)
X "Return xref string in HEADER."
X (nntp-header-xref header))
X
X(defun gnus-header-lines (header)
X "Return lines in HEADER."
X (nntp-header-lines header))
X
X(defun gnus-header-date (header)
X "Return date in HEADER."
X (nntp-header-date header))
X
X(defun gnus-header-id (header)
X "Return date in HEADER."
X (nntp-header-id header))
X
X
X;;;
X;;; Article savers.
X;;;
X
X(defun gnus-output-to-rmail (file-name)
X "Append the current article to an Rmail file named FILE-NAME."
X (require 'rmail)
X ;; Most of these codes are borrowed from rmailout.el.
X (setq file-name (expand-file-name file-name))
X (setq rmail-last-rmail-file file-name)
X (let ((artbuf (current-buffer))
X (tmpbuf (get-buffer-create " *GNUS-output*")))
X (save-excursion
X (or (get-file-buffer file-name)
X (file-exists-p file-name)
X (if (yes-or-no-p
X (concat "\"" file-name "\" does not exist, create it? "))
X (let ((file-buffer (create-file-buffer file-name)))
X (save-excursion
X (set-buffer file-buffer)
X (rmail-insert-rmail-file-header)
X (let ((require-final-newline nil))
X (write-region (point-min) (point-max) file-name t 1)))
X (kill-buffer file-buffer))
X (error "Output file does not exist")))
X (set-buffer tmpbuf)
X (buffer-flush-undo (current-buffer))
X (erase-buffer)
X (insert-buffer-substring artbuf)
X (gnus-convert-article-to-rmail)
X ;; Decide whether to append to a file or to an Emacs buffer.
X (let ((outbuf (get-file-buffer file-name)))
X (if (not outbuf)
X (append-to-file (point-min) (point-max) file-name)
X ;; File has been visited, in buffer OUTBUF.
X (set-buffer outbuf)
X (let ((buffer-read-only nil)
X (msg (and (boundp 'rmail-current-message)
X rmail-current-message)))
X ;; If MSG is non-nil, buffer is in RMAIL mode.
X (if msg
X (progn (widen)
X (narrow-to-region (point-max) (point-max))))
X (insert-buffer-substring tmpbuf)
X (if msg
X (progn
X (goto-char (point-min))
X (widen)
X (search-backward "\^_")
X (narrow-to-region (point) (point-max))
X (goto-char (1+ (point-min)))
X (rmail-count-new-messages t)
X (rmail-show-message msg))))))
X )
X (kill-buffer tmpbuf)
X ))
X
X(defun gnus-output-to-file (file-name)
X "Append the current article to a file named FILE-NAME."
X (setq file-name (expand-file-name file-name))
X (let ((artbuf (current-buffer))
X (tmpbuf (get-buffer-create " *GNUS-output*")))
X (save-excursion
X (set-buffer tmpbuf)
X (buffer-flush-undo (current-buffer))
X (erase-buffer)
X (insert-buffer-substring artbuf)
X ;; Append newline at end of the buffer as separator, and then
X ;; save it to file.
X (goto-char (point-max))
X (insert "\n")
X (append-to-file (point-min) (point-max) file-name))
X (kill-buffer tmpbuf)
X ))
X
X(defun gnus-convert-article-to-rmail ()
X "Convert article in current buffer to Rmail message format."
X (let ((buffer-read-only nil))
X ;; Insert special header of Unix mail.
X (goto-char (point-min))
X (insert "From "
X (or (mail-strip-quoted-names (mail-fetch-field "from"))
X "unknown")
X " " (current-time-string) "\n")
X ;; ``Quote'' "\nFrom " as "\n>From "
X ;; (note that this isn't really quoting, as there is no requirement
SHAR_EOF
echo "End of part 3, continue with part 4"
echo "4" > s2_seq_.tmp
exit 0
--
Masanobu UMEDA
umerin@flab.flab.Fujitsu.JUNET
umerin%flab.flab.Fujitsu.JUNET@uunet.uu.NETumerin@flab.flab.fujitsu.JUNET (Masanobu UMEDA) (11/11/88)
---- Cut Here and unpack ----
#!/bin/sh
# this is part 4 of a multipart archive
# do not concatenate these parts, unpack them in order with /bin/sh
# file gnus.el continued
#
CurArch=4
if test ! -r s2_seq_.tmp
then echo "Please unpack part 1 first!"
exit 1; fi
( read Scheck
if test "$Scheck" != $CurArch
then echo "Please unpack part $Scheck next!"
exit 1;
else exit 0; fi
) < s2_seq_.tmp || exit 1
sed 's/^X//' << 'SHAR_EOF' >> gnus.el
X ;; that "\n[>]+From " be quoted in the same transparent way.)
X (while (search-forward "\nFrom " nil t)
X (forward-char -5)
X (insert ?>))
X ;; Convert article to babyl format.
X (rmail-convert-to-babyl-format)
X ))
X
X
X;;;
X;;; Get information about active articles, already read articles, and
X;;; still unread articles.
X;;;
X
X;; GNUS internal format of gnus-newsrc-assoc:
X;; (("general" t (1 . 1))
X;; ("misc" t (1 . 10) (12 . 15))
X;; ("test" nil (1 . 99)) ...)
X;; GNUS internal format of gnus-marked-assoc:
X;; (("general" 1 2 3)
X;; ("misc" 2) ...)
X;; GNUS internal format of gnus-active-hashtb:
X;; (("general" t (1 . 1))
X;; ("misc" t (1 . 10))
X;; ("test" nil (1 . 99)) ...)
X;; GNUS internal format of gnus-unread-hashtb:
X;; (("general" 1 (1 . 1))
X;; ("misc" 14 (1 . 10) (12 . 15))
X;; ("test" 99 (1 . 99)) ...)
X
X(defun gnus-setup-news-info (&optional force)
X "Setup news information.
XIf optional argument FORCE is non-nil, initialize completely."
X (let ((init (not (and gnus-newsrc-assoc
X gnus-active-hashtb
X gnus-unread-hashtb
X (not force)))))
X (if init
X (gnus-read-newsrc-file))
X (gnus-read-active-file)
X (if init
X (gnus-add-new-newsgroup))
X (gnus-expire-marked-articles)
X (gnus-get-unread-articles)
X ))
X
X(defun gnus-make-newsrc-file (file)
X "Make site dependent file name by catenating FILE and server host name."
X (let* ((file (expand-file-name file nil))
X (real-file (concat file "-" gnus-nntp-server)))
X (if (file-exists-p real-file)
X real-file file)
X ))
X
X(defun gnus-get-unread-articles ()
X "Compute diffs between active and read articles."
X (let ((read gnus-newsrc-assoc)
X (group-info nil)
X (group-name nil)
X (active nil)
X (range nil))
X (message "Checking new news...")
X (or gnus-unread-hashtb
X (setq gnus-unread-hashtb (gnus-make-hashtable)))
X (while read
X (setq group-info (car read)) ;About one newsgroup
X (setq group-name (car group-info))
X (setq active (nth 2 (gnus-gethash group-name gnus-active-hashtb)))
X (if (and gnus-octive-hashtb
X (equal active
X (nth 2 (gnus-gethash group-name gnus-octive-hashtb))))
X nil ;Nothing changed.
X (setq range (gnus-difference-of-range active (nthcdr 2 group-info)))
X (gnus-sethash group-name
X (cons group-name ;Group name
X (cons (gnus-number-of-articles range)
X range)) ;Range of unread articles
X gnus-unread-hashtb)
X )
X (setq read (cdr read))
X )
X (message "Checking new news... done")
X ))
X
X(defun gnus-expire-marked-articles ()
X "Check expired article which is marked as unread."
X (let ((marked-assoc gnus-marked-assoc)
X (updated-assoc nil)
X (marked nil) ;Current marked info.
X (articles nil) ;List of marked articles.
X (updated nil) ;List of real marked.
X (begin nil))
X (while marked-assoc
X (setq marked (car marked-assoc))
X (setq articles (cdr marked))
X (setq updated nil)
X (setq begin
X (car (nth 2 (gnus-gethash (car marked) gnus-active-hashtb))))
X (while (and begin articles)
X (if (>= (car articles) begin)
X ;; This article is still active.
X (setq updated (cons (car articles) updated)))
X (setq articles (cdr articles)))
X (if updated
X (setq updated-assoc
X (cons (cons (car marked) updated) updated-assoc)))
X (setq marked-assoc (cdr marked-assoc)))
X (setq gnus-marked-assoc updated-assoc)
X ))
X
X(defun gnus-mark-as-read-by-xref (group headers unreads)
X "Mark as read using cross reference info. of GROUP with HEADERS and UNREADS.
XReturn list of updated newsgroup."
X (let ((xref-list nil)
X (header nil)
X (xrefs nil)) ;One Xref: field info.
X (while headers
X (setq header (car headers))
X (if (memq (nntp-header-number header) unreads)
X ;; This article is not yet marked as read.
X nil
X (setq xrefs (gnus-parse-xref-field (nntp-header-xref header)))
X ;; For each cross reference info. on one Xref: field.
X (while xrefs
X (let ((xref (car xrefs)))
X (or (string-equal group (car xref)) ;Ignore this group.
X (let ((group-xref (assoc (car xref) xref-list)))
X (if group-xref
X (if (memq (cdr xref) (cdr group-xref))
X nil ;Alread marked.
X (setcdr group-xref (cons (cdr xref) (cdr group-xref))))
X ;; Create new assoc entry for GROUP.
X (setq xref-list
X (cons (list (car xref) (cdr xref)) xref-list)))
X )))
X (setq xrefs (cdr xrefs))
X ))
X (setq headers (cdr headers)))
X ;; Mark cross referenced articles as read.
X (gnus-mark-xrefed-as-read xref-list)
X ;;(message "%s %s" (prin1-to-string unreads) (prin1-to-string xref-list))
X ;; Return list of updated group name.
X (mapcar (function car) xref-list)
X ))
X
X(defun gnus-parse-xref-field (xref-value)
X "Parse Xref: field value, and return list of `(group . article-id)'."
X (let ((xref-list nil)
X (xref-value (or xref-value "")))
X ;; Remove server host name.
X (if (string-match "^[ \t]*[^ \t,]+[ \t,]+\\(.*\\)$" xref-value)
X (setq xref-value (substring xref-value (match-beginning 1)))
X (setq xref-value nil))
X ;; Process each xref info.
X (while xref-value
X (if (string-match
X "^[ \t,]*\\([^ \t,]+\\):\\([0-9]+\\)[^0-9]*" xref-value)
X (progn
X (setq xref-list
X (cons
X (cons
X ;; Group name
X (substring xref-value (match-beginning 1) (match-end 1))
X ;; Article-ID
X (string-to-int
X (substring xref-value (match-beginning 2) (match-end 2))))
X xref-list))
X (setq xref-value (substring xref-value (match-end 2))))
X (setq xref-value nil)))
X ;; Return alist.
X xref-list
X ))
X
X(defun gnus-mark-xrefed-as-read (xrefs)
X "Update unread article information using XREFS alist."
X (let ((group nil)
X (idlist nil)
X (unread nil))
X (while xrefs
X (setq group (car (car xrefs)))
X (setq idlist (cdr (car xrefs)))
X (setq unread (gnus-uncompress-sequence
X (nthcdr 2 (gnus-gethash group gnus-unread-hashtb))))
X (while idlist
X (setq unread (delq (car idlist) unread))
X (setq idlist (cdr idlist)))
X (gnus-update-unread-articles group unread 'ignore)
X (setq xrefs (cdr xrefs))
X )))
X
X(defun gnus-update-unread-articles (group unread-list marked-list)
X "Update unread articles of GROUP using UNREAD-LIST and MARKED-LIST."
X (let ((active (nth 2 (gnus-gethash group gnus-active-hashtb)))
X (unread (gnus-gethash group gnus-unread-hashtb)))
X (if (null unread)
X ;; Ignore unknown newsgroup.
X nil
X ;; Update gnus-unread-hashtb.
X (if unread-list
X (setcdr (cdr unread)
X (gnus-compress-sequence unread-list))
X ;; All of the articles are read.
X (setcdr (cdr unread) '((0 . 0))))
X ;; Number of unread articles.
X (setcar (cdr unread)
X (gnus-number-of-articles (nthcdr 2 unread)))
X ;; Update gnus-newsrc-assoc.
X (if (> (car active) 0)
X ;; Articles from 1 to N are not active.
X (setq active (cons 1 (cdr active))))
X (setcdr (cdr (assoc group gnus-newsrc-assoc))
X (gnus-difference-of-range active (nthcdr 2 unread)))
X ;; Update .newsrc buffer.
X (gnus-update-newsrc-buffer group)
X ;; Update gnus-marked-assoc.
X (if (listp marked-list) ;Includes NIL.
X (let ((marked (assoc group gnus-marked-assoc)))
X (cond (marked
X (setcdr marked marked-list))
X (marked-list ;Non-NIL.
X (setq gnus-marked-assoc
X (cons (cons group marked-list)
X gnus-marked-assoc)))
X )))
X )))
X
X(defun gnus-compress-sequence (numbers)
X "Convert list of sorted numbers to ranges."
X (let* ((numbers (sort (copy-sequence numbers) (function <)))
X (first (car numbers))
X (last (car numbers))
X (result nil))
X (while numbers
X (cond ((= last (car numbers)) nil) ;Omit duplicated number
X ((= (1+ last) (car numbers)) ;Still in sequence
X (setq last (car numbers)))
X (t ;End of one sequence
X (setq result (cons (cons first last) result))
X (setq first (car numbers))
X (setq last (car numbers)))
X )
X (setq numbers (cdr numbers))
X )
X (nreverse (cons (cons first last) result))
X ))
X
X(defun gnus-uncompress-sequence (ranges)
X "Expand compressed format of sequence."
X (let ((first nil)
X (last nil)
X (result nil))
X (while ranges
X (setq first (car (car ranges)))
X (setq last (cdr (car ranges)))
X (while (< first last)
X (setq result (cons first result))
X (setq first (1+ first)))
X (setq result (cons first result))
X (setq ranges (cdr ranges))
X )
X (nreverse result)
X ))
X
X(defun gnus-number-of-articles (range)
X "Compute number of articles from RANGE `((beg1 . end1) (beg2 . end2) ...)'."
X (let ((count 0))
X (while range
X (if (/= (cdr (car range)) 0)
X ;; If end1 is 0, it must be skipped. Usually no articles in
X ;; this group.
X (setq count (+ count 1 (- (cdr (car range)) (car (car range))))))
X (setq range (cdr range))
X )
X count ;Result
X ))
X
X(defun gnus-difference-of-range (src obj)
X "Compute (SRC - OBJ) on range.
XRange of SRC is expressed as `(beg . end)'.
XRange of OBJ is expressed as `((beg1 . end1) (beg2 . end2) ...)."
X (let ((beg (car src))
X (end (cdr src))
X (range nil)) ;This is result.
X ;; Src may be nil.
X (while (and src obj)
X (let ((beg1 (car (car obj)))
X (end1 (cdr (car obj))))
X (cond ((> beg end)
X (setq obj nil)) ;Terminate loop
X ((< beg beg1)
X (setq range (cons (cons beg (min (1- beg1) end)) range))
X (setq beg (1+ end1)))
X ((>= beg beg1)
X (setq beg (max beg (1+ end1))))
X )
X (setq obj (cdr obj)) ;Next OBJ
X ))
X ;; Src may be nil.
X (if (and src (<= beg end))
X (setq range (cons (cons beg end) range)))
X ;; Result
X (if range
X (nreverse range)
X (list (cons 0 0)))
X ))
X
X(defun gnus-add-new-newsgroup ()
X "Add new newsgroup to gnus-newsrc-assoc.
X`-n' option of options line in .newsrc file is recognized."
X (let ((group nil))
X (mapatoms
X (function
X (lambda (sym)
X (setq group (symbol-name sym))
X ;; Taking account of `-n' option.
X (if (and (or (null gnus-newsrc-options-n-no)
X (not (string-match gnus-newsrc-options-n-no group))
X (and gnus-newsrc-options-n-yes
X (string-match gnus-newsrc-options-n-yes group)))
X (null (assoc group gnus-newsrc-assoc)))
X ;; Find new newsgroup.
X (progn
X (setq gnus-newsrc-assoc
X (cons (list group t) gnus-newsrc-assoc))
X (gnus-update-newsrc-buffer group)
X (message "New newsgroup: %s is subscribed" group)
X ))))
X gnus-active-hashtb)
X ))
X
X(defun gnus-delete-bogus-newsgroup (&optional confirm)
X "Delete bogus newsgroup.
XIf optional argument CONFIRM is non-nil, confirm deletion of newsgroups."
X (let ((group nil)
X (oldrc gnus-newsrc-assoc)
X (newsrc nil)
X (marked gnus-marked-assoc)
X (newmarked nil))
X (message "Checking bogus newsgroups...")
X ;; Update gnus-newsrc-assoc.
X (while oldrc
X (setq group (car (car oldrc)))
X (if (or (gnus-gethash group gnus-active-hashtb)
X (and confirm
X (not (y-or-n-p
X (format "Delete bogus newsgroup: %s " group)))))
X ;; Active newsgroup.
X (setq newsrc (cons (car oldrc) newsrc))
X ;; Found bogus newsgroup.
X (gnus-update-newsrc-buffer group 'delete))
X (setq oldrc (cdr oldrc))
X )
X (setq gnus-newsrc-assoc (nreverse newsrc))
X ;; Update gnus-marked-assoc.
X (while marked
X (setq group (car (car marked)))
X (if (and (cdr (car marked)) ;Non-empty?
X (assoc group gnus-newsrc-assoc)) ;Not bogus?
X (setq newmarked (cons (car marked) newmarked)))
X (setq marked (cdr marked)))
X (setq gnus-marked-assoc newmarked)
X (message "Checking bogus newsgroups... done")
X ))
X
X(defun gnus-read-active-file ()
X "Get active file from NNTP server."
X (message "Reading active file...")
X (if (nntp-request-list) ;Get active file from server
X (save-excursion
X (set-buffer nntp-server-buffer)
X ;; Save OLD active info.
X (setq gnus-octive-hashtb gnus-active-hashtb)
X (setq gnus-active-hashtb (gnus-make-hashtable))
X (gnus-active-to-gnus-format)
X (message "Reading active file... done"))
X (error "Cannot read active file from NNTP server.")))
X
X(defun gnus-active-to-gnus-format ()
X "Convert active file format to internal format."
X ;; Delete unnecessary lines.
X (goto-char (point-min))
X (delete-matching-lines "^to\\..*$")
X ;; Store active file in hashtable.
X (goto-char (point-min))
X (while
X (re-search-forward
X "^\\([^ \t]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([ymn]\\).*$"
X nil t)
X (gnus-sethash
X (buffer-substring (match-beginning 1) (match-end 1))
X (list (buffer-substring (match-beginning 1) (match-end 1))
X (string-equal
X "y" (buffer-substring (match-beginning 4) (match-end 4)))
X (cons (string-to-int
X (buffer-substring (match-beginning 3) (match-end 3)))
X (string-to-int
X (buffer-substring (match-beginning 2) (match-end 2)))))
X gnus-active-hashtb)
X ))
X
X(defun gnus-read-newsrc-file ()
X "Read in .newsrc FILE."
X (setq gnus-current-startup-file (gnus-make-newsrc-file gnus-startup-file))
X ;; Reset variables.
X (setq gnus-newsrc-options nil)
X (setq gnus-newsrc-options-n-yes nil)
X (setq gnus-newsrc-options-n-no nil)
X (setq gnus-newsrc-assoc nil)
X (setq gnus-marked-assoc nil)
X (let* ((newsrc-file gnus-current-startup-file)
X (quick-file (concat newsrc-file ".el"))
X (quick-loaded nil)
X (newsrc-mod (nth 5 (file-attributes newsrc-file)))
X (quick-mod (nth 5 (file-attributes quick-file))))
X (save-excursion
X ;; Prepare .newsrc buffer.
X (set-buffer (find-file-noselect newsrc-file))
X ;; It is not so good idea turning off undo.
X ;;(buffer-flush-undo (current-buffer))
X ;; Load quick .newsrc to restore gnus-marked-assoc even if
X ;; gnus-newsrc-assoc is out of date.
X (condition-case nil
X (setq quick-loaded (load quick-file t t t))
X (error nil))
X (cond ((and newsrc-mod quick-mod
X ;; .newsrc.el is newer than .newsrc.
X ;; Some older version does not support function
X ;; `file-newer-than-file-p'.
X (or (< (car newsrc-mod) (car quick-mod))
X (and (= (car newsrc-mod) (car quick-mod))
X (<= (nth 1 newsrc-mod) (nth 1 quick-mod))))
X quick-loaded
X gnus-newsrc-assoc
X )
X ;; We don't have to read raw startup file.
X )
X (t
X ;; Since .newsrc file is newer than quick file, read it.
X (message "Reading %s..." newsrc-file)
X (gnus-newsrc-to-gnus-format)
X (message "Reading %s... Done" newsrc-file)))
X )))
X
X(defun gnus-newsrc-to-gnus-format ()
X "Parse current buffer as .newsrc file."
X (let ((newsgroup nil)
X (subscribe nil)
X (ranges nil)
X (subrange nil)
X (read-list nil))
X ;; We have to re-initialize these variable (except for
X ;; gnus-marked-assoc) because quick load .newsrc may contain bogus
X ;; values.
X (setq gnus-newsrc-options nil)
X (setq gnus-newsrc-options-n-yes nil)
X (setq gnus-newsrc-options-n-no nil)
X (setq gnus-newsrc-assoc nil)
X ;; Save options line to variable.
X (goto-char (point-min))
X (if (re-search-forward "^[ \t]*options[ \t]*\\(.*[^ \t\n]\\)[ \t]*$" nil t)
X (progn
X (setq gnus-newsrc-options
X (buffer-substring (match-beginning 1) (match-end 1)))
X ;; Compile "-n" option.
X (if (string-match "\\(^\\|[ \t]\\)-n" gnus-newsrc-options)
X (let ((options (substring gnus-newsrc-options (match-end 0)))
X (yes nil) (no nil)
X (yes-or-no nil)
X (newsgroup nil))
X (while
X (string-match
X "^[ \t]*\\(!?\\)\\([^--- \t][^ \t]*\\)" options)
X (setq yes-or-no
X (substring options (match-beginning 1) (match-end 1)))
X (setq newsgroup
X (regexp-quote
X (substring options
X (match-beginning 2) (match-end 2))))
X (setq options (substring options (match-end 2)))
X (cond ((and (string-equal yes-or-no "!")
X (string-equal newsgroup "all"))
X (setq no (cons ".*" no)))
X ((string-equal yes-or-no "!")
X (setq no (cons newsgroup no)))
X ((string-equal newsgroup "all")) ;Ignore `all'.
X (t
X (setq yes (cons newsgroup yes)))
X ))
X (if yes
X (setq gnus-newsrc-options-n-yes
X (concat "^\\("
X (apply (function concat)
X (mapcar
X (function
X (lambda (newsgroup)
X (concat newsgroup "\\|")))
X (cdr yes)))
X (car yes) "\\)")))
X (if no
X (setq gnus-newsrc-options-n-no
X (concat "^\\("
X (apply (function concat)
X (mapcar
X (function
X (lambda (newsgroup)
X (concat newsgroup "\\|")))
X (cdr no)))
X (car no) "\\)")))
X ))
X ))
X ;; Parse body of .newsrc file
X (goto-char (point-min))
X (while (re-search-forward
X "^[ \t]*\\([^!: \t]+\\)[ \t]*\\([!:]\\)[ \t]*\\(.*\\)$" nil t)
X (setq newsgroup (buffer-substring (match-beginning 1) (match-end 1)))
X (setq subscribe
X (string-equal
X ":" (buffer-substring (match-beginning 2) (match-end 2))))
X (setq ranges (buffer-substring (match-beginning 3) (match-end 3)))
X (setq read-list nil)
X (while (string-match "^[, \t]*\\([0-9-]+\\)" ranges)
X (setq subrange (substring ranges (match-beginning 1) (match-end 1)))
X (setq ranges (substring ranges (match-end 1)))
X (cond ((string-match "^\\([0-9]+\\)-\\([0-9]+\\)$" subrange)
X (setq read-list
X (cons
X (cons (string-to-int
X (substring subrange
X (match-beginning 1) (match-end 1)))
X (string-to-int
X (substring subrange
X (match-beginning 2) (match-end 2))))
X read-list)))
X ((string-match "^[0-9]+$" subrange)
X (setq read-list
X (cons
X (cons (string-to-int subrange) (string-to-int subrange))
X read-list)))
X (t
X (message "Ignoring bogus lines of %s" newsgroup)
X (sit-for 0))
X ))
X (setq gnus-newsrc-assoc
X (cons (cons newsgroup (cons subscribe (nreverse read-list)))
X gnus-newsrc-assoc))
X )
X (setq gnus-newsrc-assoc
X (nreverse gnus-newsrc-assoc))
X ))
X
X(defun gnus-save-newsrc-file ()
X "Save to .newsrc FILE."
X (if gnus-newsrc-assoc
X (save-excursion
X (set-buffer (get-file-buffer gnus-current-startup-file))
X (if (not (buffer-modified-p))
X (message "(No changes need to be saved)")
X (message "Saving %s..." gnus-current-startup-file)
X (let ((make-backup-files t)
X (version-control nil)
X (require-final-newline t)) ;Don't ask even if requested.
X ;; Make backup file of master newsrc.
X ;; You can stop or change version control of backup file.
X ;; Suggested by jason@violet.berkeley.edu.
X (run-hooks 'gnus-Save-newsrc-hook)
X (save-buffer))
X ;; Quickly accessible .newsrc.
X (set-buffer (get-buffer-create " *GNUS-newsrc*"))
X (buffer-flush-undo (current-buffer))
X (erase-buffer)
X (gnus-gnus-to-quick-newsrc-format)
X (let ((make-backup-files nil)
X (version-control nil)
X (require-final-newline t)) ;Don't ask even if requested.
X (write-file (concat gnus-current-startup-file ".el")))
X (kill-buffer (current-buffer))
X (message "Saving %s... Done" gnus-current-startup-file)
X ))
X ))
X
X(defun gnus-update-newsrc-buffer (group &optional delete)
X "Incrementally update .newsrc buffer about GROUP.
XIf optional argument DELETE is non-nil, delete the group."
X (save-excursion
X (set-buffer (get-file-buffer gnus-current-startup-file))
X ;; Delete old entry.
X (goto-char (point-min))
X (if (re-search-forward
X (concat "^[ \t]*" (regexp-quote group) "[ \t]*[:!]") nil t)
X (progn
X (beginning-of-line)
X (kill-line 1)
X ))
X (if (not delete)
X (let ((newsrc (assoc group gnus-newsrc-assoc)))
X (if newsrc
X (progn
X ;; Insert after options line.
X (if (looking-at "^options[ \t]")
X (forward-line 1))
X (insert group ;Group name
X (if (nth 1 newsrc) ;Subscribed?
X ": " "! "))
X (gnus-ranges-to-newsrc-format (nthcdr 2 newsrc)) ;Read articles
X (insert "\n")
X ))
X ))
X ))
X
X(defun gnus-gnus-to-quick-newsrc-format ()
X "Insert gnus-newsrc-assoc as evaluable format."
X (insert ";; GNUS internal format of .newsrc file.\n")
X (insert ";; Touch .newsrc file instead if you think remove this file.\n")
X ;; Save options line.
X (if gnus-newsrc-options
X (insert "(setq gnus-newsrc-options "
X (prin1-to-string gnus-newsrc-options)
X ")\n"))
X (if gnus-newsrc-options-n-yes
X (insert "(setq gnus-newsrc-options-n-yes "
X (prin1-to-string gnus-newsrc-options-n-yes)
X ")\n"))
X (if gnus-newsrc-options-n-no
X (insert "(setq gnus-newsrc-options-n-no "
X (prin1-to-string gnus-newsrc-options-n-no)
X ")\n"))
X ;; Save newsrc assoc list.
X (insert "(setq gnus-newsrc-assoc '"
X (prin1-to-string gnus-newsrc-assoc)
X ")\n")
X ;; Save marked assoc list.
X (insert "(setq gnus-marked-assoc '"
X (prin1-to-string gnus-marked-assoc)
X ")\n")
X )
X
X(defun gnus-ranges-to-newsrc-format (ranges)
X "Insert ranges of read articles."
X (let ((range nil)) ;Range is a pair of BEGIN and END.
X (while ranges
X (setq range (car ranges))
X (setq ranges (cdr ranges))
X (cond ((= (car range) (cdr range))
X (if (= (car range) 0)
X (setq ranges nil) ;No unread articles.
X (insert (int-to-string (car range)))
X (if ranges (insert ","))
X ))
X (t
X (insert (int-to-string (car range))
X "-"
X (int-to-string (cdr range)))
X (if ranges (insert ","))
X ))
X )))
X
X
X;;;
X;;; Post A News using NNTP
X;;;
X
X(defun gnus-news-reply ()
X "Compose and post a reply (aka a followup) to the current article on USENET.
XWhile composing the followup, use \\[news-reply-yank-original] to yank the
Xoriginal message into it."
X (interactive)
X (if (y-or-n-p "Are you sure you want to followup to all of USENET? ")
X (let (from cc subject date to followup-to newsgroups message-of
X references distribution message-id
X (buffer (current-buffer)))
X (save-restriction
X (and (not (zerop (buffer-size)))
X ;;(equal major-mode 'news-mode)
X (equal major-mode 'gnus-Article-mode)
X (progn
X ;; (news-show-all-headers)
X (gnus-Article-show-all-headers)
X (narrow-to-region (point-min) (progn (goto-char (point-min))
X (search-forward "\n\n")
X (- (point) 2)))))
X (setq from (mail-fetch-field "from")
X news-reply-yank-from from
X subject (mail-fetch-field "subject")
X date (mail-fetch-field "date")
X followup-to (mail-fetch-field "followup-to")
X newsgroups (or followup-to
X (mail-fetch-field "newsgroups"))
X references (mail-fetch-field "references")
X distribution (mail-fetch-field "distribution")
X message-id (mail-fetch-field "message-id")
X news-reply-yank-message-id message-id))
X (pop-to-buffer "*post-news*")
X (news-reply-mode)
X (gnus-rebind-functions)
X (if (and (buffer-modified-p)
X (not (y-or-n-p "Unsent article being composed; erase it? ")))
X ;; Continue composition.
X nil
X (erase-buffer)
X (and subject
X (setq subject
X (concat "Re: " (gnus-simplify-subject subject 're-only))))
X (and from
X (progn
X (let ((stop-pos
X (string-match " *at \\| *@ \\| *(\\| *<" from)))
X (setq message-of
X (concat
X (if stop-pos (substring from 0 stop-pos) from)
X "'s message of "
X date)))))
X (news-setup nil subject message-of newsgroups buffer)
X (if followup-to
X (progn (news-reply-followup-to)
X (insert followup-to)))
X (mail-position-on-field "References")
X (if references
X (insert references))
X (if (and references message-id)
X (insert " "))
X (if message-id
X (insert message-id))
X ;; Make sure the article is posted by GNUS.
X ;;(mail-position-on-field "Posting-Software")
X ;;(insert "GNUS: NNTP-based News Reader for GNU Emacs")
X ;; Insert Distribution: field.
X ;; Suggested by ichikawa@flab.fujitsu.junet.
X (mail-position-on-field "Distribution")
X (insert (or distribution gnus-default-distribution ""))
X (goto-char (point-max))))
X (message "")))
X
X(defun gnus-post-news ()
X "Begin editing a new USENET news article to be posted.
X
XType \\[describe-mode] once editing the article to get a list of commands."
X (interactive)
X (if (y-or-n-p "Are you sure you want to post to all of USENET? ")
X (let ((buffer (current-buffer))
X (subject nil)
X (newsgroups nil)
X (distribution nil))
X (save-restriction
X (and (not (zerop (buffer-size)))
X ;;(equal major-mode 'news-mode)
X (equal major-mode 'gnus-Article-mode)
X (progn
X ;;(news-show-all-headers)
X (gnus-Article-show-all-headers)
X (narrow-to-region (point-min) (progn (goto-char (point-min))
X (search-forward "\n\n")
X (- (point) 2)))))
X (setq news-reply-yank-from (mail-fetch-field "from")
X news-reply-yank-message-id (mail-fetch-field "message-id")))
X (pop-to-buffer "*post-news*")
X (news-reply-mode)
X (gnus-rebind-functions)
X (if (and (buffer-modified-p)
X (not (y-or-n-p "Unsent article being composed; erase it? ")))
X ;; Continue composition.
X nil
X ;; Ask newsgroups, subject and distribution if novice.
X ;; Suggested by yuki@flab.fujitsu.junet.
X (if gnus-novice-user
X (progn
X ;; Subscribed newsgroup names are required for
X ;; completing read of newsgroup.
X (or gnus-newsrc-assoc
X (gnus-read-newsrc-file))
X ;; Which do you like? (UMERIN)
X ;; (setq newsgroups (read-string "Newsgroups: " "general"))
X (setq newsgroups
X (completing-read "Newsgroup: " gnus-newsrc-assoc
X nil 'require-match))
X (setq subject (read-string "Subject: "))
X (setq distribution
X (substring newsgroups 0 (string-match "\\." newsgroups)))
X (if (string-equal distribution newsgroups)
X ;; Newsgroup may be general or control. In this
X ;; case, use default distribution.
X (setq distribution gnus-default-distribution))
X (setq distribution
X (read-string "Distribution: " distribution))
X (if (string-equal distribution "")
X (setq distribution nil))
X ))
X (erase-buffer)
X (news-setup () subject () newsgroups buffer)
X ;; Make sure the article is posted by GNUS.
X ;;(mail-position-on-field "Posting-Software")
X ;;(insert "GNUS: NNTP-based News Reader for GNU Emacs")
X ;; Insert Distribution: field.
X ;; Suggested by ichikawa@flab.fujitsu.junet.
X (mail-position-on-field "Distribution")
X (insert (or distribution gnus-default-distribution ""))
X (goto-char (point-max))))
X (message "")))
X
X(defun gnus-inews ()
X "Send a news message using NNTP."
X (interactive)
X (let* (newsgroups
X subject
X (case-fold-search nil)
X (server-running (nntp-server-opened)))
X (save-excursion
X ;; It is possible to post a news without reading news using
X ;; `gnus' before.
X ;; Suggested by yuki@flab.fujitsu.junet.
X (gnus-start-news-server) ;Use default NNTP server.
X ;; NNTP server must be opened before current buffer is modified.
X (save-restriction
X (goto-char (point-min))
X (search-forward (concat "\n" mail-header-separator "\n"))
X (narrow-to-region (point-min) (point))
X (setq newsgroups (mail-fetch-field "newsgroups")
X subject (mail-fetch-field "subject")))
X (widen)
X (goto-char (point-min))
X (run-hooks 'news-inews-hook)
X (goto-char (point-min))
X (search-forward (concat "\n" mail-header-separator "\n"))
X (replace-match "\n\n")
X (goto-char (point-max))
X ;; require a newline at the end for inews to append .signature to
X (or (= (preceding-char) ?\n)
X (insert ?\n))
X (message "Posting to USENET...")
X ;; Call inews.
X ;;(call-process-region (point-min) (point-max)
X ;; news-inews-program nil 0 nil
X ;; "-h") ; take all header lines!
X ;; ;"-t" subject
X ;; ;"-n" newsgroups
X ;; Post to NNTP server.
X (if (gnus-inews-article)
X (message "Posting to USENET... done")
X (ding) (message "Article's rejected: %s" (nntp-status-message)))
X (goto-char (point-min)) ;restore internal header separator
X (search-forward "\n\n")
X (replace-match (concat "\n" mail-header-separator "\n"))
X (set-buffer-modified-p nil))
X ;; If NNTP server is opened by gnus-inews, close it by myself.
X (or server-running
X (nntp-close-server))
X (and (fboundp 'bury-buffer) (bury-buffer))))
X
X(defun gnus-inews-article ()
X "NNTP inews interface."
X (let ((signature (expand-file-name "~/.signature" nil))
X (distribution nil)
X (artbuf (current-buffer))
X (tmpbuf (get-buffer-create " *GNUS-posting*")))
X (save-excursion
X (set-buffer tmpbuf)
X (buffer-flush-undo (current-buffer))
X (erase-buffer)
X (insert-buffer-substring artbuf)
X ;; Get distribution.
X (save-restriction
X (goto-char (point-min))
X (search-forward "\n\n")
X (narrow-to-region (point-min) (point))
X (setq distribution (mail-fetch-field "distribution")))
X (widen)
X ;; Change signature file by distribution.
X ;; Suggested by hyoko@flab.fujitsu.junet.
X (if (file-exists-p (concat signature "-" distribution))
X (setq signature (concat signature "-" distribution)))
X ;; Insert signature.
X (if (file-exists-p signature)
X (progn
X (goto-char (point-max))
X (insert "--\n")
X (insert-file-contents signature)))
X ;; Prepare article headers.
X (save-restriction
X (goto-char (point-min))
X (search-forward "\n\n")
X (narrow-to-region (point-min) (point))
X (gnus-inews-insert-headers))
X (widen)
X ;; Save author copy of posted article. The article must be
X ;; copied before being posted because `nntp-request-post'
X ;; modifies the buffer.
X (cond ((and (stringp gnus-author-copy-file)
X (string-match "^[ \t]*|[ \t]*\\(.*\\)[ \t]*$"
X gnus-author-copy-file))
X (let ((program (substring gnus-author-copy-file
X (match-beginning 1)
X (match-end 1))))
X ;; Suggested by yuki@flab.fujitsu.junet.
X ;; Pipe out article to named program.
X (call-process-region (point-min) (point-max) shell-file-name
X nil nil nil "-c" program)
X ))
X ((stringp gnus-author-copy-file)
X ;; Suggested by hyoko@flab.fujitsu.junet.
X ;; Save article in Unix mail format.
X ;; This is much convenient for Emacs user.
X (rmail-output gnus-author-copy-file)))
X ;; Run final hooks.
X (run-hooks 'gnus-Inews-article-hook)
X ;; Post an article to NNTP server.
X ;; Return NIL if post failed.
X (prog1
X (nntp-request-post)
X (kill-buffer (current-buffer)))
X )))
X
X(defun gnus-inews-cancel ()
X "Cancel an article you posted."
X (let ((from nil)
X (newsgroups nil)
X (message-id nil)
X (distribution nil))
X (save-excursion
X ;; Get header info. from original article.
X (save-restriction
X (gnus-Article-show-all-headers)
X (goto-char (point-min))
X (search-forward "\n\n")
X (narrow-to-region (point-min) (point))
X (setq from (mail-fetch-field "from"))
X (setq newsgroups (mail-fetch-field "newsgroups"))
X (setq message-id (mail-fetch-field "message-id"))
X (setq distribution (mail-fetch-field "distribution")))
X ;; Verify the article is absolutely user's by comparing user id
X ;; with value of its From: field.
X (if (not (string-equal (downcase (mail-strip-quoted-names from))
X (downcase (gnus-inews-user-name))))
X (progn
X (ding) (message "This article is not yours"))
X ;; Make control article.
X (set-buffer (get-buffer-create " *GNUS-posting*"))
X (buffer-flush-undo (current-buffer))
X (erase-buffer)
X (insert "Newsgroups: " newsgroups "\n"
X "Subject: cancel " message-id "\n"
X "Control: cancel " message-id "\n"
X ;; We should not use the value of
X ;; `gnus-default-distribution' as default value,
X ;; because distribution must be as same as original
X ;; article.
X "Distribution: " (or distribution "") "\n"
X )
X ;; Prepare article headers.
X (gnus-inews-insert-headers)
X (goto-char (point-max))
X ;; Insert empty line.
X (insert "\n")
X ;; Post control article to NNTP server.
X (message "Canceling your article...")
X (if (nntp-request-post)
X (message "Canceling your article... done")
X (ding) (message "Failed to cancel your article"))
X (kill-buffer (current-buffer))
X ))
X ))
X
X(defun gnus-inews-insert-headers ()
X "Prepare article headers.
XPath:, From:, Subject:, Message-ID: and Distribution: are generated.
XOrganization: is optional."
X (save-excursion
X (let* ((domain-name (gnus-inews-domain-name))
X ;; Message-ID should not contain slash `/' and should be
X ;; terminated by a number. I don't know the reason why it
X ;; is so. (UMERIN@flab)
X (id (gnus-inews-message-id gnus-user-login-name))
X (organization (or (getenv "ORGANIZATION") gnus-your-organization)))
X ;; Insert from top of headers.
X (goto-char (point-min))
X (insert "Path: " gnus-nntp-server "!" gnus-user-login-name "\n"
X "From: " (gnus-inews-user-name)
X (if (or (string-equal gnus-user-full-name "")
X (string-equal gnus-user-full-name "&"))
X "\n"
X (concat " (" gnus-user-full-name ")\n"))
X )
X ;; If there is no subject, make Subject: field.
X (or (mail-fetch-field "subject")
X (insert "Subject: \n"))
X ;; Insert random headers.
X (insert "Message-ID: <" id "@" domain-name ">\n")
X ;; Insert buggy date (time zone is ignored), but I don't worry
X ;; about it since inews will rewrite it.
X (insert "Date: " (gnus-inews-date) "\n")
X (if organization
X (insert "Organization: " organization "\n"))
X (or (mail-fetch-field "distribution")
X (insert "Distribution: \n"))
X )))
X
X(defun gnus-inews-user-name ()
X "Return user's network address."
X (concat gnus-user-login-name
X "@"
X (gnus-inews-domain-name gnus-use-generic-from)))
X
X(defun gnus-inews-domain-name (&optional genericfrom)
X "Return user's domain name.
XIf optional argument GENERICFROM is non-nil, host name never be inserted."
X ;; If system-name returns full internet name, domain name should be
X ;; got from it.
X (if (string-match "\\." (system-name))
X (setq gnus-your-domain (substring (system-name) (match-end 0))))
X (let ((domain (or (getenv "DOMAINNAME") gnus-your-domain)))
X (if (null domain)
X (progn
X (setq domain (read-string "Domain name (no host): "))
X (setq gnus-your-domain domain)))
X (if (string-equal "." (substring domain 0 1))
X (setq domain (substring domain 1)))
X (if genericfrom
X ;; Support GENERICFROM as same as standard Bnews system.
X ;; Suggested by ohm@kaba.junet.
X (if (string-match "^[^.]+\\.\\(.+\\)" (system-name))
X ;; Remove host name from full internet name.
X (substring (system-name) (match-beginning 1))
X domain
X )
X (if (or (string-equal domain "")
X (string-match "\\." (system-name))) ;Full internet name.
X ;; Assume function `system-name' returns full internet name.
X ;; Suggested by Mike DeCorte <mrd@sun.soe.clarkson.edu>.
X (system-name)
X (concat (system-name)
X ;; Host name and domain name must be separated by
X ;; one period `.'.
X "." domain
X )
X ))
X ))
X
X(defun gnus-inews-message-id (name)
X "Generate unique message-ID for NAMEd user."
X (let ((date (current-time-string)))
X (if (string-match "^[^ ]+ \\([^ ]+\\)[ ]+\\([0-9]+\\) \\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\) [0-9][0-9]\\([0-9][0-9]\\)"
X date)
X (concat (upcase name) "."
X (substring date (match-beginning 6) (match-end 6)) ;Year
X (substring date (match-beginning 1) (match-end 1)) ;Month
X (substring date (match-beginning 2) (match-end 2)) ;Day
X (substring date (match-beginning 3) (match-end 3)) ;Hour
X (substring date (match-beginning 4) (match-end 4)) ;Minute
X (substring date (match-beginning 5) (match-end 5)) ;Second
X )
X (error "Cannot understand current-time-string: %s." date))
X ))
X
X(defun gnus-inews-date ()
X "Bnews date format string of today. Time zone is ignored."
X (let ((date (current-time-string)))
X (if (string-match "^[^ ]+ \\([^ ]+\\)[ ]+\\([0-9]+\\) \\([0-9:]+\\) [0-9][0-9]\\([0-9][0-9]\\)"
X date)
X (concat (substring date (match-beginning 2) (match-end 2)) ;Day
X " "
X (substring date (match-beginning 1) (match-end 1)) ;Month
X " "
X (substring date (match-beginning 4) (match-end 4)) ;Year
X " "
X (substring date (match-beginning 3) (match-end 3))) ;Time
X (error "Cannot understand current-time-string: %s." date))
X ))
X
X
X;;Local variables:
X;;eval: (put 'eval-in-buffer-window 'lisp-indent-hook 1)
X;;end:
SHAR_EOF
chmod 0644 gnus.el || echo "restore of gnus.el fails"
set `wc -c gnus.el`;Sum=$1
if test "$Sum" != "178299"
then echo original size 178299, current size $Sum;fi
sed 's/^X//' << 'SHAR_EOF' > mhspool.el &&
X;;; MH folder patches to NNTP package for GNU Emacs
X;; Copyright (C) 1988 Fujitsu Laboratoris LTD.
X;; Copyright (C) 1988 Masanobu UMEDA (umerin@flab.flab.Fujitsu.JUNET)
X;; $Header: mhspool.el,v 1.2 88/11/11 14:57:53 umerin Exp $
X
X;; This file is part of GNU Emacs.
X
X;; GNU Emacs is distributed in the hope that it will be useful,
X;; but WITHOUT ANY WARRANTY. No author or distributor
X;; accepts responsibility to anyone for the consequences of using it
X;; or for whether it serves any particular purpose or works at all,
X;; unless he says so in writing. Refer to the GNU Emacs General Public
X;; License for full details.
X
X;; Everyone is granted permission to copy, modify and redistribute
X;; GNU Emacs, but only under the conditions described in the
X;; GNU Emacs General Public License. A copy of this license is
X;; supposed to have been given to you along with GNU Emacs so you
X;; can know your rights and responsibilities. It should be in a
X;; file named COPYING. Among other things, the copyright notice
X;; and this notice must be preserved on all copies.
X
X(provide 'mhspool)
X(require 'nntp)
X(require 'nnspool)
X
X;; This package is a patch to nnspool.el package of GNUS, a NNTP-based
X;; network news reader. This package enables you to read mails or
X;; articles in MH folder, or articles saved in article save directory
X;; by GNUS. In any case file names must consist of numbers only.
X
X;; Before using the package, you have to make a special .newsrc file
X;; according to the directory which you want to read. For example, if
X;; you want to read mails under the directory named ~/Mail, the file
X;; must be named as `.newsrc-:Mail'. (There is no way to specify
X;; hierarchical directory now.) In this case the name of NNTP server
X;; passed to GNUS must be `:Mail'.
X
X;; If you'd like to read news normally, you'd better exit Emacs once.
X;; I hope you enjoy GNUS.
X
X(defconst mhspool-version "MHSPOOL 1.2"
X "Version numbers of this version of MHSPOOL.")
X
X;;;
X;;; Replacement of NNTP Raw Interface.
X;;;
X
X(defun nntp-open-server (host &optional service)
X "Open news server on HOST.
XIf HOST is nil, use value of environment variable `NNTPSERVER'.
XIf optional argument SERVICE is non-nil, open by the service name."
X (let ((host (or host (getenv "NNTPSERVER")))
X (status nil))
X ;; Get directory name from HOST name.
X (if (string-match ":\\(.+\\)$" host)
X (progn
X (setq nnspool-spool-directory
X (file-name-as-directory
X (expand-file-name
X (substring host (match-beginning 1) (match-end 1))
X (expand-file-name "~/" nil))))
X (setq host (system-name)))
X (setq nnspool-spool-directory nil))
X (setq nntp-status-message-string "")
X (cond ((and (stringp host)
X (stringp nnspool-spool-directory)
X (file-directory-p nnspool-spool-directory)
X (string-equal host (system-name)))
X (setq status (nntp-open-server-internal host service)))
X ((string-equal host (system-name))
X (setq nntp-status-message-string
X (format "%s has no news spool. Goodbye." host)))
X ((null host)
X (setq nntp-status-message-string "NNTP server is not specified."))
X (t
X (setq nntp-status-message-string
X (format
X "Load `nntp' again if you'd like to talk to %s." host)))
X )
X status
X ))
X
X(defun nntp-request-list ()
X "List valid newsgoups."
X (save-excursion
X (let* ((newsgroup nil)
X (articles nil)
X (directory (file-name-as-directory
X (expand-file-name nnspool-spool-directory nil)))
X (folder-regexp (concat "^" (regexp-quote directory) "\\(.+\\):$"))
X (buffer (get-buffer-create " *GNUS MH list*")))
X (set-buffer nntp-server-buffer)
X (erase-buffer)
X (set-buffer buffer)
X (erase-buffer)
X (call-process "ls" nil t nil "-R" directory)
X (goto-char (point-min))
X (while (re-search-forward folder-regexp nil t)
X (setq newsgroup
X (mhspool-reverse-article-pathname
X (buffer-substring (match-beginning 1) (match-end 1))))
X (setq articles nil)
X (forward-line 1) ;(beginning-of-line)
X (while (looking-at "^[0-9]+$")
X (setq articles
X (cons (string-to-int
X (buffer-substring (match-beginning 0) (match-end 0)))
X articles))
X (forward-line 1))
X (if articles
X (princ (format "%s %d %d n\n" newsgroup
X (apply (function max) articles)
X (apply (function min) articles))
X nntp-server-buffer))
X )
X (kill-buffer buffer)
X (set-buffer nntp-server-buffer)
X (buffer-size)
X )))
X
X(defun nntp-request-post ()
X "Post a new news in current buffer."
X (setq nntp-status-message-string "MHSPOOL: What do you mean post?")
X nil
X )
X
X
X;;;
X;;; Replacement of Low-Level Interface to NNTP Server.
X;;;
X
X(defun nnspool-find-article-by-message-id (id)
X "Return full pathname of an artilce identified by message-ID."
X nil
X )
X
X(defun nnspool-find-file (file)
X "Insert FILE in server buffer safely."
X (set-buffer nntp-server-buffer)
X (erase-buffer)
X (condition-case ()
X (progn
X (insert-file-contents file)
X (goto-char (point-min))
X ;; If there is no body, `^L' appears at end of file. Special
X ;; hack for MH folder.
X (and (search-forward "\n\n" nil t)
X (string-equal (buffer-substring (point) (point-max)) "\^L")
X (delete-char 1))
X t
X )
X (file-error nil)
X ))
X
X(defun mhspool-reverse-article-pathname (pathname)
X "Make group name from PATHNAME."
X (let ((pathname (substring pathname 0)) ;Copy string.
X (len (length pathname))
X (idx 0))
X ;; Replace all occurence of `/' with `.'.
X (while (< idx len)
X (if (= (aref pathname idx) ?/)
X (aset pathname idx ?.))
X (setq idx (1+ idx)))
X pathname
X ))
SHAR_EOF
chmod 0644 mhspool.el || echo "restore of mhspool.el fails"
set `wc -c mhspool.el`;Sum=$1
if test "$Sum" != "5566"
then echo original size 5566, current size $Sum;fi
sed 's/^X//' << 'SHAR_EOF' > nnspool.el &&
X;;; Spool patches to NNTP package for GNU Emacs
X;; Copyright (C) 1988 Fujitsu Laboratoris LTD.
X;; Copyright (C) 1988 Masanobu UMEDA (umerin@flab.flab.Fujitsu.JUNET)
X;; $Header: nnspool.el,v 1.7 88/11/11 14:57:43 umerin Exp $
X
X;; This file is part of GNU Emacs.
X
X;; GNU Emacs is distributed in the hope that it will be useful,
X;; but WITHOUT ANY WARRANTY. No author or distributor
X;; accepts responsibility to anyone for the consequences of using it
X;; or for whether it serves any particular purpose or works at all,
X;; unless he says so in writing. Refer to the GNU Emacs General Public
X;; License for full details.
X
X;; Everyone is granted permission to copy, modify and redistribute
X;; GNU Emacs, but only under the conditions described in the
X;; GNU Emacs General Public License. A copy of this license is
X;; supposed to have been given to you along with GNU Emacs so you
X;; can know your rights and responsibilities. It should be in a
X;; file named COPYING. Among other things, the copyright notice
X;; and this notice must be preserved on all copies.
X
X(provide 'nnspool)
X(require 'nntp)
X
X(defconst nnspool-version "NNSPOOL 1.7"
X "Version numbers of this version of NNSPOOL.")
X
X(defvar nnspool-inews-program news-inews-program
X "Program to post news.")
X
X(defvar nnspool-spool-directory news-path
X "Local news spool directory.")
X
X(defvar nnspool-active-file "/usr/lib/news/active"
X "Local news active file.")
X
X(defvar nnspool-history-file "/usr/lib/news/history"
X "Local news history file.")
X
X(defvar nnspool-current-directory nil
X "Current news group directory.")
X
X;;;
X;;; Replacement of Extended Command for retrieving many headers.
X;;;
X
X(defun nntp-retrieve-headers (sequence)
X "Return list of article headers specified by SEQUENCE of article id.
XThe format of list is `([NUMBER SUBJECT FROM XREF LINES DATE MESSAGE-ID] ...)'.
XReader macros for the vector are defined as `nntp-header-FIELD'.
XWriter macros for the vector are defined as `nntp-set-header-FIELD'.
XNews group must be selected before calling me."
X (save-excursion
X (set-buffer nntp-server-buffer)
X ;;(erase-buffer)
X (let ((file nil)
X (number (length sequence))
X (count 0)
X (headers nil) ;Result list.
X (article 0)
X (subject nil)
X (message-id nil)
X (from nil)
X (xref nil)
X (lines 0)
X (date nil))
X (while sequence
X ;;(nntp-send-strings-to-server "HEAD" (car sequence))
X (setq article (car sequence))
X (setq file
X (concat nnspool-current-directory (prin1-to-string article)))
X (if (and (file-exists-p file)
X (not (file-directory-p file)))
X (progn
X (erase-buffer)
X (insert-file-contents file)
X (goto-char (point-min))
X (search-forward "\n\n" nil 'move)
X (narrow-to-region (point-min) (point))
X ;; Make it possible to search `\nFIELD'.
X (goto-char (point-min))
X (insert "\n")
X ;; Extract From:
X (goto-char (point-min))
X (if (search-forward "\nFrom: " nil t)
X (setq from (buffer-substring
X (point)
X (save-excursion (end-of-line) (point))))
X (setq from "Unknown User"))
X ;; Extract Subject:
X (goto-char (point-min))
X (if (search-forward "\nSubject: " nil t)
X (setq subject (buffer-substring
X (point)
X (save-excursion (end-of-line) (point))))
X (setq subject "(None)"))
X ;; Extract Message-ID:
X (goto-char (point-min))
X (if (search-forward "\nMessage-ID: " nil t)
X (setq message-id (buffer-substring
X (point)
X (save-excursion (end-of-line) (point))))
X (setq message-id nil))
X ;; Extract Date:
X (goto-char (point-min))
X (if (search-forward "\nDate: " nil t)
X (setq date (buffer-substring
X (point)
X (save-excursion (end-of-line) (point))))
X (setq date nil))
X ;; Extract Lines:
X (goto-char (point-min))
X (if (search-forward "\nLines: " nil t)
X (setq lines (string-to-int
X (buffer-substring
X (point)
X (save-excursion (end-of-line) (point)))))
X (setq lines 0))
X ;; Extract Xref:
X (goto-char (point-min))
X (if (search-forward "\nXref: " nil t)
X (setq xref (buffer-substring
X (point)
X (save-excursion (end-of-line) (point))))
X (setq xref nil))
X (setq headers
X (cons (vector article subject from
X xref lines date message-id)
X headers))
X ))
X (setq sequence (cdr sequence))
X (setq count (1+ count))
X (if (and (> number 100)
X (zerop (% count 20)))
X (message "NNSPOOL: %d%% of headers received."
X (/ (* count 100) number)))
X )
X (if (> number 100)
X (message "NNSPOOL: 100%% of headers received."))
X (nreverse headers)
X )))
X
X
X;;;
X;;; Replacement of NNTP Raw Interface.
X;;;
X
X(defun nntp-open-server (host &optional service)
X "Open news server on HOST.
XIf HOST is nil, use value of environment variable `NNTPSERVER'.
XIf optional argument SERVICE is non-nil, open by the service name."
X (let ((host (or host (getenv "NNTPSERVER")))
X (status nil))
X (setq nntp-status-message-string "")
X (cond ((and (file-directory-p nnspool-spool-directory)
X (file-exists-p nnspool-active-file)
X (string-equal host (system-name)))
X (setq status (nntp-open-server-internal host service)))
X ((string-equal host (system-name))
X (setq nntp-status-message-string
X (format "%s has no news spool. Goodbye." host)))
X ((null host)
X (setq nntp-status-message-string "NNTP server is not specified."))
X (t
X (setq nntp-status-message-string
X (format
X "Load `nntp' again if you'd like to talk to %s." host)))
X )
X status
X ))
X
X(defun nntp-close-server ()
X "Close news server."
X (nntp-close-server-internal))
X
X(fset 'nntp-request-quit (symbol-function 'nntp-close-server))
X
X(defun nntp-server-opened ()
X "Return server process status, T or NIL.
XIf the stream is opened, return T, otherwise return NIL."
X (and nntp-server-buffer
X (get-buffer nntp-server-buffer)))
X
X(defun nntp-status-message ()
X "Return server status response as string."
X nntp-status-message-string
X )
X
X(defun nntp-request-article (id)
X "Select article by message ID (or number)."
X (let ((file (if (stringp id)
SHAR_EOF
echo "End of part 4, continue with part 5"
echo "5" > s2_seq_.tmp
exit 0
--
Masanobu UMEDA
umerin@flab.flab.Fujitsu.JUNET
umerin%flab.flab.Fujitsu.JUNET@uunet.uu.NETumerin@flab.flab.fujitsu.JUNET (Masanobu UMEDA) (11/11/88)
---- Cut Here and unpack ----
#!/bin/sh
# this is part 5 of a multipart archive
# do not concatenate these parts, unpack them in order with /bin/sh
# file nnspool.el continued
#
CurArch=5
if test ! -r s2_seq_.tmp
then echo "Please unpack part 1 first!"
exit 1; fi
( read Scheck
if test "$Scheck" != $CurArch
then echo "Please unpack part $Scheck next!"
exit 1;
else exit 0; fi
) < s2_seq_.tmp || exit 1
sed 's/^X//' << 'SHAR_EOF' >> nnspool.el
X (nnspool-find-article-by-message-id id)
X (concat nnspool-current-directory (prin1-to-string id)))))
X (if (and (stringp file)
X (file-exists-p file)
X (not (file-directory-p file)))
X (save-excursion
X (nnspool-find-file file)))
X ))
X
X(defun nntp-request-body (id)
X "Select article body by message ID (or number)."
X (if (nntp-request-article id)
X (save-excursion
X (set-buffer nntp-server-buffer)
X (goto-char (point-min))
X (if (search-forward "\n\n" nil t)
X (delete-region (point-min) (point)))
X t
X )
X ))
X
X(defun nntp-request-head (id)
X "Select article head by message ID (or number)."
X (if (nntp-request-article id)
X (save-excursion
X (set-buffer nntp-server-buffer)
X (goto-char (point-min))
X (if (search-forward "\n\n" nil t)
X (delete-region (1- (point)) (point-max)))
X t
X )
X ))
X
X(defun nntp-request-stat (id)
X "Select article by message ID (or number)."
X (error "NNSPOOL: STAT is not implemented."))
X
X(defun nntp-request-group (group)
X "Select news GROUP."
X (let ((pathname (nnspool-article-pathname group)))
X (if (file-directory-p pathname)
X (setq nnspool-current-directory pathname))
X ))
X
X(defun nntp-request-list ()
X "List valid newsgoups."
X (save-excursion
X (nnspool-find-file nnspool-active-file)))
X
X(defun nntp-request-last ()
X "Set current article pointer to the previous article
Xin the current news group."
X (error "NNSPOOL: LAST is not implemented."))
X
X(defun nntp-request-next ()
X "Advance current article pointer."
X (error "NNSPOOL: NEXT is not implemented."))
X
X(defun nntp-request-post ()
X "Post a new news in current buffer."
X (save-excursion
X ;; We have to work in the server buffer because of NEmacs hack.
X (copy-to-buffer nntp-server-buffer (point-min) (point-max))
X (set-buffer nntp-server-buffer)
X (call-process-region (point-min) (point-max)
X nnspool-inews-program 'delete t nil
X "-h")
X (prog1
X (or (zerop (buffer-size))
X ;; If inews returns strings, it must be error message
X ;; unless SPOOLNEWS is defined.
X ;; This condition is very weak, but there is no good rule
X ;; identifying errors when SPOOLNEWS is defined.
X ;; Suggested by ohm@kaba.junet.
X (string-match "spooled"
X (buffer-substring (point-min) (point-max))))
X ;; Make status message by unfolding lines.
X (subst-char-in-region (point-min) (point-max) ?\n ?\\ 'noundo)
X (setq nntp-status-message-string
X (buffer-substring (point-min) (point-max)))
X (erase-buffer))
X ))
X
X
X;;;
X;;; Replacement of Low-Level Interface to NNTP Server.
X;;;
X
X(defun nntp-open-server-internal (host &optional service)
X "Open connection to news server on HOST by SERVICE (default is nntp)."
X (save-excursion
X (if (not (string-equal host (system-name)))
X (error "NNSPOOL: Load `nntp' again if you'd like to talk to %s." host))
X ;; Initialize communication buffer.
X (setq nntp-server-buffer (get-buffer-create " *nntpd*"))
X (set-buffer nntp-server-buffer)
X (kill-all-local-variables)
X (buffer-flush-undo (current-buffer))
X (erase-buffer)
X (setq nntp-server-process nil)
X (setq nntp-server-name host)
X ;; It is possible to change kanji-fileio-code in this hook.
X (run-hooks 'nntp-server-hook)
X t
X ))
X
X(defun nntp-close-server-internal ()
X "Close connection to news server."
X (if (get-file-buffer nnspool-history-file)
X (kill-buffer (get-file-buffer nnspool-history-file)))
X (if nntp-server-buffer
X (kill-buffer nntp-server-buffer))
X (setq nntp-server-buffer nil)
X (setq nntp-server-process nil))
X
X(defun nnspool-find-article-by-message-id (id)
X "Return full pathname of an artilce identified by message-ID."
X (save-excursion
X (let ((buffer (get-file-buffer nnspool-history-file)))
X (if buffer
X (set-buffer buffer)
X ;; Finding history file may take lots of time.
X (message "Reading history file...")
X (set-buffer (find-file-noselect nnspool-history-file))
X (message "Reading history file... done")))
X ;; Search from end of the file. I think this is much faster than
X ;; do from the beginning of the file.
X (goto-char (point-max))
X (if (re-search-backward
X (concat "^" (regexp-quote id)
X "[ \t].*[ \t]\\([^ \t/]+\\)/\\([0-9]+\\)[ \t]*$") nil t)
X (let ((group (buffer-substring (match-beginning 1) (match-end 1)))
X (number (buffer-substring (match-beginning 2) (match-end 2))))
X (concat (nnspool-article-pathname group) number))
X )))
X
X(defun nnspool-find-file (file)
X "Insert FILE in server buffer safely."
X (set-buffer nntp-server-buffer)
X (erase-buffer)
X (condition-case ()
X (progn (insert-file-contents file) t)
X (file-error nil)
X ))
X
X(defun nnspool-article-pathname (group)
X "Make pathname to news GROUP."
X (let ((group (substring group 0)) ;Copy string.
X (len (length group))
X (idx 0))
X ;; Replace all occurence of `.' with `/'.
X (while (< idx len)
X (if (= (aref group idx) ?.)
X (aset group idx ?/))
X (setq idx (1+ idx)))
X (concat (file-name-as-directory nnspool-spool-directory) group "/")
X ))
SHAR_EOF
chmod 0644 nnspool.el || echo "restore of nnspool.el fails"
set `wc -c nnspool.el`;Sum=$1
if test "$Sum" != "11173"
then echo original size 11173, current size $Sum;fi
sed 's/^X//' << 'SHAR_EOF' > nntp.el &&
X;;; NNTP (RFC977) Interface for GNU Emacs
X;; Copyright (C) 1987, 1988 Fujitsu Laboratoris LTD.
X;; Copyright (C) 1987, 1988 Masanobu UMEDA (umerin@flab.flab.Fujitsu.JUNET)
X;; $Header: nntp.el,v 3.7 88/11/11 14:56:50 umerin Exp $
X
X;; This file is part of GNU Emacs.
X
X;; GNU Emacs is distributed in the hope that it will be useful,
X;; but WITHOUT ANY WARRANTY. No author or distributor
X;; accepts responsibility to anyone for the consequences of using it
X;; or for whether it serves any particular purpose or works at all,
X;; unless he says so in writing. Refer to the GNU Emacs General Public
X;; License for full details.
X
X;; Everyone is granted permission to copy, modify and redistribute
X;; GNU Emacs, but only under the conditions described in the
X;; GNU Emacs General Public License. A copy of this license is
X;; supposed to have been given to you along with GNU Emacs so you
X;; can know your rights and responsibilities. It should be in a
X;; file named COPYING. Among other things, the copyright notice
X;; and this notice must be preserved on all copies.
X
X;; This implementation is tested on both 1.2a and 1.5 version of NNTP
X;; package.
X
X;; Trouble shooting of NNTP
X;;
X;; (1) Select routine may signal an error or fall into infinite loop
X;; while waiting for server response. In this case, you'd better not
X;; use byte-compiled code but original source. If you still have a
X;; trouble with it, set variable `nntp-buggy-select' to T.
X;;
X;; (2) Emacs may hang while retrieving headers since too many requests
X;; have been sent to news server without reading their replies. In
X;; this case, reduce number of requests sent to the server at once by
X;; setting smaller value to `nntp-maximum-request'.
X;;
X;; (3) If TCP/IP stream (open-network-stream) is not supported by
X;; emacs, compile and install `tcp.el' and `tcp.c' which is an
X;; emulation program of the stream. If you modified `tcp.c' for your
X;; system, please send me the diffs. I'll include it in the future
X;; release.
X
X(provide 'nntp)
X
X(defvar nntp-server-hook nil
X "*Hooks for NNTP news server.
XIf Kanji code of news server is different from local kanji code, you
Xhave to put the following code in your .emacs file:
X
X(setq nntp-server-hook
X '(lambda ()
X ;; Server's Kanji code is EUC (NEmacs hack).
X (make-local-variable 'kanji-fileio-code)
X (setq kanji-fileio-code 0)))
X
XIf you'd like to change something depending on server in this hook,
Xuse variable `nntp-server-name'.")
X
X(defvar nntp-buggy-select (memq system-type '(usg-unix-v fujitsu-uts))
X "*T if select routine is buggy.
XIf select routine signals error or fall into infinite loop while
Xwaiting for server response, the value must be set to T.
XIn case of Fujitsu UTS it is set to T since `accept-process-output'
Xdoesn't work properly.")
X
X(defvar nntp-maximum-request 400
X "*Maximum number of requests sent to news server at once.
XIf Emacs hangs while retrieving headers, set smaller value than the default.")
X
X
X(defconst nntp-version "NNTP 3.7"
X "Version numbers of this version of NNTP.")
X
X(defvar nntp-server-name nil
X "Host name of NNTP server.")
X
X(defvar nntp-server-buffer nil
X "Buffer associated with NNTP news server process.")
X
X(defvar nntp-server-process nil
X "NNTP news server process.
XYou'd better not use this variable in NNTP front-end program but
Xinstead use `nntp-server-buffer'.")
X
X(defvar nntp-status-message-string nil
X "Save server response message.
XYou'd better not use this variable in NNTP front-end program but
Xinstead call function `nntp-status-message' to get status message.")
X
X;;;
X;;; Extended Command for retrieving many headers.
X;;;
X;; Retrieving lots of headers by sending command asynchronously.
X;; Access functions to headers are defined as macro.
X
X(defmacro nntp-header-number (header)
X "Return article number in HEADER."
X (` (aref (, header) 0)))
X
X(defmacro nntp-set-header-number (header number)
X "Set article number of HEADER to NUMBER."
X (` (aset (, header) 0 (, number))))
X
X(defmacro nntp-header-subject (header)
X "Return subject string in HEADER."
X (` (aref (, header) 1)))
X
X(defmacro nntp-set-header-subject (header subject)
X "Set article subject of HEADER to SUBJECT."
X (` (aset (, header) 1 (, subject))))
X
X(defmacro nntp-header-from (header)
X "Return author string in HEADER."
X (` (aref (, header) 2)))
X
X(defmacro nntp-set-header-from (header from)
X "Set article author of HEADER to FROM."
X (` (aset (, header) 2 (, from))))
X
X(defmacro nntp-header-xref (header)
X "Return xref string in HEADER."
X (` (aref (, header) 3)))
X
X(defmacro nntp-set-header-xref (header xref)
X "Set article xref of HEADER to xref."
X (` (aset (, header) 3 (, xref))))
X
X(defmacro nntp-header-lines (header)
X "Return lines in HEADER."
X (` (aref (, header) 4)))
X
X(defmacro nntp-set-header-lines (header lines)
X "Set article lines of HEADER to LINES."
X (` (aset (, header) 4 (, lines))))
X
X(defmacro nntp-header-date (header)
X "Return date in HEADER."
X (` (aref (, header) 5)))
X
X(defmacro nntp-set-header-date (header date)
X "Set article date of HEADER to DATE."
X (` (aset (, header) 5 (, date))))
X
X(defmacro nntp-header-id (header)
X "Return date in HEADER."
X (` (aref (, header) 6)))
X
X(defmacro nntp-set-header-id (header id)
X "Set article ID of HEADER to ID."
X (` (aset (, header) 6 (, id))))
X
X(defun nntp-retrieve-headers (sequence)
X "Return list of article headers specified by SEQUENCE of article id.
XThe format of list is `([NUMBER SUBJECT FROM XREF LINES DATE MESSAGE-ID] ...)'.
XReader macros for the vector are defined as `nntp-header-FIELD'.
XWriter macros for the vector are defined as `nntp-set-header-FIELD'.
XNews group must be selected before calling me."
X (save-excursion
X (set-buffer nntp-server-buffer)
X (erase-buffer)
X (let ((number (length sequence))
X (last-point (point-min))
X (received 0)
X (count 0)
X (headers nil) ;Result list.
X (article 0)
X (subject nil)
X (message-id)
X (from nil)
X (xref nil)
X (lines 0)
X (date nil))
X ;; Send HEAD command.
X (while sequence
X (nntp-send-strings-to-server "HEAD" (car sequence))
X (setq sequence (cdr sequence))
X (setq count (1+ count))
X ;; Every 400 header requests we have to read stream in order
X ;; to avoid deadlock.
X (if (or (null sequence) ;All requests have been sent.
X (zerop (% count nntp-maximum-request)))
X (progn
X (accept-process-output)
X (while (progn
X (goto-char last-point)
X ;; Count replies.
X (while (re-search-forward "^[0-9]" nil t)
X (setq received (1+ received)))
X (setq last-point (point))
X (< received count))
X ;; If number of headers is greater than 100, give
X ;; informative messages.
X (if (and (> number 100)
X (zerop (% received 20)))
X (message "NNTP: %d%% of headers received."
X (/ (* received 100) number)))
X (nntp-accept-response))
X ))
X )
X ;; Wait for text of last command.
X (goto-char (point-max))
X (re-search-backward "^[0-9]")
X (if (looking-at "^[23]")
X (while (progn
X (goto-char (- (point-max) 3))
X (not (looking-at "^\\.\r$")))
X (nntp-accept-response)
X ))
X (if (> number 100)
X (message "NNTP: 100%% of headers received."))
X ;; Now all of replies are received.
X ;; First, delete unnecessary lines.
X (goto-char (point-min))
X (delete-non-matching-lines
X "^Subject:\\|^Xref:\\|^From:\\|^Lines:\\|^Date:\\|^[23]")
X (if (> number 100)
X (message "NNTP: Parsing headers..."))
X ;; Then examines replies.
X (while (not (eobp))
X (cond ((looking-at "^[23].*[ \t]+\\([0-9]+\\)[ \t]+\\(<.+>\\)")
X (setq article
X (string-to-int
X (buffer-substring (match-beginning 1) (match-end 1))))
X (setq message-id
X (buffer-substring (match-beginning 2) (match-end 2)))
X (forward-line 1)
X ;; Set default value.
X (setq subject nil)
X (setq xref nil)
X (setq from nil)
X (setq lines 0)
X (setq date nil)
X ;; It is better to extract From:, Subject:, Date:,
X ;; Lines: and Xref: field values in *THIS* order.
X ;; Forward-line each time after getting expected value
X ;; in order to reduce count of string matching.
X (while (looking-at "^[^23]")
X (if (looking-at "^From:[ \t]\\(.*\\)\r$")
X (progn
X (setq from (buffer-substring (match-beginning 1)
X (match-end 1)))
X (forward-line 1)))
X (if (looking-at "^Subject:[ \t]\\(.*\\)\r$")
X (progn
X (setq subject (buffer-substring (match-beginning 1)
X (match-end 1)))
X (forward-line 1)))
X (if (looking-at "^Date:[ \t]\\(.*\\)\r$")
X (progn
X (setq date (buffer-substring (match-beginning 1)
X (match-end 1)))
X (forward-line 1)))
X (if (looking-at "^Lines:[ \t]\\(.*\\)\r$")
X (progn
X (setq lines (string-to-int
X (buffer-substring (match-beginning 1)
X (match-end 1))))
X (forward-line 1)))
X (if (looking-at "^Xref:[ \t]\\(.*\\)\r$")
X (progn
X (setq xref (buffer-substring (match-beginning 1)
X (match-end 1)))
X (forward-line 1)))
X )
X (if (null subject)
X (setq subject "(None)"))
X (if (null from)
X (setq from "Unknown User"))
X (setq headers
X (cons (vector article subject from
X xref lines date message-id)
X headers))
X )
X (t (forward-line 1)) ;Skip invalid field (ex. Subject:abc)
X ))
X (nreverse headers)
X )))
X
X
X;;;
X;;; Raw Interface to Network News Transfer Protocol (RFC977).
X;;;
X
X(defun nntp-open-server (host &optional service)
X "Open news server on HOST.
XIf HOST is nil, use value of environment variable `NNTPSERVER'.
XIf optional argument SERVICE is non-nil, open by the service name."
X (let ((host (or host (getenv "NNTPSERVER")))
X (status nil))
X (setq nntp-status-message-string "")
X (cond ((and host (nntp-open-server-internal host service))
X (setq status (nntp-wait-for-response "^[23].*\r$"))
X ;; Do check unexpected close of connection.
X ;; Suggested by feldmark@hanako.stars.flab.fujitsu.junet.
X (if status
X (set-process-sentinel nntp-server-process
X 'nntp-default-sentinel)
X ;; We have to close connection here, since function
X ;; `nntp-server-opened' may return incorrect status.
X (nntp-close-server-internal)
X ))
X ((null host)
X (setq nntp-status-message-string "NNTP server is not specified."))
X )
X status
X ))
X
X(defun nntp-close-server ()
X "Close news server."
X (unwind-protect
X (progn
X ;; Un-set default sentinel function before closing connection.
X (and nntp-server-process
X (eq 'nntp-default-sentinel
X (process-sentinel nntp-server-process))
X (set-process-sentinel nntp-server-process nil))
X ;; We cannot send QUIT command unless the process is running.
X (if (nntp-server-opened)
X (nntp-send-command nil "QUIT"))
X )
X (nntp-close-server-internal)
X ))
X
X(fset 'nntp-request-quit (symbol-function 'nntp-close-server))
X
X(defun nntp-server-opened ()
X "Return server process status, T or NIL.
XIf the stream is opened, return T, otherwise return NIL."
X (and nntp-server-process
X (memq (process-status nntp-server-process) '(open run))))
X
X(defun nntp-status-message ()
X "Return server status response as string."
X (if (and nntp-status-message-string
X ;; NNN MESSAGE
X (string-match "[0-9][0-9][0-9][ \t]+\\([^\r]*\\).*$"
X nntp-status-message-string))
X (substring nntp-status-message-string (match-beginning 1) (match-end 1))
X ;; Empty message if nothing.
X ""
X ))
X
X(defun nntp-request-article (id)
X "Select article by message ID (or number)."
X (prog1
X (nntp-send-command "^\\.\r$" "ARTICLE" id)
X (nntp-decode-text)
X ))
X
X(defun nntp-request-body (id)
X "Select article body by message ID (or number)."
X (prog1
X (nntp-send-command "^\\.\r$" "BODY" id)
X (nntp-decode-text)
X ))
X
X(defun nntp-request-head (id)
X "Select article head by message ID (or number)."
X (prog1
X (nntp-send-command "^\\.\r$" "HEAD" id)
X (nntp-decode-text)
X ))
X
X(defun nntp-request-stat (id)
X "Select article by message ID (or number)."
X (nntp-send-command "^[23].*\r$" "STAT" id))
X
X(defun nntp-request-group (group)
X "Select news GROUP."
X ;; 1.2a NNTP's group command is buggy. "^M" (\r) is not appended to
X ;; end of the status message.
X (nntp-send-command "^[23].*$" "GROUP" group))
X
X(defun nntp-request-list ()
X "List valid newsgoups."
X (prog1
X (nntp-send-command "^\\.\r$" "LIST")
X (nntp-decode-text)
X ))
X
X(defun nntp-request-last ()
X "Set current article pointer to the previous article
Xin the current news group."
X (nntp-send-command "^[23].*\r$" "LAST"))
X
X(defun nntp-request-next ()
X "Advance current article pointer."
X (nntp-send-command "^[23].*\r$" "NEXT"))
X
X(defun nntp-request-post ()
X "Post a new news in current buffer."
X (if (nntp-send-command "^[23].*\r$" "POST")
X (progn
X (nntp-encode-text)
X (nntp-send-region-to-server (point-min) (point-max))
X ;; 1.2a NNTP's post command is buggy. "^M" (\r) is not
X ;; appended to end of the status message.
X (nntp-wait-for-response "^[23].*$")
X )))
X
X(defun nntp-default-sentinel (proc status)
X "Default sentinel function for NNTP server process."
X (if (and nntp-server-process
X (not (nntp-server-opened)))
X (error "NNTP: Connection closed.")
X ))
X
X;; Encoding and decoding of NNTP text.
X
X(defun nntp-decode-text ()
X "Decode text transmitted by NNTP.
X0. Delete status line.
X1. Delete `^M' at end of line.
X2. Delete `.' at end of buffer (end of text mark).
X3. Delete `.' at beginning of line."
X (save-excursion
X (set-buffer nntp-server-buffer)
X ;; Insert newline at end of buffer.
X (goto-char (point-max))
X (if (not (bolp))
X (insert "\n"))
X ;; Delete status line.
X (goto-char (point-min))
X (kill-line 1)
X ;; Delete `^M' at end of line.
X ;; (replace-regexp "\r$" "")
X (while (not (eobp))
X (end-of-line)
X (if (= (preceding-char) ?\r)
X (delete-char -1))
X (forward-line 1)
X )
X ;; Delete `.' at end of buffer (end of text mark).
X (goto-char (point-max))
X (forward-line -1) ;(beginning-of-line)
X (if (looking-at "^\\.$")
X (kill-line 1))
X ;; Replace `..' at beginning of line with `.'.
X (goto-char (point-min))
X ;; (replace-regexp "^\\.\\." ".")
X (while (search-forward "\n.." nil t)
X (delete-char -1))
X ))
X
X(defun nntp-encode-text ()
X "Encode text in current buffer for NNTP transmission.
X1. Insert `.' at beginning of line.
X2. Insert `.' at end of buffer (end of text mark)."
X (save-excursion
X ;; Insert newline at end of buffer.
X (goto-char (point-max))
X (if (not (bolp))
X (insert "\n"))
X ;; Replace `.' at beginning of line with `..'.
X (goto-char (point-min))
X ;; (replace-regexp "^\\." "..")
X (while (search-forward "\n." nil t)
X (insert "."))
X ;; Insert `.' at end of buffer (end of text mark).
X (goto-char (point-max))
X (insert ".\n")
X ))
X
X
X;;;
X;;; Synchronous Communication with NNTP Server.
X;;;
X
X(defun nntp-send-command (response cmd &rest args)
X "Wait for server RESPONSE after sending CMD and optional ARGS to server."
X (save-excursion
X ;; Clear communication buffer.
X (set-buffer nntp-server-buffer)
X (erase-buffer)
X (apply 'nntp-send-strings-to-server cmd args)
X (if response
X (nntp-wait-for-response response)
X t)
X ))
X
X(defun nntp-wait-for-response (regexp)
X "Wait for server response which matches REGEXP."
X (save-excursion
X (let ((status t)
X (wait t))
X (set-buffer nntp-server-buffer)
X ;; Wait for status response (RFC977).
X ;; 1xx - Informative message.
X ;; 2xx - Command ok.
X ;; 3xx - Command ok so far, send the rest of it.
X ;; 4xx - Command was correct, but couldn't be performed for some
X ;; reason.
X ;; 5xx - Command unimplemented, or incorrect, or a serious
X ;; program error occurred.
X (nntp-accept-response)
X (while wait
X (goto-char (point-min))
X (cond ((looking-at "[23]")
X (setq wait nil))
X ((looking-at "[45]")
X (setq status nil)
X (setq wait nil))
X (t (nntp-accept-response))
X ))
X ;; Save status message.
X (end-of-line)
X (setq nntp-status-message-string
X (buffer-substring (point-min) (point)))
X (if status
X (progn
X (setq wait t)
X (while wait
X (goto-char (point-max))
X (forward-line -1) ;(beginning-of-line)
X ;;(message (buffer-substring
X ;; (point)
X ;; (save-excursion (end-of-line) (point))))
X (if (looking-at regexp)
X (setq wait nil)
X (message "NNTP: Reading...")
X (nntp-accept-response)
X (message "")
X ))
X ;; Successfully received server response.
X t
X ))
X )))
X
X
X;;;
X;;; Low-Level Interface to NNTP Server.
X;;;
X
X(defun nntp-send-strings-to-server (&rest strings)
X "Send list of STRINGS to news server as command and its arguments."
X (let ((cmd (car strings))
X (strings (cdr strings)))
X ;; Command and each argument must be separeted by one or more spaces.
X (while strings
X (setq cmd (concat cmd " " (car strings)))
X (setq strings (cdr strings)))
X ;; Command line must be terminated by a CR-LF.
X (process-send-string nntp-server-process (concat cmd "\n"))
X ))
X
X(defun nntp-send-region-to-server (begin end)
X "Send current buffer region (from BEGIN to END) to news server."
X (save-excursion
X ;; We have to work in the buffer associated with NNTP server
X ;; process because of NEmacs hack.
X (copy-to-buffer nntp-server-buffer begin end)
X (set-buffer nntp-server-buffer)
X (setq begin (point-min))
X (setq end (point-max))
X ;; `process-send-region' does not work if text to be sent is very
X ;; large. I don't know maximum size of text sent correctly.
X (let ((last nil)
X (size 100)) ;Size of text sent at once.
X (save-restriction
X (narrow-to-region begin end)
X (goto-char begin)
X (while (not (eobp))
X ;;(setq last (min end (+ (point) size)))
X ;; NEmacs gets confused if character at `last' is Kanji.
X (setq last (save-excursion
X (goto-char (min end (+ (point) size)))
X (or (eobp) (forward-char 1)) ;Adjust point
X (point)))
X (process-send-region nntp-server-process (point) last)
X ;; I don't know whether the next codes solve the known
X ;; problem of communication error of GNU Emacs.
X (accept-process-output)
X ;;(sit-for 0)
X (goto-char last)
X )))
X ;; We cannot erase buffer, because reply may be received.
X (delete-region begin end)
X ))
X
X(defun nntp-open-server-internal (host &optional service)
X "Open connection to news server on HOST by SERVICE (default is nntp)."
X (save-excursion
X ;; Use TCP/IP stream emulation package if needed.
X (or (fboundp 'open-network-stream)
X (require 'tcp))
X ;; Initialize communication buffer.
X (setq nntp-server-buffer (get-buffer-create " *nntpd*"))
X (set-buffer nntp-server-buffer)
X (kill-all-local-variables)
X (buffer-flush-undo (current-buffer))
X (erase-buffer)
X (setq nntp-server-process
X (open-network-stream "nntpd" (current-buffer)
X host (or service "nntp")))
X (setq nntp-server-name host)
X ;; It is possible to change kanji-fileio-code in this hook.
X (run-hooks 'nntp-server-hook)
X ;; Return the server process.
X nntp-server-process
X ))
X
X(defun nntp-close-server-internal ()
X "Close connection to news server."
X (if nntp-server-process
X (delete-process nntp-server-process))
X (if nntp-server-buffer
X (kill-buffer nntp-server-buffer))
X (setq nntp-server-buffer nil)
X (setq nntp-server-process nil))
X
X(defun nntp-accept-response ()
X "Read response of server.
XIt is known that communication speed will be improved much by defining
Xthis function as macro."
X (if nntp-buggy-select
X (progn
X ;; We cannot use `accept-process-output'.
X ;; Fujitsu UTS requires messages during sleep-for. I don't know why.
X (message "NNTP: Reading...")
X (sleep-for 1)
X (message ""))
X ;; To deal with server process exiting before
X ;; accept-process-output is called.
X ;; Suggested by Jason Venner <jason@violet.berkeley.edu>.
X (condition-case ()
X (accept-process-output nntp-server-process)
X (error nil))
X ))
SHAR_EOF
chmod 0644 nntp.el || echo "restore of nntp.el fails"
set `wc -c nntp.el`;Sum=$1
if test "$Sum" != "20236"
then echo original size 20236, current size $Sum;fi
sed 's/^X//' << 'SHAR_EOF' > tcp.el &&
X;;; TCP/IP stream emulation for GNU Emacs
X;; Copyright (C) 1988 Fujitsu Laboratoris LTD.
X;; Copyright (C) 1988 Masanobu UMEDA (umerin@flab.flab.Fujitsu.JUNET)
X;; $Header: tcp.el,v 1.2 88/11/11 14:58:08 umerin Exp $
X
X;; This file is part of GNU Emacs.
X
X;; GNU Emacs is distributed in the hope that it will be useful,
X;; but WITHOUT ANY WARRANTY. No author or distributor
X;; accepts responsibility to anyone for the consequences of using it
X;; or for whether it serves any particular purpose or works at all,
X;; unless he says so in writing. Refer to the GNU Emacs General Public
X;; License for full details.
X
X;; Everyone is granted permission to copy, modify and redistribute
X;; GNU Emacs, but only under the conditions described in the
X;; GNU Emacs General Public License. A copy of this license is
X;; supposed to have been given to you along with GNU Emacs so you
X;; can know your rights and responsibilities. It should be in a
X;; file named COPYING. Among other things, the copyright notice
X;; and this notice must be preserved on all copies.
X
X;; Note on TCP package:
X;;
X;; This package provides TCP/IP stream emulation on GNU Emacs. If
X;; function `open-network-stream' is not defined in Emacs, but your
X;; operating system has a capability of network stream connection,
X;; the tcp package can be used for communicating with NNTP server.
X;;
X;; The tcp package runs inferior process named `tcp' which actually
X;; does the role of `open-network-stream'. Before loading the package,
X;; compile `tcp.c' and install it as `tcp' on a emacs search path. If
X;; you modify `tcp.c', please send diffs to umerin@flab.Fujitsu.JUNET.
X;; I'll include it in the next release.
X;;
X;; This file also contains small pieces of emacs lisp codes for
X;; compatibility with some old version of GNU Emacs. If these codes
X;; does wrong for your emacs, please remove all or parts of them.
X
X(provide 'tcp)
X
X(defvar tcp-program-name "tcp"
X "Program name emulating open-network-stream function.")
X
X(defun open-network-stream (name buffer host service)
X "Open a TCP connection for a service to a host.
XReturns a subprocess-object to represent the connection.
XInput and output work as for subprocesses; `delete-process' closes it.
XArgs are NAME BUFFER HOST SERVICE.
XNAME is name for process. It is modified if necessary to make it unique.
XBUFFER is the buffer (or buffer-name) to associate with the process.
X Process output goes at end of that buffer, unless you specify
X an output stream or filter function to handle the output.
X BUFFER may be also nil, meaning that this process is not associated
X with any buffer
XThird arg is name of the host to connect to.
XFourth arg SERVICE is name of the service desired, or an integer
X specifying a port number to connect to."
X (let ((proc
X (start-process name buffer
X tcp-program-name
X "-h" host
X "-s" (if (stringp service)
X service
X (int-to-string service))
X )))
X (process-kill-without-query proc)
X ;; Return process
X proc
X ))
X
X(if (fboundp 'load-library)
X nil
X ;; Following definitions are only for compatibility with *OOOOOLD*
X ;; Emacs, especially SX/A Emacs (a variant of GNU Emacs).
X ;; If your Emacs does not have `load-library' function, you have to
X ;; load this tcp package before loading `gnus'.
X
X ;; By Yasunari,Itoh at PFU limited.
X (defvar news-inews-program "inews"
X "Function to post news.")
X (defvar news-path "/usr/spool/news/"
X "The root directory below which all news files are stored.")
X
X (fset 'load-library (symbol-function 'load))
X (fset 'process-send-string (symbol-function 'send-string))
X (fset 'process-send-region (symbol-function 'send-region))
X
X (load "backquote")
X
X (defun one-window-p (&optional win)
X (if (or (not win)(eq win t)) (setq win (selected-window)))
X (eq (selected-window)(next-window win)))
X
X (fset 'bury-buffer-org (symbol-function 'bury-buffer))
X (fset 'apply-org (symbol-function 'apply))
X
X (defun bury-buffer (&optional buffer)
X (let ((buf (or buffer (current-buffer))))
X (bury-buffer-org buf)))
X
X (defun apply (func &rest args)
X (let* ((last (car (reverse args)))
X (before (reverse (cdr (reverse args))))
X (org-arg (append before last)))
X (apply-org func org-arg)))
X
X (defun file-name-as-directory (filename &optional expand-filename)
X (let* ((expanded
X (if expand-filename (expand-file-name filename)
X filename))
X (tail-ix (1- (length expanded))))
X (if (and (> tail-ix 0)
X (= (aref expanded tail-ix) ?/)) expanded
X (concat expanded "/"))))
X
X )
SHAR_EOF
chmod 0644 tcp.el || echo "restore of tcp.el fails"
set `wc -c tcp.el`;Sum=$1
if test "$Sum" != "4538"
then echo original size 4538, current size $Sum;fi
sed 's/^X//' << 'SHAR_EOF' > tcp.c &&
X/*
X * TCP/IP stream emulation for GNU Emacs.
X * Copyright (C) 1988 Fujitsu Laboratoris LTD.
X * Copyright (C) 1988 Masanobu UMEDA (umerin@flab.flab.Fujitsu.JUNET)
X * $Header: tcp.c,v 1.1 88/09/29 19:40:38 umerin Exp $
X
X * This file is part of GNU Emacs.
X
X * GNU Emacs is distributed in the hope that it will be useful,
X * but WITHOUT ANY WARRANTY. No author or distributor
X * accepts responsibility to anyone for the consequences of using it
X * or for whether it serves any particular purpose or works at all,
X * unless he says so in writing. Refer to the GNU Emacs General Public
X * License for full details.
X
X * Everyone is granted permission to copy, modify and redistribute
X * GNU Emacs, but only under the conditions described in the
X * GNU Emacs General Public License. A copy of this license is
X * supposed to have been given to you along with GNU Emacs so you
X * can know your rights and responsibilities. It should be in a
X * file named COPYING. Among other things, the copyright notice
X * and this notice must be preserved on all copies.
X
X * For Fujitsu UTS compile with:
X * cc -O -o tcp tcp.c -DFUJITSU_UTS -lu -lsocket
X
X * If you modifies the source for your system, please send me the
X * diffs. I'll includes it in the future release.
X *
X * Yasunari,Itoh at PFU limited contributed for Fujitsu UTS and SX/A.
X */
X
X#ifndef lint
Xstatic char *rcsId = "$Header: tcp.c,v 1.1 88/09/29 19:40:38 umerin Exp $";
X#endif
X
X#include <stdio.h>
X#include <fcntl.h>
X#include <ctype.h>
X#include <sys/types.h>
X
X#ifdef FUJITSU_UTS
X#define USG
X#include <sys/ucbtypes.h>
X#include <sys/tisp/socket.h>
X#include <netdb.h>
X#include <sys/tisp/in.h>
X#else
X#include <sys/socket.h>
X#include <netdb.h>
X#include <netinet/in.h>
X#endif
X
X#ifdef USG
X#include <sys/stat.h>
X#include <signal.h>
X#endif
X
X#ifdef FUJITSU_UTS
X#define bcopy(f,t,n) memcpy(t,f,n)
X#define bcmp(b1,b2,n) (memcmp(b1,b2,n)!=0)
X#define bzero(b,n) memset(b,0,n)
X#endif
X
X#ifdef USG
Xint selectable = 1;
X
Xsigout()
X{
X fcntl(fileno(stdin),F_SETFL,0);
X exit(-1);
X}
X#endif
X
Xmain(argc, argv)
Xint argc;
Xchar *argv[];
X{
X struct hostent *host;
X struct sockaddr_in sockin, sockme;
X struct servent *serv;
X char *hostname;
X char *service;
X int port;
X int readfds;
X int server; /* NNTP Server */
X int emacsIn = fileno(stdin); /* Emacs intput */
X int emacsOut = fileno(stdout); /* Emacs output */
X char buffer[1024];
X int nbuffer; /* Number of bytes in buffer */
X
X while(--argc > 0){
X switch(**(++argv)){
X case '-':
X {
X char *p = &argv[0][1];
X if(strcmp(p,"s")==0){ /* Service name */
X service = *(++argv);
X --argc;
X } else if(strcmp(p,"h")==0){ /* Host name */
X hostname = *(++argv);
X --argc;
X } else {
X fprintf(stderr, "Usage: tcp -h HOST -s SERVICE\n");
X exit(1);
X }
X }
X break;
X default:
X fprintf(stderr, "Usage: tcp -h HOST -s SERVICE\n");
X exit(1);
X break;
X }
X }
X
X if((host = gethostbyname(hostname)) == NULL){
X perror("gethostbyname");
X exit(1);
X }
X if(isdigit(service[0]))
X port = atoi(service);
X else {
X serv = getservbyname(service, "tcp");
X if(serv == NULL){
X perror("getservbyname");
X exit(1);
X }
X port = serv->s_port;
X }
X
X bzero(&sockin, sizeof(sockin));
X sockin.sin_family = host->h_addrtype;
X bcopy(host->h_addr, &sockin.sin_addr, host->h_length);
X sockin.sin_port = htons(port);
X if((server = socket(AF_INET, SOCK_STREAM, 0)) < 0) {
X perror("socket");
X exit(1);
X }
X if(setsockopt(server, SOL_SOCKET, SO_REUSEADDR, 0, 0)) {
X perror("setsockopt");
X exit(1);
X }
X bzero(&sockme, sizeof(sockme));
X sockme.sin_family = sockin.sin_family;
X sockme.sin_addr.s_addr = INADDR_ANY;
X if(bind(server, &sockme, sizeof(sockme)) < 0){
X perror("bind");
X exit(1);
X }
X if(connect(server, &sockin, sizeof (sockin)) < 0){
X perror("connect");
X close(server);
X exit(1);
X }
X
X#ifdef O_NDELAY
X fcntl(server, F_SETFL, O_NDELAY);
X
X#ifdef USG
X /* USG pipe cannot not select emacsIn */
X {
X struct stat statbuf;
X fstat (emacsIn,&statbuf);
X if (statbuf.st_mode & 010000)
X selectable = 0;
X if (!selectable){
X signal(SIGINT,sigout);
X fcntl(emacsIn, F_SETFL, O_NDELAY);
X }
X }
X#endif
X#endif
X
X /* Connection established. */
X while(1){
X readfds = (1 << server) | (1 << emacsIn);
X if(select(32, &readfds, NULL, NULL, (struct timeval *)NULL) == -1){
X perror("select");
X exit(1);
X }
X if(readfds & (1 << emacsIn)){
X /* From Emacs */
X nbuffer = read(emacsIn, buffer, sizeof buffer -1);
X
X#ifdef USG
X if (selectable && nbuffer == 0){
X goto finish;
X } else if (!(readfds & (1 << server)) && nbuffer == 0){
X sleep (1);
X } else
X#else
X if(nbuffer == 0)
X goto finish;
X#endif
X if((nbuffer > 0) && (write(server, buffer, nbuffer) != nbuffer))
X goto finish;
X }
X if(readfds & (1 << server)){
X /* From NNTP server */
X nbuffer = read(server, buffer, sizeof buffer -1);
X if(nbuffer == 0)
X goto finish;
X if((nbuffer > 0) && (write(emacsOut, buffer, nbuffer) != nbuffer))
X goto finish;
X }
X }
X
X /* End of communication. */
X finish:
X close(server);
X#ifdef USG
X if (!selectable) fcntl(emacsIn, F_SETFL,0);
X#endif
X close(emacsIn);
X close(emacsOut);
X exit(0);
X}
SHAR_EOF
chmod 0644 tcp.c || echo "restore of tcp.c fails"
set `wc -c tcp.c`;Sum=$1
if test "$Sum" != "5236"
then echo original size 5236, current size $Sum;fi
rm -f s2_seq_.tmp
echo "You have unpacked the last part"
exit 0
--
Masanobu UMEDA
umerin@flab.flab.Fujitsu.JUNET
umerin%flab.flab.Fujitsu.JUNET@uunet.uu.NET