umerin@flab.flab.fujitsu.JUNET (Masanobu UMEDA) (09/19/88)
This is a new release of GNUS, a NNTP-base network news reader for GNU
Emacs. Bug fixes reported and recommended extensions are almost
included in this release.
New features of GNUS 3.8 are:
(1) KILL file (like rn)
(2) ROT13/47 (47 is for Japanese)
(3) Sorting of subject buffer
(4) Selecting same subject (like rn -S)
(5) Real marking as unread
(6) Page breaking
(7) Hierarchical directory of ~/News/*
(8) Saving article in MH format
(9) Many hooks (useful examples are documented)
Please unpack 4 shell archives, and then byte-compile-file nntp.el,
nnspool.el, and gnus.el in *THIS* order. Read gnus.el for more
information about installation.
Anyway, mailing list for GNUS lover is started. The list is intended
to exchange valuable information about GNUS, such as bugs information,
useful hooks, and extensions of GNUS. English and Japanese are
official language of the list. If you are interested in it and don't
worry about Japanese (or English :-), send request to
info-gnus-request%flab.Fujitsu.JUNET@uunet.UU.NET
Send contributions to the list to
info-gnus%flab.Fujitsu.JUNET@uunet.UU.NET
Masanobu UMEDA
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
# nnspool.el
# nntp.el
#
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.8 88/09/19 11:04:30 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;; (1) Unshar gnus.el, nntp.el, and nnspool.el.
X;; (2) byte-compile-file nntp.el, nnspool.el, and gnus.el in THIS ORDER.
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-server-host "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) 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;; (5) 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;; (6) Read nntp.el if you have any trouble with NNTP or Kanji handling.
X
X;; GNUS Mailing List:
X;; There is a mailing list for GNUS lovers, which is intended to
X;; exchange valuable information about GNUS, such as bugs information,
X;; useful hooks, and extensions of GNUS. English and Japanese are
X;; official language of the list. If you are interested in it and
X;; don't worry about Japanese (or English :-), send request to the
X;; following:
X;;
X;; info-gnus-request@flab.Fujitsu.JUNET, or
X;; info-gnus-request%flab.Fujitsu.JUNET@uunet.UU.NET
X;;
X;; Send contributions to the list to:
X;;
X;; info-gnus@flab.Fujitsu.JUNET, or
X;; info-gnus%flab.Fujitsu.JUNET@uunet.UU.NET
X
X;; TO DO:
X;; (1) Stop using replace-regexp in format conversion because it is
X;; too slow.
X;; (2) Incremental update of active info.
X;; (3) GNUS own poster and programmable interface to various mailers.
X;; (4) Multi-GNUS (Talking to many hosts same time).
X
X(provide 'gnus)
X(require 'nntp)
X(require 'mail-utils)
X;; Function `news-inews' overrides the function defined in
X;; `rnewspost.el'. So, rnewspost.el must be loaded before it is
X;; defined.
X(if (not (fboundp 'news-inews))
X (load-library "rnewspost"))
X
X(defvar gnus-server-host (getenv "NNTPSERVER")
X "*Host the NNTP server is running.
XInitialized from the NNTPSERVER environment variable.")
X
X(defvar gnus-startup-file "~/.newsrc"
X "*Your .newsrc file. Use `.newsrc-HOST' 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-default-saver (function gnus-Subject-save-in-mail)
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 three functions:
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-enable-kill-file nil
X "*Enable KILL file if non-nil.
XKILL file is initially disabled since it makes GNUS slower. It can be
Xenabled temporary by editing the KILL file.")
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-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-auto-select-next t
X "*Select next newsgroup automagically if non-nil.
XIf the value is not nil nor t, GNUS won't exit subject display mode
Xeven if next newsgroup is empty.")
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 nil
X "*Break pages of news article if non-nil.
XPage delimiter is specified by variable `gnus-page-delimiter'.
XExperimental feature. Drop me your comments.")
X
X(defvar gnus-page-delimiter "^\^L"
X "*Regexp describing line-beginnings that separate pages of news article.")
X
X(defvar gnus-force-nntp nil
X "*Use NNTP even if local news spool is available if non-nil.")
X
X(defvar gnus-digest-temp-directory "/usr/tmp"
X "*Directory name placing RMAIL digest message.")
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-Save-newsrc-hook nil
X "*Hooks for saving the newsrc file.
XThis hook is called before writing to .newsrc file.")
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.")
X
X(defvar gnus-Article-prepare-hook nil
X "*Hooks called after an article is prepared for reading.")
X
X(defvar gnus-Select-group-hook nil
X "*Hooks called when a newsgroup is selected.
XIf you'd like to sort subjects by posted date, you can use the
Xfollowing hook:
X
X(setq gnus-Select-group-hook
X '(lambda ()
X (setq gnus-current-group-headers
X (sort gnus-current-group-headers
X '(lambda (a b)
X (gnus-date-lessp (nntp-header-date a)
X (nntp-header-date b)))))))
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 (nntp-header-subject header)))))
X gnus-current-group-headers)))")
X
X(defvar gnus-Select-article-hook nil
X "*Hooks called when an article is selected.
XIf you don't like to be marked as read automagically, you can use the
Xfollowing hook:
X
X(setq gnus-Select-article-hook
X '(lambda ()
X (gnus-Subject-mark-as-unread)))
X
XIf you'd like to run RMAIL on a digest message automagically, you can
Xuse the following hook:
X
X(setq gnus-Select-article-hook
X '(lambda ()
X (if (string-match \"Digest\"
X (nntp-header-subject
X (nntp-find-header-by-number
X gnus-current-group-headers gnus-current-article)))
X (gnus-Subject-rmail-digest))))")
X
X(defvar gnus-Exit-gnus-hook nil
X "*Hooks called when exiting gnus.")
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(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-newsrc-options nil
X "Options line in .newsrc file.")
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
X(defvar gnus-current-startup-file nil)
X(defvar gnus-current-group-name nil)
X
X(defvar gnus-current-group-unreads nil
X "List of unread articles in current newsgroup.")
X
X(defvar gnus-current-group-marked nil
X "List of marked articles in current newsgroup.")
X
X(defvar gnus-current-group-headers nil
X "List of article headers in current newsgroup.")
X
X(defvar gnus-current-article nil)
X(defvar gnus-previous-article nil)
X(defvar gnus-have-all-headers 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 '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;;(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
X;;;
X;;; GNUS Group display 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-select-group)
X (define-key gnus-Group-mode-map "=" 'gnus-Group-select-group-no-article)
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 "?" '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-select-group] Select this newsgroup.
X\\[gnus-Group-select-group-no-article] List subjects in 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\\[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
XIf there exists a file named `~/.newsrc-HOST', it is used as startup
Xfile instead of standard one when talking to a NNTP server on HOST.
XIt is possible to talk to hosts more than one by using different
Xstartup files for each.
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
XUser customizable variables:
X gnus-server-host
X Specifies host name NNTP server is running. The variable is
X initialized from the NNTPSERVER environment variable.
X
X gnus-author-copy-file
X An article posted by GNUS will be saved to a file specified by its
X value. If the first character of the value is `|', contents of
X the article will be piped out to a program specified by the rest
X of the value. The variable is initialized from the AUTHORCOPY
X environment variable.
X
X gnus-enable-kill-file
X Non-nil means KILL file is enabled. KILL file is initially
X disabled since it makes GNUS slower. Editing a KILL file will
X enables it temporary during current GNUS session.
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
X gnus-force-nntp
X Non-nil lets GNUS use NNTP even if local news spool is available.
X If local host has a news spool, GNUS won't use NNTP but go to the
X spool directly using `nnspool' library if that value is nil.
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-Save-newsrc-hook
X Called with no arguments when saving newsrc file if that value is
X non-nil.
X
X gnus-Exit-gnus-hook
X Called with no arguments when exiting GNUS, if that value is
X non-nil."
X (interactive)
X (kill-all-local-variables)
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 (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-server-host))
X (let ((buffer-read-only nil))
X (erase-buffer)
X (gnus-Group-startup-message)
X (sit-for 0)
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.8
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 ;; At first update .newsrc buffer
X (gnus-update-newsrc-buffer group)
X ;; Then update group display buffer.
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 (re-search-forward "^.[* \t]*[0-9]+:[ \t]+\\([^ \t\n]+\\)$" nil t)
X (buffer-substring (match-beginning 1)
X (match-end 1))
X )))
X
X(defun gnus-Group-select-group (all &optional no-article)
X "Select newsgroup to read at current line.
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-no-article (all)
X "Select newsgroup to read at current line.
XNo article is selected automatically.
XIf argument ALL is non-nil, already read articles become readable."
X (interactive "P")
X (gnus-Group-select-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 this 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 this group."
X (interactive)
X (gnus-Group-unsubscribe-group (gnus-Group-group-name)))
X
X(defun gnus-Group-unsubscribe-group (group)
X "Toggle subscribe from/to unsubscribe GROUP."
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)
X (not (nth 1 newsrc)))
X (gnus-Group-update-group group)
X (gnus-Group-next-group 1)
X ))
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-news-group 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 (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 (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 display 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 "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 "." 'gnus-Subject-first-unread-article)
X (define-key gnus-Subject-mode-map "/" 'isearch-forward)
X (define-key gnus-Subject-mode-map "s" 'gnus-Subject-search-article-body)
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 "^" 'gnus-Subject-goto-parent-article)
X (define-key gnus-Subject-mode-map "l" 'gnus-Subject-goto-last-article)
X (define-key gnus-Subject-mode-map "u" 'gnus-Subject-mark-unread-forward)
X (define-key gnus-Subject-mode-map "U" 'gnus-Subject-mark-unread-backward)
X (define-key gnus-Subject-mode-map "d" 'gnus-Subject-mark-read-forward)
X (define-key gnus-Subject-mode-map "D" 'gnus-Subject-mark-read-backward)
X (define-key gnus-Subject-mode-map "k" 'gnus-Subject-kill-same-subject)
X (define-key gnus-Subject-mode-map "\C-k" 'gnus-Subject-kill-same-subject-without-reading)
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 "\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 "=" '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 "X" 'gnus-Subject-caesar-message)
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 "?" '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. (Select next unread article \n\tat the end of the article.)
X\\[gnus-Subject-prev-page] Scroll to previous page of 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-first-unread-article] Jump to first unread article in current newsgroup.
X\\[isearch-forward] Do incremental search forward on subjects.
X\\[gnus-Subject-search-article-body] Do incremental search forward on current article.
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-parent-article] Jump to parent article of current article.
X\\[gnus-Subject-goto-last-article] Jump to article you read last.
X\\[gnus-Subject-mark-unread-forward] Mark current article as unread, and go forward.
X\\[gnus-Subject-mark-unread-backward] Mark current article as unread, and go backward.
X\\[gnus-Subject-mark-read-forward] Mark current article as read, and go forward.
X\\[gnus-Subject-mark-read-backward] Mark current article as read, and go backward.
X\\[gnus-Subject-kill-same-subject] Mark articles which has same subject as current article as read.
X\\[gnus-Subject-kill-same-subject-without-reading] Mark articles which has same subject as current article as read.
X Next unread article won't be selected automagically.
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-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-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] RMAIL a 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\\[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-default-saver
X Specifies your favorite article saver which is interactively
X funcallable. Currently following three functions are available:
X
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 Directory name to save an article to using the command
X gnus-Subject-save-in-mail and gnus-Subject-save-in-file. The
X variable is initialized from the 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 MH folder name saving an article in using the command
X gnus-Subject-save-in-folder.
X
X gnus-auto-select-next
X Non-nil means next newsgroup is selected automagically at the end
X of the newsgroup. You don't have to exit subject selection mode
X explicitly. If the value is not nil nor t, GNUS won't exit subject
X display mode even if the next newsgroup is empty.
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 some version of GNU Emacs before 18.50.
X
X gnus-page-delimiter
X Regexp describing line-beginnings that separate pages of news
X article.
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
X information."
X (interactive)
X (kill-all-local-variables)
X (setq major-mode 'gnus-Subject-mode)
X (setq mode-name "GNUS Subject")
X (gnus-Subject-set-mode-line)
X (use-local-map gnus-Subject-mode-map)
X (setq buffer-read-only t) ;Disable modification
X (setq truncate-lines t) ;Stop folding of lines.
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 body is displayed."
X (message "Retrieving newsgroup: %s..." group)
X (if (gnus-select-news-group 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 (if (zerop (buffer-size))
X ;; This newsgroup is empty.
X (progn
X (setq gnus-current-group-unreads nil)
X (gnus-Subject-exit)
X (message "No unread news."))
X ;; Apply KILL files.
X (if gnus-enable-kill-file
X (gnus-Kill-file-mark-as-read))
X ;; Show first unread article if requested.
X (goto-char (point-min))
X (if (and (not no-article)
X (gnus-Subject-first-unread-article))
X nil ;Window is configured automatically.
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 ))
X ;; Adjust cursor point.
X (beginning-of-line)
X (search-forward ":" nil t)
X ))
X ;; Cannot select newsgroup GROUP.
X (message "No such newsgroup: %s" group)
X (sit-for 0)
X ;; Run checking bogus newsgroups.
X (gnus-delete-bogus-news-group t) ;Confirm
X ))
X
X(defun gnus-Subject-prepare ()
X "Prepare subject list of current newsgroup in subject display buffer."
X (let* ((buffer-read-only nil)
X (id 0)
X (headers gnus-current-group-headers)
X (header nil)
X ;; These define format of subject display buffer.
X (name-length (length "umerin@photon"))
X (cntl
X (format "%%s %%%ds: [%%3d:%%s] %%s\n"
X (length (prin1-to-string gnus-current-group-end)))))
X ;; Newsgroup must be selected before calling me.
X (erase-buffer)
X (while headers
X (setq header (car headers))
X (setq id (nntp-header-number header))
X (insert
X (format cntl
X ;; Read or not.
X (cond ((memq id gnus-current-group-marked) "-")
X ((memq id gnus-current-group-unreads) " ")
X (t "D"))
X id ;Article ID.
X ;; Lines of the article.
X ;; Suggested by dana@bellcore.com.
X (nntp-header-lines header)
X ;; Its author.
X (substring (concat (mail-strip-quoted-names
X (nntp-header-from header))
X (make-string name-length ? ))
X 0 name-length)
X ;; Its subject.
X (nntp-header-subject header)))
X (setq headers (cdr headers))
X )
X ;; Erase header retrieval message.
X (message "")
X ;; Call hooks for modifying subject buffer.
X ;; Suggested by sven@tde.LTH.Se (Sven Mattisson).
X (run-hooks 'gnus-Subject-prepare-hook)
X ))
X
X(defun gnus-Subject-set-mode-line ()
X "Set Subject mode line string."
X (let ((subject gnus-current-group-name))
X (if gnus-current-article
X (setq subject
X (nntp-header-subject
X (nntp-find-header-by-number gnus-current-group-headers
X gnus-current-article))))
X (setq mode-line-process (concat " " gnus-current-group-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 (sit-for 0)
X ))
X
X;; GNUS Subject display mode command.
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 (case-fold-search nil) ;Don't ignore case.
X (regexp
X (format "^%s[ \t]+\\([0-9]+\\):[ \t]+\\[.*\\][ \t]+%s"
X ;;(if unread " " ".")
X (cond ((eq unread t) " ") (unread "[^D]") (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 (re-search-forward "^.[ \t]+\\([0-9]+\\):" nil t)
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 non."
X (save-excursion
X ;; It is possible to implement this function using
X ;; `gnus-Subject-article-number' and `gnus-current-group-headers'.
X (beginning-of-line)
X (if (re-search-forward "^.[ \t]+[0-9]+:[ \t]+\\[.*\\][ \t]+\\(.*\\)$"
X nil t)
X (let ((subject (buffer-substring (match-beginning 1) (match-end 1))))
X ;; Trim spaces of subject.
X (if (string-match "^[ \t]+\\([^ \t].*\\)$" subject)
X (setq subject (substring subject (match-beginning 1))))
X ;; Return subject string.
X subject
X )
X nil
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-current-group-headers)
X nil 'require-match))))
X (let ((current (point)))
X (goto-char (point-min))
X (or (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 window."
X ;; Scroll window so as to cursor comes center of subject window
X ;; only when article is displayed.
X ;; Suggested by earle@mahendo.JPL.NASA.GOV (Greg Earle).
X (and (get-buffer-window gnus-Article-buffer)
X (< (/ (- (window-height) 1) 2)
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) (09/19/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 (count-lines (point) (point-max)))
X (recenter (/ (- (window-height) 2) 2))))
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 GNUS 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 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 display 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-current-group-unreads
X gnus-current-group-marked)
X (memq (key-binding (this-command-keys))
X '(gnus-Subject-next-unread-article
X gnus-Subject-next-page
X ;;gnus-Subject-next-article
X ;;gnus-Subject-next-same-subject
X ;;gnus-Subject-next-unread-same-subject
X )))
X ;; No more articles with same subject, so jump to the first
X ;; unread article.
X (let ((last-point (point)))
X (gnus-Subject-first-unread-article)
X (if (< (point) last-point)
X (message "Wrapped."))
X ))
X (t
X (let* ((keyseq (this-command-keys))
X (cmd (string-to-char keyseq))
X (group (gnus-Subject-next-group-name))
X (auto-select
X (and gnus-auto-select-next
X (or (null subject)
X (null
X (gnus-set-difference gnus-current-group-unreads
X gnus-current-group-marked)))
X (memq (key-binding keyseq)
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 ))
X ;; Ignore characters typed ahead.
X (not (input-pending-p))
X )))
X (message "No more%s articles%s"
X (if unread " unread" "")
X (if auto-select
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-current-group-name
X ))
X "."))
X ;; Select next unread newsgroup automagically.
X (if auto-select
X (let ((char nil))
X (setq char (read-char))
X (message "")
X (if (= char cmd)
X (if (null group)
X (gnus-Subject-exit)
X (gnus-Subject-exit t) ;Exit temporary.
X (gnus-Subject-read-group group nil nil)
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
X ;; since the articles are marked as read
X ;; by cross-referencing. So, try next
X ;; newsgroup.
X (let ((group
X (save-excursion
X (set-buffer gnus-Group-buffer)
X (gnus-Group-group-name))))
X (if group
X (gnus-Subject-read-group group nil nil))))
X )
X (setq unread-command-char char))
X ))
X ))
X ))
X
X(defun gnus-Subject-next-group-name ()
X "Return next unread newsgroup name."
X (save-excursion
X (set-buffer gnus-Group-buffer)
X (save-excursion
X ;; We don't want to alter current point of group selection buffer.
X (if (gnus-Group-search-forward nil nil)
X (gnus-Group-group-name))
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-current-group-unreads
X gnus-current-group-marked)
X (memq (key-binding (this-command-keys))
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 (if endp
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-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-goto-parent-article ()
X "Select parent article of current article in currently visible subjects."
X (interactive)
X (gnus-Subject-select-article t t) ;Request all headers.
X (let ((message-id nil))
X ;; Look for parent Message-ID.
X (eval-in-buffer-window gnus-Article-buffer
X (save-restriction
X (widen)
X (goto-char (point-min))
X (narrow-to-region (point)
X (save-excursion
X (search-forward "\n\n" nil t) (point)))
X (if (re-search-forward
X "^References:[ \t].*\\(<[^<>]+>\\)[ \t]*$" nil t)
X (setq message-id
X (buffer-substring (match-beginning 1) (match-end 1))))
X ))
X (if (stringp message-id)
X (let ((parent
X (nntp-find-header-by-id gnus-current-group-headers
X message-id)))
X (if parent
X (gnus-Subject-goto-article (nntp-header-number parent))
X (message "Cannot find parent article.")))
X (message "No parent article."))
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-search-article-body ()
X "Search on article body."
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-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 (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 (narrow-to-page))
X ))
X
X(defun gnus-Subject-goto-article (article)
X "Read ARTICLE if exists."
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-current-group-headers)
X nil 'require-match))))
X (if (gnus-Subject-goto-subject article)
X (gnus-Subject-display-article article)))
X
X(defun gnus-Subject-goto-last-article ()
X "Go to last subject line."
X (interactive)
X (if gnus-previous-article
X (gnus-Subject-goto-article gnus-previous-article)))
X
X(defun gnus-Subject-toggle-header ()
X "Show original article header if pruned header currently shown, or vice versa."
X (interactive)
X (gnus-Subject-select-article (not gnus-have-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 (widen)
X ))
X
X(defun gnus-Subject-kill-same-subject (unmark)
X "Mark articles which has the same subject as read.
XIf argument UNMARK is non-nil, mark articles as unread instead."
X (interactive "P")
X (let ((count
X (gnus-Subject-mark-same-subject
X (gnus-Subject-subject-string) unmark)))
X (gnus-Subject-next-article (not unmark))
X (message "%d articles are marked as %s."
X count (if unmark "unread" "read"))
X ))
X
X(defun gnus-Subject-kill-same-subject-without-reading (unmark)
X "Mark articles which has the same subject as read.
XDon't select article after that.
XIf argument UNMARK is non-nil, mark articles as unread instead."
X (interactive "P")
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.
XReturn number of articles marked as read.
XIf optional argument UNMARK is non-nil, mark as unread instead."
X (save-excursion
X (let ((count 1))
X (if unmark
X (gnus-Subject-mark-as-unread)
X (gnus-Subject-mark-as-read))
X (while (and subject
X (gnus-Subject-search-forward nil subject))
X (if unmark
X (gnus-Subject-mark-as-unread)
X (gnus-Subject-mark-as-read))
X (setq count (1+ count))
X )
X ;; Return number of articles marked as read.
X count
X )))
X
X(defun gnus-Subject-mark-unread-forward ()
X "Mark current subject as unread, and then go forward."
X (interactive)
X (gnus-Subject-mark-as-unread)
X (gnus-Subject-next-subject 1 nil))
X
X(defun gnus-Subject-mark-unread-backward ()
X "Mark current subject as unread, and then go backward."
X (interactive)
X (gnus-Subject-mark-as-unread)
X (gnus-Subject-prev-subject 1 nil))
X
X(defun gnus-Subject-mark-as-unread (&optional article)
X "Mark current article as unread.
XOptional argument ARTICLE specifies article to be marked as unread."
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 ;; Add to unread and marked list.
X (or (memq article gnus-current-group-unreads)
X (setq gnus-current-group-unreads
X (cons article gnus-current-group-unreads)))
X (or (memq article gnus-current-group-marked)
X (setq gnus-current-group-marked
X (cons article gnus-current-group-marked)))
X (if (or (eq article current)
X (gnus-Subject-goto-subject article))
X (progn
X (beginning-of-line)
X (delete-char 1)
X (insert "-")))
X )))
X
X(defun gnus-Subject-mark-read-forward ()
X "Mark current subject as read, and then go forward."
X (interactive)
X (gnus-Subject-mark-as-read)
X (gnus-Subject-next-subject 1 'marked))
X
X(defun gnus-Subject-mark-read-backward ()
X "Mark current subject as read, and then go backward."
X (interactive)
X (gnus-Subject-mark-as-read)
X (gnus-Subject-prev-subject 1 'marked))
X
X(defun gnus-Subject-mark-as-read (&optional article)
X "Mark ARTICLE's subject as read."
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 (if (memq article gnus-current-group-unreads)
X (progn
X ;; Remove from unread and marked list.
X (setq gnus-current-group-unreads
X (delq article gnus-current-group-unreads))
X (setq gnus-current-group-marked
X (delq article gnus-current-group-marked))
X (if (or (eq article current)
X (gnus-Subject-goto-subject article))
X (progn
X (beginning-of-line)
X (delete-char 1)
X (insert "D")))
X ))
X )))
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-current-group-unreads))
X (while unreads
X (gnus-Subject-mark-as-read (car unreads))
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-current-group-unreads nil)
X (setq gnus-current-group-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-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.
XArgument REVERSE means reverse order."
X (interactive "P")
X (gnus-Subject-sort-subjects
X (function
X (lambda (a b)
X (string-lessp (nntp-header-subject a) (nntp-header-subject b))))
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."
X (let ((current (gnus-Subject-article-number)))
X (setq gnus-current-group-headers
X (if reverse
X (nreverse (sort (nreverse gnus-current-group-headers) predicate))
X (sort gnus-current-group-headers predicate)))
X (gnus-Subject-prepare)
X (if current
X (gnus-Subject-goto-subject current))
X ))
X
X(defun gnus-Subject-show-all-subjects ()
X "Show all subjects in this newsgroup."
X (interactive)
X (let ((current-subject (gnus-Subject-article-number))
X (current-unreads gnus-current-group-unreads)
X (current-marked gnus-current-group-marked))
X (message "Retrieving newsgroup: %s..." gnus-current-group-name)
X (if (gnus-select-news-group gnus-current-group-name t)
X (progn
X (setq gnus-current-group-unreads current-unreads)
X (setq gnus-current-group-marked current-marked)
X (run-hooks 'gnus-Select-group-hook)
X (gnus-Subject-prepare)
X (if current-subject
X (gnus-Subject-goto-subject current-subject)))
X ;; What's happening now?
X (setq gnus-current-group-unreads current-unreads)
X (setq gnus-current-group-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 (news-caesar-buffer-body rotnum)
X ))
X
X(defun gnus-Subject-rmail-digest ()
X "Read digest message using RMAIL."
X (interactive)
X (gnus-Subject-select-article)
X (let ((last-dir default-directory)
X (file
X (expand-file-name
X (concat (upcase (user-login-name)) "-GNUS-Digest")
X gnus-digest-temp-directory)))
X (if (get-file-buffer file)
X (progn
X ;; Clear old contents.
X (set-buffer (get-file-buffer file))
X (set-buffer-modified-p nil)
X (kill-buffer (current-buffer))))
X ;; Once delete work file.
X (if (file-exists-p file)
X (delete-file file))
X (eval-in-buffer-window gnus-Article-buffer
X (rmail-output file))
X (rmail-input file) ;Run RMAIL.
X (setq default-directory last-dir) ;Restore directory.
X (setq rmail-last-file
X (if gnus-use-long-file-name
X (gnus-savedir-pathname gnus-current-group-name)
X (expand-file-name
X (int-to-string gnus-current-article)
X (gnus-savedir-pathname gnus-current-group-name))))
X (condition-case ()
X (progn
X (undigestify-rmail-message)
X (rmail-expunge) ;Delete original message.
X (delete-other-windows))
X (error (message "Message is not a digest.")
X (set-buffer-modified-p nil)
X (kill-buffer (current-buffer))))
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 (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 (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-control-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 (widen)
X (delete-other-windows)
X (bury-buffer gnus-Article-buffer)
X (news-mail-reply))
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 (widen)
X (delete-other-windows)
X (bury-buffer gnus-Article-buffer)
X (news-mail-other-window))
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 (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-mail (&optional file)
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.
XOptional argument FILE specifies the name of the file."
X (interactive)
X (gnus-Subject-save-in-file file 'unix))
X
X(defun gnus-Subject-save-in-file (&optional file style)
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.
XOptional 1st argument FILE specifies the name of the file.
XOptional 2nd argument STYLE specifies saving format of the article. It
Xmust be one of nil (for plain file) or unix (for unix mail format)."
X (interactive)
X (gnus-Subject-select-article)
X (eval-in-buffer-window gnus-Article-buffer
X (save-excursion
X (save-restriction
X (widen)
X (let ((buffer-read-only nil)
X (file
X (or file
X (read-file-name
X (cond ((eq style 'unix)
X "Save article in Unix mail file: ")
X (t
X "Save article in file: "))
X (if gnus-use-long-file-name
X (gnus-savedir-pathname gnus-current-group-name)
X (expand-file-name
X (int-to-string gnus-current-article)
X (gnus-savedir-pathname gnus-current-group-name)))))))
X (gnus-make-directory (file-name-directory file))
X (cond ((eq style 'unix)
X ;; Save in unix mail format.
X (rmail-output file))
X (t
X ;; Save as plain file.
X (unwind-protect
X ;; Append newline at end of the buffer as
X ;; separator, and then save it to file. After
X ;; that, delete the newline safely.
X (progn
X (goto-char (point-max))
X (insert "\n")
X (append-to-file (point-min) (point-max) file))
X (delete-region (1- (point-max)) (point-max)))))
X ;; Remember the directory name to save articles.
X ;;(setq gnus-article-save-directory (file-name-directory file))
X )
X ))
X ))
X
X(defun gnus-Subject-save-in-folder (&optional folder)
X "Save this article to MH folder (using `rcvstore' in MH library).
XFolder to save in is default to `gnus-article-mh-folder'.
XOptional argument FOLDER specifies folder name to save in."
X (interactive)
X (gnus-Subject-select-article)
X (eval-in-buffer-window gnus-Article-buffer
X (save-restriction
X (widen)
X ;; Thanks to yuki@flab.Fujitsu.JUNET.
X (shell-command-on-region
X (point-min) (point-max)
X (concat (expand-file-name "rcvstore" mh-lib)
X " "
X (or folder
X (mh-prompt-for-folder "Save article in"
X gnus-article-mh-folder t)
X ))
X nil)
X )))
X
X(defun gnus-Subject-pipe-output ()
X "Pipe this article to command subprocess."
X (interactive)
X (gnus-Subject-select-article)
X (eval-in-buffer-window gnus-Article-buffer
X (save-restriction
X (widen)
X (shell-command-on-region (point-min) (point-max)
X (read-string "Shell command on article: ") nil))
X ))
X
X(defun gnus-Subject-exit (&optional temporary)
X "Exit reading current newsgroup, and then return to group selection mode."
X (interactive)
X (let ((updated nil))
X (gnus-update-unread-articles gnus-current-group-name
X gnus-current-group-unreads
X gnus-current-group-marked)
X (setq updated
X (gnus-mark-as-read-by-xref gnus-current-group-name
X gnus-current-group-headers
X gnus-current-group-unreads))
X (if temporary
X ;; Do not switch windows but change 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 non-visible group.
X (setq updated (cdr updated)))
X (gnus-Group-update-group gnus-current-group-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 display 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 "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 (define-key gnus-Article-mode-map "q" 'gnus-Subject-exit)
X (define-key gnus-Article-mode-map "Q" 'gnus-Subject-quit))
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 (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-variable-buffer-local 'page-delimiter)
X (setq page-delimiter gnus-page-delimiter)
X (make-variable-buffer-local 'mail-header-separator)
X (setq mail-header-separator "") ;For caesar function.
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 display 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 display 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 (erase-buffer)
X (if (nntp-request-article article)
X (progn
X ;; Setup article buffer
X (gnus-copy-to-buffer (current-buffer))
X (gnus-Article-convert-format all-headers)
X (setq gnus-have-all-headers all-headers)
X (if gnus-break-pages
X (narrow-to-page))
X (if (not (eq article gnus-current-article))
X (progn
X ;; Set article pointer.
X (setq gnus-previous-article gnus-current-article)
X (setq gnus-current-article article)
X (or (memq gnus-current-article gnus-current-group-marked)
X (gnus-Subject-mark-as-read gnus-current-article))
X ))
X ;; Next function must be called after setting
X ;; `gnus-current-article' variable.
X (gnus-Article-set-mode-line)
X ;; Hooks for modifying contents of article.
X (run-hooks 'gnus-Article-prepare-hook))
X (gnus-Subject-mark-as-read article)
X (message "No such article (may be canceled)."))
X )))
X
X(defun gnus-Article-show-all-headers ()
X "Show all article headers in article display 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 (concat "GNUS: "
X gnus-current-group-name
X (format "/%d" gnus-current-article)
X ;; Enough spaces to pad group name to 17 positions.
X (substring " "
X 0 (max 0 (- 17 (length gnus-current-group-name))))))
X (set-buffer-modified-p t)
X (sit-for 0))
X
X(defun gnus-Article-convert-format (&optional all-headers)
X "Beautify article text.
XIf optional argument ALL-HEADERS is non-nil, all of headers will be displayed."
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 (if (not all-headers)
X (gnus-Article-delete-headers))
X )))
X
X(defun gnus-Article-delete-headers ()
X "Delete unnecessary headers."
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;; 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 (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 (narrow-to-page -1) ;Go to previous page.
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 (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 (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-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
X
X;;;
X;;; Kill file
X;;;
X
X(if gnus-Kill-file-mode-map
X nil
X (setq gnus-Kill-file-mode-map (make-keymap))
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 SOURCE/REGEXP/COMMAND commands (one
Xper line) to be applied to newsgroup when it is selected. The purpose
Xof a KILL is to mark article as read on the basis of some set of
XREGEXPs. Global KILL file is applied to every newsgroup while local
XKILL file is applied to specified newsgroup.
X
XSOURCE specifies header field of articles which will be compared with
XREGEXP. Currently SOURCE must be one of the following characters. The
Xvalue is default to 's'.
X
X s means subject string.
X a means author name (From: field value).
X
XCOMMAND specifies an operation to the article which matches REGEXP.
X
X d mark as read.
X e FORM evalute lisp FORM.
X
XFor example, '/AI/d' will mark articles whose subject matches 'AI' as
Xread. '/AI/e (gnus-Subject-mark-as-read)' also does the same thing.
X
XKILL file is initially disabled since it makes GNUS slower. You can
Xenable it during this GNUS session by editing the KILL file or simply
Xset variable `gnus-enable-kill-file' to non-nil. If you'd like to
Xenable the KILL file in the future GNUS sessions, set the variable to
Xnon-nil in your startup file `~/.emacs'.
X
XSince global KILL file is applied to every newsgroup, you'd better not
Xuse global KILL file but local one for better performance.
X
XEntry to this mode calls the value of gnus-Kill-file-mode-hook with no
Xarguments, if that value is non-nil."
X (interactive)
X (kill-all-local-variables)
X (setq major-mode 'gnus-Kill-file-mode)
X (setq mode-name "Edit Kill File")
X (use-local-map gnus-Kill-file-mode-map)
X (run-hooks '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.
XKILL file is initially disabled. You can enable it temporary by
Xediting the KILL file."
X (interactive)
X (gnus-Kill-file-edit (gnus-Kill-file-pathname t))
X (if gnus-enable-kill-file
X (message "Editing global KILL file. (Type C-c C-c to exit)")
X (message "Editing global KILL file. (Type C-c C-c to exit and enable it)")
X ))
X
X(defun gnus-Kill-file-edit-local ()
X "Edit local KILL file.
XLocal KILL file is applied to current newsgroup only.
XKILL file is initially disabled. You can enable it temporary by
Xediting the KILL file."
X (interactive)
X (gnus-Kill-file-edit (gnus-Kill-file-pathname nil))
X (if gnus-enable-kill-file
X (message "Editing local KILL file. (Type C-c C-c to exit)")
X (message "Editing local KILL file. (Type C-c C-c to exit and enable it)")
X ))
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 and enable KILL file, then return to previous buffer."
X (interactive)
X (save-buffer)
X (or gnus-enable-kill-file
X (not (y-or-n-p "Do you really want to enable KILL file? "))
X (setq gnus-enable-kill-file t)) ;Enable temporary.
X (bury-buffer))
X
X(defun gnus-Kill-file-mark-as-read ()
X "Mark as read using kill file."
X (save-excursion
X ;; Apply global kill file.
X (let ((global (gnus-Kill-file-pathname t)))
X (if (file-exists-p global)
X (gnus-Kill-file-mark-as-read-using global)))
X ;; And then apply local kill file.
X (let ((local (gnus-Kill-file-pathname nil)))
X (if (file-exists-p local)
X (gnus-Kill-file-mark-as-read-using local)))
X ))
X
X(defun gnus-Kill-file-pathname (global)
X (cond (global
X (expand-file-name gnus-kill-file-name (gnus-savedir-pathname "")))
X (gnus-use-long-file-name
X (concat (gnus-savedir-pathname gnus-current-group-name)
X "." gnus-kill-file-name))
X (t
X (expand-file-name gnus-kill-file-name
X (gnus-savedir-pathname gnus-current-group-name)))
X ))
X
X(defun gnus-Kill-file-mark-as-read-using (file)
X "Mark as read using kill FILE."
X (set-buffer (find-file-noselect file))
X (goto-char (point-min))
X (while (re-search-forward "^\\([^/]*\\)/\\(.*\\)/\\([^/]*\\)[ \t]*$" nil t)
X (let ((source (buffer-substring (match-beginning 1) (match-end 1)))
X (pattern (buffer-substring (match-beginning 2) (match-end 2)))
X (command (buffer-substring (match-beginning 3) (match-end 3)))
X (headers gnus-current-group-headers)
X (header nil))
X (while headers
X (setq header (car headers))
X (if (cond ((or (string-equal "" source)
X (string-equal "s" source))
X (string-match pattern (nntp-header-subject header)))
X ((string-equal "a" source)
X (string-match pattern (nntp-header-from header))))
X (cond ((string-match "^[ \t]*d" command)
X ;; Mark as read.
X (gnus-Subject-mark-as-read (nntp-header-number header)))
X ((string-match "^[ \t]*e\\(.*\\)$" command)
X ;; Eval expression.
X (condition-case ()
X (save-excursion
X (save-window-excursion
X (let ((form
X (substring command
X (match-beginning 1)
X (match-end 1))))
X (set-buffer gnus-Subject-buffer)
X (gnus-Subject-goto-subject
X (nntp-header-number header))
X (eval (read form))
X )))
X (error
X (message "KILL file command failed: %s" command)
X (sit-for 1))))
X (t
X (message "Unknown KILL file command: %s" command)
X (sit-for 1))
X ))
X (setq headers (cdr headers)))
X )))
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-server-host))
X (setq gnus-server-host
X (read-string "NNTP server host: " gnus-server-host)))
X (if (or gnus-force-nntp
X (not (string-equal gnus-server-host (system-name))))
X (message "Connecting to NNTP server on %s..." gnus-server-host)
X ;; Use local news spool.
X (require 'nnspool)
X (message "Looking up local news spool..."))
X (cond ((nntp-open-server gnus-server-host))
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-server-host)))
X ))
X
X(defun gnus-select-news-group (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-current-group-name group)
X (setq gnus-current-group-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-current-group-unreads)))
X ;; Get headers list.
X (setq gnus-current-group-headers (nntp-retrieve-headers articles))
X ;; UNREADS may contain expired articles, so we have to remove
X ;; them from the list.
X (setq gnus-current-group-unreads
X (gnus-intersection gnus-current-group-unreads
X (mapcar
X (function
X (lambda (header)
X (nntp-header-number header)))
X gnus-current-group-headers)))
X ;; Marked article must be a subset of unread articles.
X (setq gnus-current-group-marked
X (gnus-intersection gnus-current-group-unreads
X (cdr (assoc group gnus-marked-assoc))))
X ;; Last article in this newsgroup.
X (if gnus-current-group-headers
X (setq gnus-current-group-end
X (nntp-header-number
X (gnus-last-element gnus-current-group-headers))))
X ;; Reset article pointer.
X (setq gnus-current-article nil)
X (setq gnus-previous-article nil)
X (setq gnus-have-all-headers nil)
X ;; GROUP is successfully selected.
X t
X )
X ))
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 (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-copy-to-buffer (buffer &optional append)
X "Copy server response to BUFFER (or buffer name).
XIf optional argument APPEND is non-nil, append to buffer."
X (let ((buffer (get-buffer-create buffer)))
X (set-buffer buffer)
X (goto-char (point-max))
X (save-excursion
X (set-buffer nntp-server-buffer)
X (if append
X (append-to-buffer buffer (point-min) (point-max))
X (copy-to-buffer buffer (point-min) (point-max))))
X ;; Return BUFFER itself.
X buffer
X ))
X
X(defun gnus-simplify-subject (subject)
X "Remove `Re:' and words in parentheses."
X ;; Remove `Re:'
X (let ((case-fold-search t)) ;Ignore case.
X (if (string-match "^re: " subject)
X (while (string-match "^re: " subject)
X (setq subject (substring subject 4))
X (if (string-match "^[ \t]+\\([^ \t].*\\)$" subject)
X (setq subject (substring subject (match-beginning 1))))
X ))
X ;; Remove words in parentheses from end.
X ;; (string-match "([ \t]*in[ \t]+.*)" subject)
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-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 (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 (or date ""))
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(defun gnus-savedir-pathname (group)
X (expand-file-name
X (if gnus-use-long-file-name
X group
X (gnus-group-directory-form group))
X (or gnus-article-save-directory "~/News")))
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)
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) (09/19/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 (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 (if (not (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;;; 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 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;;; 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-news-group))
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-server-host)))
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-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 (group-xref (assoc (car xref) xref-list)))
X (if (string-equal group (car xref))
X ;; Ignore this group.
X nil
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))
X xref-list)))
X ))
X (setq xrefs (cdr xrefs))
X ))
X (setq headers (cdr headers)))
X ;; Mark cross referenced articles as read.
X (gnus-mark-xref-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-xref-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 (progn
X ;; New newsgroup must be added during this GNUS session.
X (message "It seems me that new newsgroup is added.")
X (gnus-add-new-news-group)
X (gnus-get-unread-articles)
X (setq unread (gnus-gethash group gnus-unread-hashtb))
X ))
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 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) 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-news-group ()
X "Add new newsgroup to gnus-newsrc-assoc."
X (let ((group nil))
X (mapatoms
X (function
X (lambda (sym)
X (setq group (symbol-name sym))
X (if (null (assoc group gnus-newsrc-assoc))
X ;; Find new newsgroup.
X (let ((subscribe (not (or (string-equal group "control")
X (string-equal group "junk")))))
X (setq gnus-newsrc-assoc
X (cons (list group subscribe) gnus-newsrc-assoc))
X (gnus-update-newsrc-buffer group)
X (if subscribe
X (message "New newsgroup: %s is subscribed." group))
X ))))
X gnus-active-hashtb)
X ))
X
X(defun gnus-delete-bogus-news-group (&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 (save-excursion
X (message "Reading active file...")
X (if (nntp-request-list) ;Get active file from server
X (progn
X ;; Take care of unexpected situations.
X ;;(gnus-copy-to-buffer " *GNUS-active*")
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 ;;(kill-buffer (current-buffer))
X (message "Reading active file... Done.")
X )
X (error "Cannot read active file from NNTP server."))
X ))
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-assoc nil)
X (setq gnus-marked-assoc nil)
X (if (file-exists-p gnus-current-startup-file)
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 ;; Load quick .newsrc to restore gnus-marked-assoc even if
X ;; gnus-newsrc-assoc is out of date.
X (condition-case nil
X (progn (load-file quick-file)
X (message "")
X (setq quick-loaded 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 (t
X (save-excursion
X (message "Reading %s..." newsrc-file)
X (set-buffer (get-buffer-create " *GNUS-newsrc*"))
X (erase-buffer)
X (insert-file-contents newsrc-file)
X (gnus-newsrc-to-gnus-format)
X ;; Define variable gnus-newsrc-assoc.
X (condition-case nil
X (eval-current-buffer)
X (error
X (error "Too long or invalid lines in %s" newsrc-file)))
X (kill-buffer (current-buffer))
X (message "Reading %s... Done." newsrc-file)))
X ))
X ))
X
X(defun gnus-newsrc-to-gnus-format ()
X "Convert newsrc format to gnus internal format.
XBuffer becomes evaluable as lisp expression."
X ;; Make it easy to edit.
X (goto-char (point-min))
X (replace-regexp "$" " ")
X (goto-char (point-min))
X (replace-string "," " , ")
X ;; Make sure .newsrc file is formated in standard way.
X (goto-char (point-min))
X (replace-string ":" ": ")
X (goto-char (point-min))
X (replace-string "!" "! ")
X ;; Save options line to variable.
X (goto-char (point-min))
X (if (re-search-forward "^options[ \t]*\\(.*[^ \t]\\)[ \t]*$" nil t)
X (progn
X (setq gnus-newsrc-options (buffer-substring (match-beginning 1)
X (match-end 1)))
X ;; Delete options line.
X (beginning-of-line)
X (kill-line 1) ;Kill just one line.
X ))
X ;; num -> (num . num)
X (goto-char (point-min))
X (replace-regexp "[ \t]\\([0-9]+\\)[ \t]" "(\\1 . \\1)")
X ;; num1-num2 -> (num1 . num2)
X (goto-char (point-min))
X (while (re-search-forward "[ \t]\\([0-9]+\\)-\\([0-9]+\\)[ \t]" nil t)
X (replace-match "(\\1 . \\2)")
X ;; Need retry on this line.
X (beginning-of-line))
X ;; Delete ','.
X (goto-char (point-min))
X (replace-string "," " ")
X ;; Put range of read article in list form.
X (goto-char (point-min))
X (replace-regexp "\\(^.*[!:][ ]*\\)\\(.*\\)$" "\\1(\\2)")
X ;; Process Subscribed newsgroup.
X (goto-char (point-min))
X (replace-regexp "\\(^.*\\):\\(.*\\)$" "(\"\\1\" t . \\2)")
X ;; Process UnSubscribed newsgroup.
X (goto-char (point-min))
X (replace-regexp "\\(^.*\\)!\\(.*\\)$" "(\"\\1\" nil . \\2)")
X ;; Make the buffer evaluable.
X (goto-char (point-min))
X (insert "(setq gnus-newsrc-assoc '(\n")
X (goto-char (point-max))
X (insert "))\n")
X )
X
X(defun gnus-save-newsrc-file ()
X "Save to .newsrc FILE."
X (if gnus-newsrc-assoc
X (save-excursion
X (set-buffer (find-file-noselect 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 (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 (find-file-noselect gnus-current-startup-file))
X (goto-char (point-min))
X (if (re-search-forward (concat "^" (regexp-quote group) "[:!]") nil t)
X (progn
X ;; Delete old info.
X (beginning-of-line)
X (kill-line 1)
X ))
X (if (not delete)
X (let ((newsrc (assoc group gnus-newsrc-assoc)))
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(defun gnus-gnus-to-quick-newsrc-format ()
X "Insert gnus-newsrc-assoc as evaluable format."
X (insert ";; DON'T DELETE ME.\n")
X ;; Save options line.
X (if gnus-newsrc-options
X (insert "(setq gnus-newsrc-options \"" gnus-newsrc-options "\")\n"))
X ;; Save newsrc assoc list.
X (insert "(setq gnus-newsrc-assoc '")
X (insert (prin1-to-string gnus-newsrc-assoc))
X (insert ")\n")
X ;; Save marked assoc list.
X (insert "(setq gnus-marked-assoc '")
X (insert (prin1-to-string gnus-marked-assoc))
X (insert ")\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 (erase-buffer)
X (and subject
X (progn (if (string-match "^Re: " subject)
X (while (string-match "^Re: " subject)
X (setq subject (substring subject 4))))
X (setq subject (concat "Re: " subject))))
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 (erase-buffer)
X ;; Ask newsgroups, subject and distribution if you are a
X ;; novice user.
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 (substring newsgroups 0
X (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 (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 )
X (message "")))
X
X;; `news-inews' in `newspost.el' is re-defined.
X
X(defun news-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 (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)
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 `news-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 ()
X "NNTP inews interface."
X (let ((signature (expand-file-name "~/.signature" nil))
X (distribution nil))
X (save-excursion
X (copy-to-buffer " *GNUS-posting*" (point-min) (point-max))
X (set-buffer " *GNUS-posting*")
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 ;; Post 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-control-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 (message "The article's not yours.")
X ;; Make control article.
X (set-buffer (get-buffer-create " *GNUS-posting*"))
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 (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* ((login-name (gnus-inews-login-name))
X (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 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-server-host "!" 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-inews-login-name)
X "@"
X (gnus-inews-domain-name gnus-use-generic-from)))
X
X(defun gnus-inews-login-name ()
X "Return user's login name."
X (or (getenv "USER")
X (getenv "LOGNAME")
X (user-login-name)))
X
X(defun gnus-inews-domain-name (&optional genericfrom)
X "Return user's domain name.
XIf optional argument GENERICFROM is non-nil, don't insert local host
Xname to the domain name."
X (let ((domain (or (getenv "DOMAINNAME") gnus-your-domain)))
X (if (and (null domain)
X (not (string-match "\\." (system-name))))
X (progn
X (setq domain (read-string "Your 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 0444 gnus.el || echo "restore of gnus.el fails"
set `wc -c gnus.el`;Sum=$1
if test "$Sum" != "129600"
then echo original size 129600, 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.5 88/09/19 11:03: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(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-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 (concat nnspool-current-directory
X (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 ;; 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
X (getenv "NNTPSERVER")
X (error "NNSPOOL: no server host is specified."))))
X (setq nntp-status-message-string "")
X (if (and (file-directory-p nnspool-spool-directory)
X (file-exists-p nnspool-active-file))
X (nntp-open-server-internal host service)
X (setq nntp-status-message-string
X (format "%s has no news spool. Goodbye." host))
X nil
X )
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 (concat nnspool-current-directory (prin1-to-string id))))
X (if (and (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 week, 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 (erase-buffer)
X (setq nntp-server-process nil)
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 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-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 nnspool-spool-directory group "/")
X ))
SHAR_EOF
chmod 0444 nnspool.el || echo "restore of nnspool.el fails"
set `wc -c nnspool.el`;Sum=$1
if test "$Sum" != "9488"
then echo original size 9488, 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.5 88/09/19 11:01:51 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
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(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
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) (09/19/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 nntp.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' >> nntp.el
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(defun nntp-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 (if (eq number (nntp-header-number (car headers)))
X (setq found (car headers)))
X (setq headers (cdr headers)))
X found
X ))
X
X(defun nntp-find-header-by-id (headers id)
X "Return a header which is a element of HEADERS and has message-ID."
X (let ((found nil))
X (while (and headers (not found))
X (if (string-equal id (nntp-header-id (car headers)))
X (setq found (car headers)))
X (setq headers (cdr headers)))
X found
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
X (getenv "NNTPSERVER")
X (error "NNTP: no server host is specified."))))
X (setq nntp-status-message-string "")
X (if (nntp-open-server-internal host service)
X (let ((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 '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 status
X ))
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 (forward-char -1)
X (if (looking-at "\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)
X (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 (not (eobp))
X (if (looking-at "^\\.\\.")
X (delete-char 1))
X (forward-line 1)
X (beginning-of-line))
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 `.' ad beginning of line with `..'.
X (goto-char (point-min))
X ;; (replace-regexp "^\\." "..")
X (while (not (eobp))
X (if (looking-at "^\\.")
X (insert "."))
X (forward-line 1)
X (beginning-of-line))
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 "Wailt for server RESPONSE after sending CMD and optional ARGS to
Xnews 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)
X (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 (erase-buffer)
X (setq nntp-server-process
X (open-network-stream "nntpd" (current-buffer)
X host (or service "nntp")))
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 0444 nntp.el || echo "restore of nntp.el fails"
set `wc -c nntp.el`;Sum=$1
if test "$Sum" != "20613"
then echo original size 20613, 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.NETbrian@radio.uucp (Brian Glendenning) (09/21/88)
Can anyone with experience with both GNUS and Gnews comment on the relative merits of them? I am generally quite happy with Gnews but wish it was a bit (a lot for some things) faster. -- Brian Glendenning - Radio astronomy, University of Toronto brian@radio.astro.toronto.edu uunet!utai!radio!brian glendenn@utorphys.bitnet