umerin@flab.flab.fujitsu.JUNET (Masanobu UMEDA) (05/25/88)
This is the latest version of GNUS, a network news reader for GNU
Emacs. It is based on Network News Transfer Protocol (NNTP). You are
able to read and post a news remotely inside Emacs. I'd like to give
much thanks to everyone who sends me valuable comments.
Before staring gnus you have to define your environment as follows:
(1) define news server host by
setenv NNTPSERVER your-news-server-host-name
(2) define your domain (do not include your host name!) by
setenv DOMAINNAME your-domain-name
(3) define your organization by
setenv ORGANIZATION your-organization
One known problem is that a large text posted remotely may be broken
by unknown reason. This is why Emacs command `lisp-send-defun' uses
external file to send function definitions to inferior lisp process.
You'd better not post a so large news as gnus.el (:-).
Masanobu UMEDA
umerin%flab.flab.Fujitsu.JUNET@uunet.uu.NET
---------------------------------------------------------------------------
: This is a shar archive. Extract with sh, not csh.
: The rest of this file will extract:
: gnus.el
echo x gnus.el
sed 's/^X//' > gnus.el << '*-*-END-of-gnus.el-*-*'
X;;; GNUS: NNTP Based News Reader for GNU Emacs
X;; Copyright (C) 1987, 1988 Fujitsu Laboratoris LTD.
X;; Copyrigth (C) 1987, 1988 Masanobu UMEDA (umerin@flab.flab.Fujitsu.JUNET)
X;; $Header: gnus.el,v 3.1 88/05/23 17:10:18 umerin Locked $
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;; TO DO:
X;; (1) stop using replace-regexp in format conversion because it is
X;; too slow.
X;; (2) caesar article body (rot13).
X;; (3) select article by references.
X;; (4) select article by author.
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 news 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.")
X
X(defvar gnus-author-copy-file (getenv "AUTHORCOPY")
X "*File name saving copy of posted article.
XIf the first character of the name is `|', the article is piped out to
Xnamed program.
XInitialized from the AUTHORCOPY environment variable.")
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 T.
XAsk you news group name, subject, and distribution.")
X
X(defvar gnus-Group-mode-hook nil
X "*Hooks for GNUS Group mode.")
X
X(defvar gnus-Save-newsrc-hook nil
X "*Hooks for saving the newsrc information.
XThe hook is called before writing to .newsrc file.")
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;; 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.")
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-your-time-zone -9
X "*Difference between GMT and your time zone.")
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-unread-assoc nil
X "Assoc list of unread articles.")
X
X(defvar gnus-active-assoc nil
X "Assoc list of active articles.")
X
X(defvar gnus-octive-assoc nil
X "Assoc list of OLD active articles.")
X
X(defvar gnus-Group-display-buffer "*Newsgroup*")
X(defvar gnus-Subject-display-buffer "*Subject*")
X(defvar gnus-Article-display-buffer "*Article*")
X
X(defvar gnus-current-startup-file nil)
X(defvar gnus-current-news-group nil)
X(defvar gnus-current-group-begin nil)
X(defvar gnus-current-group-end nil)
X
X(defvar gnus-current-group-articles nil
X "List of articles in current news group.")
X
X(defvar gnus-current-group-unread-articles nil
X "List of unread articles in current news group.")
X
X(defvar gnus-current-group-headers nil
X "List of (ARTICLE-NUMBER SUBJECT FROM XREF) in current news group.")
X
X(defvar gnus-current-article nil
X "Current article number.")
X
X(defvar gnus-previous-article nil
X "Previous article number.")
X
X(defvar gnus-Group-mode-map nil)
X(defvar gnus-Subject-mode-map nil)
X(defvar gnus-Article-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
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
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-without-reading)
X (define-key gnus-Group-mode-map "j" 'gnus-Group-read-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-post-news)
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 based news server.
XAll normal editing commands are turned off.
XInstead, these commands are available:
X
X\\[gnus-Group-select-group] Select this news group.
X\\[gnus-Group-select-group-without-reading] List subjects in this news group.
X\\[gnus-Group-read-group] Jump to specified news group.
X\\[gnus-Group-next-unread-group] Move to Next unread news group.
X\\[gnus-Group-prev-unread-group] Move to Previous unread news group.
X\\[gnus-Group-next-group] Move to Next news group.
X\\[gnus-Group-prev-group] Move to Previous news group.
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 news group unsubscribe from/to subscribe.
X\\[gnus-Group-unsubscribe-group] Toggle news group unsubscribe from/to subscribe.
X\\[gnus-Group-catch-up] Mark all articles in this news group as read.
X\\[gnus-Group-list-groups] Revert this buffer.
X\\[gnus-Group-list-all-groups] List all of news groups.
X\\[gnus-Group-get-new-news] Get new news.
X\\[gnus-Group-check-bogus-groups] Check bogus news groups.
X\\[gnus-post-news] Post an article to JUNET (USENET).
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
XThe following commands are available:
X\\{gnus-Group-mode-map}
X
XIf there is a file named `~/.newsrc-HOST', it is used as startup file
Xinstead of standard one when talking to a news server on HOST. You are
Xable to talk to hosts more than one by using different startup files
Xfor each.
X
XBy giving an argument to command `\\[gnus]', you can choose news server
Xhost different from default one.
X
XIf there is a file named `~/.signature-DISTRIBUTION', it is used as
Xsignature file instead of standard one when posting a news in
XDISTRIBUTION.
X
XIf you are a novice to network news, it is recommended to set variable
X`gnus-novice-user' to non-NIL. You will be asked newsgroup, subject,
Xand distribution when posting a new news if the value is set to
Xnon-NIL (defalut).
X
XEntry to this mode calls the value of gnus-Group-mode-hook with no arguments,
Xif that value is non-nil."
X (interactive)
X (kill-all-local-variables)
X (setq major-mode 'gnus-Group-mode)
X (setq mode-name (concat "GNUS talking to " gnus-server-host))
X (setq mode-line-buffer-identification "GNUS: List of Newsgroups")
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 ask-host)
X "Read news using nntp based news server.
XIf optional argument ASK-HOST is non-nil, ask news server host."
X (interactive "P")
X (gnus-start-news-server ask-host)
X (switch-to-buffer (get-buffer-create gnus-Group-display-buffer))
X (gnus-Group-mode)
X (let ((buffer-read-only nil))
X (erase-buffer)
X (gnus-Group-startup-message)
X (sit-for 0)
X (gnus-setup-news-info)
X (erase-buffer))
X (gnus-Group-list-groups nil)
X (sit-for 0))
X
X(defun gnus-Group-startup-message ()
X (insert "\n\n\n\n
X GNUS Version 3.1
X
X NNTP Based News Reader for GNU Emacs
X
X
X If you have any troubles with this software, please let me
X know. I would fix your problems in the next release.
X
X Any comment, suggestion, and bug fix are welcome.
X
X Masanobu UMEDA
X umerin@flab.Fujitsu.JUNET"))
X
X(defun gnus-Group-list-groups (show-all)
X "List news groups in group selection buffer.
XIf argument SHOW-ALL is non-nil, unsubscribed groups are also listed."
X (interactive "P")
X (gnus-Group-prepare-list 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-list (&optional all)
X "Prepare list of news groups in current buffer.
XIf optional argument ALL is non-nil, unsubscribed groups are also listed."
X (save-excursion
X (let ((buffer-read-only nil)
X (unread gnus-unread-assoc)
X (group nil)
X (group-name nil)
X ;; This specifies format of Group display buffer.
X (cntl "%s %5s: %s\n"))
X (erase-buffer)
X (goto-char (point-min))
X ;; List news groups.
X (while unread
X (setq group (car unread))
X (setq group-name (car group))
X (if (or all
X (and (> (nth 1 group) 0) ;There are unread articles.
X (nth 1 (assoc group-name gnus-newsrc-assoc))))
X (progn
X (insert
X (format cntl
X ;; Subscribed or not.
X (if (nth 1 (assoc group-name gnus-newsrc-assoc))
X " " "U")
X ;; Number of unread articles.
X (nth 1 group)
X ;; News group name.
X group-name))
X ))
X (setq unread (cdr unread))
X ))
X ))
X
X(defun gnus-Group-update-group (group &optional visible-only)
X "Update news group info of GROUP.
XIf optional argument VISIBLE-ONLY is non-nil, non displayed group is ignored."
X (save-excursion
X ;; At first update .newsrc buffer
X (gnus-update-newsrc-buffer group)
X ;; Then update group display buffer.
X (set-buffer (get-buffer gnus-Group-display-buffer))
X (let ((buffer-read-only nil)
X (visible nil)
X (unread (assoc group gnus-unread-assoc))
X ;; This specifies format of Group display buffer.
X (cntl "%s %5s: %s\n"))
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
X (not visible-only))
X (insert
X (format cntl
X ;; Subscribed or not.
X (if (nth 1 (assoc group gnus-newsrc-assoc))
X " " "U")
X ;; Number of unread articles.
X (nth 1 unread)
X ;; News group name.
X group))
X ))
X ))
X
X;; GNUS Group mode command
X
X(defun gnus-Group-group-name ()
X "Get news group 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 news group 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))) ;News group name
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 (nth 1 (assoc group gnus-unread-assoc)))) ;No unread
X no-article
X ))
X ))
X
X(defun gnus-Group-select-group-without-reading (all)
X "Select news group 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-read-group (group &optional all)
X "Start reading news in news GROUP.
XIf argument ALL is non-nil, already read articles become readable."
X (interactive (list (completing-read "News group: " gnus-unread-assoc)
X current-prefix-arg))
X (gnus-Subject-read-group
X group
X (or all
X (not (nth 1 (assoc group gnus-newsrc-assoc))) ;Unsubscribed
X (zerop (nth 1 (assoc group gnus-unread-assoc)))) ;No unread article
X ))
X
X(defun gnus-Group-search-forward (backward any-group)
X "Search for news group 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 "." " ")
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 ()
X "Go to next news group."
X (interactive)
X (if (gnus-Group-search-forward nil t)
X nil
X (message "No more news group.")))
X
X(defun gnus-Group-next-unread-group ()
X "Go to next unread news group."
X (interactive)
X (if (gnus-Group-search-forward nil nil)
X nil
X (message "No more news group.")))
X
X(defun gnus-Group-prev-group ()
X "Go to previous news group."
X (interactive)
X (gnus-Group-search-forward t t))
X
X(defun gnus-Group-prev-unread-group ()
X "Go to previous unread news group."
X (interactive)
X (gnus-Group-search-forward t nil))
X
X(defun gnus-Group-catch-up (no-confirm)
X "Mark all articles in this news group 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)
X (gnus-Group-update-group group)
X (gnus-Group-next-unread-group))
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 of GROUP."
X (interactive (list (completing-read "News group: " gnus-newsrc-assoc)))
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)
X ))
X ))
X
X(defun gnus-Group-list-all-groups ()
X "List all of news groups 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 news group."
X (interactive)
X (gnus-delete-bogus-news-group t) ;Require confirmation.
X (gnus-Group-list-groups nil))
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 (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 ))
X
X(defun gnus-Group-quit ()
X "Quit reading news without updating .newsrc."
X (interactive)
X (if (yes-or-no-p "Quit reading news without saving .newsrc? ")
X (progn
X (gnus-clear-system)
X (nntp-close-server))
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 "\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-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-t" 'gnus-Subject-toggle-truncation)
X (define-key gnus-Subject-mode-map "t" 'gnus-Subject-show-all-headers)
X (define-key gnus-Subject-mode-map "v" 'gnus-Subject-show-all-headers)
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-in-file)
X (define-key gnus-Subject-mode-map "\C-o" 'gnus-Subject-rmail-output)
X (define-key gnus-Subject-mode-map "|" 'gnus-Subject-pipe-output)
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 news group.
XAll normal editing commands are turned off.
XInstead, these commands are available:
X
X\\[gnus-Subject-next-page] Scroll to next page of this article. (If end of the article,\n\tmove to next article.)
X\\[gnus-Subject-prev-page] Scroll to previous page of this 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 this article.
X\\[gnus-Subject-prev-same-subject] Move to Previous article which has same subject as this article.
X\\[gnus-Subject-next-digest] Scroll to next digested message in this article.
X\\[gnus-Subject-prev-digest] Scroll to previous digested message in this 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 this news group.
X\\[isearch-forward] Do incremental search forward.
X\\[gnus-Subject-search-article-body] Do incremental search forward on this article body.
X\\[gnus-Subject-beginning-of-article] Move point to beginning of this article.
X\\[gnus-Subject-end-of-article] Move point to end of this article.
X\\[gnus-Subject-goto-article] Jump to article specified by numeric article ID.
X\\[gnus-Subject-goto-last-article] Jump to article you read last.
X\\[gnus-Subject-mark-unread-forward] Mark this article as unread, and go forward.
X\\[gnus-Subject-mark-unread-backward] Mark this article as unread, and go backward.
X\\[gnus-Subject-mark-read-forward] Mark this article as read, and go forward.
X\\[gnus-Subject-mark-read-backward] Mark this article as read, and go backward.
X\\[gnus-Subject-kill-same-subject] Mark articles which has same subject as this article as read.
X\\[gnus-Subject-kill-same-subject-without-reading] Mark articles which has same subject as this article as read.
X Don't select article after that.
X\\[gnus-Subject-catch-up] Mark all of articles in this news group as read.
X\\[gnus-Subject-toggle-truncation] Toggle truncation of subject lines.
X\\[gnus-Subject-show-all-headers] Show all headers of this article.
X\\[gnus-Subject-post-news] Post an article.
X\\[gnus-Subject-post-reply] Post a reply article.
X\\[gnus-Subject-cancel] Cancel this 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-in-file] Append this article to file.
X\\[gnus-Subject-rmail-output] Append this article to file in Unix mail format.
X\\[gnus-Subject-pipe-output] Pipe this article to subprocess.
X\\[describe-mode] Describe this mode.
X\\[gnus-Subject-exit] Quit reading news in this news group.
X\\[gnus-Subject-quit] Quit reading news without updating read articles information.
X
XThe following commands are available:
X\\{gnus-Subject-mode-map}
X
XEntry to this mode calls the value of gnus-Subject-mode-hook with no arguments,
Xif that value is non-nil."
X (interactive)
X (kill-all-local-variables)
X (setq major-mode 'gnus-Subject-mode)
X (setq mode-name (concat "GNUS " gnus-current-news-group))
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-read-group (group &optional show-all no-article)
X "Start reading news in news 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 news group: %s..." group)
X (if (gnus-select-news-group group show-all)
X (progn
X (switch-to-buffer (get-buffer-create gnus-Subject-display-buffer))
X (gnus-Subject-mode)
X (gnus-Subject-prepare-list)
X (message "") ;Erase message.
X (if (zerop (buffer-size))
X ;; This news group is empty.
X (progn
X (setq gnus-current-group-unread-articles nil)
X (gnus-Subject-exit)
X (message "No unread news."))
X ;; Show first unread article.
X (goto-char (point-min))
X (if (not no-article)
X (gnus-Subject-first-unread-article)
X ;; Kill article display buffer because I sometime get
X ;; confused by old article buffer.
X (if (get-buffer gnus-Article-display-buffer)
X (kill-buffer gnus-Article-display-buffer)
X ))
X ;; Adjust cursor point.
X (beginning-of-line)
X (search-forward ":" nil t)
X ))
X ;; Cannot select news GROUP.
X (message "No such news group: %s" group)
X (sit-for 0)
X ;; Run checking bogus news groups.
X (gnus-delete-bogus-news-group t) ;Confirm
X ))
X
X(defun gnus-Subject-prepare-list ()
X "Prepare subject list of current news group in current buffer."
X (save-excursion
X (let* ((buffer-read-only nil)
X (id 0)
X (headers gnus-current-group-headers)
X (unread (copy-sequence gnus-current-group-unread-articles))
X ;; These define format of subject display buffer.
X (name-length (length "umerin@photon"))
X (cntl
X (format "%%s %%%ds: [%%%ds] %%s\n"
X (length (prin1-to-string gnus-current-group-end))
X name-length)))
X ;; News group must be selected before calling me.
X (erase-buffer)
X (while headers
X (setq id (nntp-headers-number (car headers)))
X (setq unread (delq id unread))
X (insert
X (format cntl
X (if (memq id gnus-current-group-unread-articles)
X " " "D") ;Read or not.
X id ;Article ID.
X (substring (concat (mail-strip-quoted-names
X (nntp-headers-from (car headers)))
X (make-string name-length ? ))
X 0 name-length)
X (nntp-headers-subject (car headers))))
X (setq headers (cdr headers))
X )
X ;; If unread is non-nil, there exists expired articles. In this
X ;; case, these articles must be removed from unread articles.
X (while unread
X (setq gnus-current-group-unread-articles
X (delq (car unread) gnus-current-group-unread-articles))
X (setq unread (cdr unread)))
X )))
X
X(defun gnus-Subject-set-mode-line ()
X "Set Subject mode line string."
X (let ((subject (nntp-headers-subject
X (assoc gnus-current-article
X gnus-current-group-headers))))
X (setq mode-line-process
X (concat " "
X (if (integerp gnus-current-group-begin)
X (int-to-string gnus-current-group-begin)
X "?")
X "-"
X (if (integerp gnus-current-group-end)
X (int-to-string gnus-current-group-end)
X "?")
X ))
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 (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 (buffer-substring (match-beginning 1)
X (match-end 1))))
X )
X ;; Adjust cursor point.
X (beginning-of-line)
X (search-forward ":" nil t)
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 (if (and article
X (get-buffer-window gnus-Article-display-buffer)
X (< (/ (- (window-height) 1) 2)
X (count-lines (point) (point-max))))
X (recenter (/ (- (window-height) 2) 2)))
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."
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."
X (interactive "NArticle ID: ")
X (goto-char (point-min))
X (re-search-forward (format "^.[ \t]+%d:" article) nil t))
X
X;; Walking around subject lines.
X
X(defun gnus-Subject-next-subject (unread)
X "Go to next subject line.
XIf argument UNREAD is non-nil, only unread article is selected."
X (interactive "P")
X (cond ((gnus-Subject-search-forward unread))
X (unread
X (message "No more unread articles."))
X (t
X (message "No more articles."))
X ))
X
X(defun gnus-Subject-next-unread-subject ()
X "Go to next unread subject line."
X (interactive)
X (gnus-Subject-next-subject t))
X
X(defun gnus-Subject-prev-subject (unread)
X "Go to previous subject line.
XIf argument UNREAD is non-nil, only unread article is selected."
X (interactive "P")
X (cond ((gnus-Subject-search-backward unread))
X (unread
X (message "No more unread articles."))
X (t
X (message "No more articles."))
X ))
X
X(defun gnus-Subject-prev-unread-subject ()
X "Go to previous unread subject line."
X (interactive)
X (gnus-Subject-prev-subject t))
X
X;; Walking around subject lines with displaying articles.
X
X(defun gnus-Subject-configure-window ()
X "Use two window mode. One is for reading subjects and the other is article."
X (if (one-window-p t)
X (progn
X (switch-to-buffer gnus-Subject-display-buffer)
X (split-window-vertically (1+ gnus-subject-lines-height))
X (other-window 1)
X (gnus-Article-setup-buffer)
X (switch-to-buffer gnus-Article-display-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 article
X (progn
X (gnus-Subject-configure-window)
X (let ((window (selected-window)))
X (gnus-Article-prepare article all-header)
X (pop-to-buffer gnus-Article-display-buffer)
X (select-window window)
X (gnus-Subject-set-mode-line)))
X ))
X
X(defun gnus-Subject-select-article (&optional all-headers force)
X "Select current article.
XOptional 1st argument ALL-HEADERS is non-nil, show all headers.
XOptional 2nd argument FORCE is non-nil, force update."
X (let ((article (gnus-Subject-article-number)))
X (if (or force
X (null gnus-current-article)
X (/= article gnus-current-article))
X ;; Selected subject is different from current article's.
X (gnus-Subject-display-article article all-headers)
X (or (get-buffer-window gnus-Article-display-buffer)
X (gnus-Subject-configure-window))
X )
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 (unread
X (message "No more unread articles."))
X (t
X (message "No more articles."))
X ))
X
X(defun gnus-Subject-next-unread-article ()
X "Select unread article after current one."
X (interactive)
X (gnus-Subject-next-article t))
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 (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))
X
X(defun gnus-Subject-next-page ()
X "Show next page of selected article.
XIf end of artile, select next article."
X (interactive)
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-display-buffer
X (setq endp (gnus-Article-next-page)))
X (if endp
X (gnus-Subject-next-unread-article)))
X ))
X
X(defun gnus-Subject-prev-page ()
X "Show previous page of selected article."
X (interactive)
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-display-buffer
X (gnus-Article-prev-page))
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-digest ()
X "Move to head of next digested message."
X (interactive)
X (gnus-Subject-select-article)
X (eval-in-buffer-window gnus-Article-display-buffer
X (gnus-Article-next-digest)
X ))
X
X(defun gnus-Subject-prev-digest ()
X "Move to head of previous digested message."
X (interactive)
X (gnus-Subject-select-article)
X (eval-in-buffer-window gnus-Article-display-buffer
X (gnus-Article-prev-digest)
X ))
X
X(defun gnus-Subject-first-unread-article ()
X "Select first unread article."
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 )
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-display-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-display-buffer
X (beginning-of-buffer)
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-display-buffer
X (end-of-buffer)
X ))
X
X(defun gnus-Subject-goto-article (article)
X "Go to ARTICLE."
X (interactive (list
X (string-to-int
X (completing-read "NArticle number: "
X (mapcar
X '(lambda (headers)
X (list (int-to-string
X (nntp-headers-number headers))))
X gnus-current-group-headers)))))
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-show-all-headers ()
X "Show all article header."
X (interactive)
X (gnus-Subject-select-article t t))
X
X(defun gnus-Subject-kill-same-subject (no-select)
X "Mark articles which has the same subject as read.
XIf argument NO-SELECT is non-nil, next unread article is not selected."
X (interactive "P")
X (let* ((article (gnus-Subject-article-number))
X (cntl (format "^.[ \t]+%d:" article))
X (subject nil)
X (count 0))
X (save-excursion
X (goto-char (point-min))
X (if (re-search-forward cntl nil t)
X (progn
X (setq subject (gnus-Subject-subject-string))
X (gnus-Subject-mark-read article)
X (setq count (1+ count))
X (while (and subject
X (gnus-Subject-search-forward t subject))
X (gnus-Subject-mark-read (gnus-Subject-article-number))
X (setq count (1+ count)))
X ))
X )
X (if no-select
X (gnus-Subject-next-subject t)
X (gnus-Subject-next-unread-article))
X (message "%d articles are marked as read." count)
X ))
X
X(defun gnus-Subject-kill-same-subject-without-reading ()
X "Mark articles which has the same subject as read.
XDon't select article after that."
X (interactive)
X (gnus-Subject-kill-same-subject t))
X
X(defun gnus-Subject-mark-unread-forward (&optional article)
X "Mark current subject as unread, and then go forward.
XIf optional argument ARTICLE is non-nil, the ARTICLE rather than
Xcurrent is marked as unread."
X (interactive)
X (gnus-Subject-mark-unread (or article
X (gnus-Subject-article-number)))
X (gnus-Subject-next-subject nil))
X
X(defun gnus-Subject-mark-unread-backward (&optional article)
X "Mark current subject as unread, and then go backward.
XIf optional argument ARTICLE is non-nil, the ARTICLE rather than
Xcurrent is marked as unread."
X (interactive)
X (gnus-Subject-mark-unread (or article
X (gnus-Subject-article-number)))
X (gnus-Subject-prev-subject nil))
X
X(defun gnus-Subject-mark-unread (article)
X "Mark ARTICLE's subject as unread."
X (save-excursion
X (set-buffer gnus-Subject-display-buffer)
X (let ((buffer-read-only nil))
X (if (not (memq article gnus-current-group-unread-articles))
X (progn
X ;; Add to list.
X (setq gnus-current-group-unread-articles
X (cons article gnus-current-group-unread-articles))
X (if (gnus-Subject-goto-subject article)
X (progn
X (beginning-of-line)
X (delete-region (point) (1+ (point)))
X (insert " ")))
X ))
X )))
X
X(defun gnus-Subject-mark-read-forward (&optional article)
X "Mark current subject as read, and then go forward.
XIf optional argument ARTICLE is non-nil, the ARTICLE rather than
Xcurrent is marked as read."
X (interactive)
X (gnus-Subject-mark-read (or article
X (gnus-Subject-article-number)))
X (gnus-Subject-next-subject t))
X
X(defun gnus-Subject-mark-read-backward (&optional article)
X "Mark current subject as read, and then go backward.
XIf optional argument ARTICLE is non-nil, the ARTICLE rather than
Xcurrent is marked as read."
X (interactive)
X (gnus-Subject-mark-read (or article
X (gnus-Subject-article-number)))
X (gnus-Subject-prev-subject t))
X
X(defun gnus-Subject-mark-read (article)
X "Mark ARTICLE's subject as read."
X (save-excursion
X (set-buffer gnus-Subject-display-buffer)
X (let ((buffer-read-only nil))
X (if (memq article gnus-current-group-unread-articles)
X (progn
X ;; Remove from list.
X (setq gnus-current-group-unread-articles
X (delq article gnus-current-group-unread-articles))
X (if (gnus-Subject-goto-subject article)
X (progn
X (beginning-of-line)
X (delete-region (point) (1+ (point)))
X (insert "D")))
X ))
X )))
X
X(defun gnus-Subject-catch-up ()
X "Mark all articles in this news group as read."
X (interactive)
X (if (y-or-n-p "Do you really want to mark everything as read? ")
X (progn
X (setq gnus-current-group-unread-articles 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-post-news ()
X "Post a news article."
X (interactive)
X (gnus-Subject-select-article)
X (switch-to-buffer gnus-Article-display-buffer)
X (delete-other-windows)
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-display-buffer)
X (delete-other-windows)
X (gnus-news-reply))
X
X(defun gnus-Subject-cancel ()
X "Cancel an article you posted."
X (interactive)
X (gnus-Subject-select-article)
X (if (yes-or-no-p "Do you really want to cancel this article? ")
X (eval-in-buffer-window gnus-Article-display-buffer
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-display-buffer)
X (delete-other-windows)
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-display-buffer)
X (delete-other-windows)
X (news-mail-other-window))
X
X(defun gnus-Subject-rmail-output ()
X "Append this article to Unix mail file."
X (interactive)
X (gnus-Subject-select-article)
X (eval-in-buffer-window gnus-Article-display-buffer
X (call-interactively 'rmail-output))
X )
X
X(defun gnus-Subject-save-in-file ()
X "Append this article to file."
X (interactive)
X (gnus-Subject-select-article)
X (eval-in-buffer-window gnus-Article-display-buffer
X (append-to-file (point-min) (point-max)
X (read-file-name "Save article in file: ")))
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-display-buffer
X (shell-command-on-region (point-min) (point-max)
X (read-string "Shell command on article: ")
X nil))
X )
X
X(defun gnus-Subject-exit ()
X "Exit reading current news group, and then return to group selection mode."
X (interactive)
X (let ((updated nil))
X (gnus-update-unread-articles gnus-current-news-group
X gnus-current-group-unread-articles)
X (setq updated
X (gnus-mark-as-read-by-xref gnus-current-news-group
X gnus-current-group-headers
X gnus-current-group-unread-articles))
X ;; Return to Group selection mode.
X (if (get-buffer gnus-Subject-display-buffer)
X (bury-buffer gnus-Subject-display-buffer))
X (if (get-buffer gnus-Article-display-buffer)
X (bury-buffer gnus-Article-display-buffer))
X (switch-to-buffer gnus-Group-display-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-news-group)
X (gnus-Group-next-unread-group)
X ))
X
X(defun gnus-Subject-quit ()
X "Quit reading current news group 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-display-buffer)
X (bury-buffer gnus-Subject-display-buffer))
X (if (get-buffer gnus-Article-display-buffer)
X (bury-buffer gnus-Article-display-buffer))
X (switch-to-buffer gnus-Group-display-buffer)
X (delete-other-windows)
X (gnus-Group-next-unread-group)
X )))
X
X
X;;;
X;;; GNUS Article display mode
X;;;
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 " " 'scroll-up)
X (define-key gnus-Article-mode-map "\177" 'scroll-down)
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
XEntry to this mode calls the value of gnus-Article-mode-hook with no arguments,
Xif that value is non-nil."
X (interactive)
X (kill-all-local-variables)
X (setq major-mode 'gnus-Article-mode)
X (setq mode-name "GNUS")
X (gnus-Article-set-mode-line)
X (use-local-map gnus-Article-mode-map)
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 (save-excursion
X (if (get-buffer gnus-Article-display-buffer)
X nil
X (set-buffer (get-buffer-create gnus-Article-display-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 (gnus-Article-setup-buffer)
X (set-buffer gnus-Article-display-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 ;; Set article pointer.
X (setq gnus-previous-article gnus-current-article)
X (setq gnus-current-article article)
X (if (not (eq gnus-previous-article gnus-current-article))
X (gnus-Subject-mark-read gnus-current-article))
X ;; Next function must be called after setting
X ;; `gnus-current-article' variable.
X (gnus-Article-set-mode-line)
X )
X (gnus-Subject-mark-read article)
X (error "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-prepare gnus-current-article t))
X
X(defun gnus-Article-set-mode-line ()
X "Set Article mode line string."
X (setq mode-line-process
X (concat " "
X (if (integerp gnus-current-article)
X (int-to-string gnus-current-article)
X "??")
X "/"
X (if (integerp gnus-current-group-end)
X (int-to-string gnus-current-group-end)
X gnus-current-group-end)))
X (setq mode-line-buffer-identification
X (concat "GNUS: "
X gnus-current-news-group
X ;; Enough spaces to pad group name to 17 positions.
X (substring " "
X 0 (max 0 (- 17 (length gnus-current-news-group))))))
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 (kill-line 1) ;Kill NNTP status message.
X (let* ((start (point))
X (end (condition-case ()
X (progn (search-forward "\n\n") (point))
X (error nil)))
X (has-from nil)
X (has-date nil))
X (if end
X (progn
X (narrow-to-region start end)
X (goto-char start)
X (setq has-from (search-forward "\nFrom:" nil t))
X (goto-char start)
X (setq has-date (search-forward "\nDate:" nil t))
X (if (and (not has-from) has-date)
X (progn
X (goto-char start)
X (search-forward "\nDate:")
X (beginning-of-line)
X (kill-line 1)))
X (if (not all-headers)
X (gnus-Article-delete-headers start))
X ))
X ))))
X
X(defun gnus-Article-delete-headers (pos)
X "Delete unnecessary headers."
X (goto-char pos)
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 ()
X "Show next page of current article.
XIf end of article, return T. Otherwise return nil."
X (move-to-window-line -1)
X (if (eobp)
X t
X (scroll-up)
X nil
X ))
X
X(defun gnus-Article-prev-page ()
X "Show previous page of current article."
X (scroll-down))
X
X(defun gnus-Article-next-digest ()
X "Move to head of next digested message.
XSet mark at end of digested message."
X (end-of-line)
X (if (re-search-forward "^Subject:[ \t]" nil t)
X (let ((begin (progn
X (beginning-of-line) (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 (message "End of message.")
X ))
X
X(defun gnus-Article-prev-digest ()
X "Move to head of previous digested message."
X (beginning-of-line)
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 (pop-to-buffer gnus-Subject-display-buffer)
X (delete-other-windows)
X (gnus-Subject-configure-window))
X
X
X;;;
X;;; General functions.
X;;;
X
X(defun gnus-start-news-server (&optional ask-host)
X "Open network stream to remote news server.
XIf optional argument ASK-HOST is non-nil, ask you host name that news
Xserver is running even if it is defined."
X (if (and nntp-server-process
X (eq (process-status nntp-server-process) 'open))
X ;; Stream is already opened.
X nil
X ;; Make sure the stream is closed.
X (if nntp-server-process
X (nntp-close-server-internal))
X (if (or ask-host
X (null gnus-server-host))
X (setq gnus-server-host
X (read-string "News Server host: " gnus-server-host)))
X ;; Actually open news server.
X (message "Connecting to News Server on %s" gnus-server-host)
X (if (null (nntp-open-server gnus-server-host))
X (error "Cannot open News Server on %s" gnus-server-host))
X ))
X
X(defun gnus-select-news-group (group &optional show-all)
X "Select news 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 ((unread (assoc group gnus-unread-assoc)))
X (setq gnus-current-news-group group)
X (if show-all
X ;; Select all active articles.
X (let ((active (assoc group gnus-active-assoc)))
X (setq gnus-current-group-begin (car (nth 2 active)))
X (setq gnus-current-group-end (cdr (nth 2 active)))
X (setq gnus-current-group-articles
X (gnus-uncompress-sequence (nthcdr 2 active)))
X )
X ;; Select unread articles only.
X (setq gnus-current-group-begin (car (nth 2 unread)))
X (setq gnus-current-group-end (cdr (car (reverse (nthcdr 2 unread)))))
X (setq gnus-current-group-articles
X (gnus-uncompress-sequence (nthcdr 2 unread)))
X )
X ;; Reset article pointer and etc.
X (setq gnus-current-article nil)
X (setq gnus-previous-article nil)
X (setq gnus-current-group-unread-articles
X (gnus-uncompress-sequence (nthcdr 2 unread)))
X (setq gnus-current-group-headers
X (nntp-retrieve-headers gnus-current-group-articles))
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-active-assoc nil)
X (setq gnus-newsrc-assoc nil)
X (setq gnus-unread-assoc nil)
X ;; Kill buffers
X (if (get-buffer gnus-Article-display-buffer)
X (kill-buffer gnus-Article-display-buffer))
X (if (get-buffer gnus-Subject-display-buffer)
X (kill-buffer gnus-Subject-display-buffer))
X (if (get-buffer gnus-Group-display-buffer)
X (kill-buffer gnus-Group-display-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 (process-buffer nntp-server-process))
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.
X ;; (string-match "([ \t]*in[ \t]+.*)" subject)
X (while (string-match "(.*)" subject)
X (setq subject (concat (substring subject 0 (match-beginning 0))
X (substring subject (match-end 0))))
X )
X ;; Return subject string.
X subject
X ))
X
X
X;;;
X;;; Get information about active articles, already read articles, and
X;;; still unread articles.
X;;;
X
X;; GNUS internal format of gnus-newsrc-assoc:
X;; (("general" t (1 . 1))
X;; ("misc" t (1 . 10) (12 . 15))
X;; ("test" nil (1 . 99)) ...)
X;; GNUS internal format of gnus-active-assoc:
X;; (("general" t (1 . 1))
X;; ("misc" t (1 . 10))
X;; ("test" nil (1 . 99)) ...)
X;; GNUS internal format of gnus-unread-assoc:
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 (if (and gnus-active-assoc
X gnus-newsrc-assoc
X gnus-unread-assoc
X (not force))
X (progn
X ;; Re-read active file only.
X (gnus-read-active-file)
X (gnus-add-new-news-group)
X (gnus-get-unread-articles))
X ;; Read .newsrc file and active file.
X (setq gnus-current-startup-file (gnus-make-newsrc-file gnus-startup-file))
X (gnus-read-newsrc-file)
X (gnus-read-active-file)
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 nil)
X (group-name nil)
X (active nil)
X (range nil)
X (unread nil))
X (message "Checking new news...")
X (while read
X (setq group (car read)) ;About one news group
X (setq group-name (car group))
X (setq active (nth 2 (assoc group-name gnus-active-assoc)))
X (if (and (not (null gnus-octive-assoc))
X (equal active (nth 2 (assoc group-name gnus-octive-assoc))))
X ;; There are no changes in this news group, so use old info.
X (setq unread (cons (assoc group-name gnus-unread-assoc) unread))
X (setq range (gnus-difference-of-range active (nthcdr 2 group)))
X (setq unread
X (cons (cons group-name ;Group name
X (cons (gnus-number-of-articles range)
X range)) ;Range of unread articles
X unread))
X )
X (setq read (cdr read))
X )
X (setq gnus-unread-assoc (nreverse unread))
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 news group."
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-headers-number header) unreads)
X ;; This article is not yet marked as read.
X nil
X (setq xrefs (gnus-parse-xref-field (nntp-headers-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 '(lambda (elt) (car elt)) 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 (assoc group gnus-unread-assoc))))
X (while idlist
X (setq unread (delq (car idlist) unread))
X (setq idlist (cdr idlist)))
X (gnus-update-unread-articles group unread)
X (setq xrefs (cdr xrefs))
X )))
X
X(defun gnus-update-unread-articles (group unread-list)
X "Update unread article information of news GROUP using UNREAD-LIST."
X (let ((active (nth 2 (assoc group gnus-active-assoc)))
X (unread (assoc group gnus-unread-assoc)))
X ;; Update gnus-unread-assoc.
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 ))
X
X(defun gnus-compress-sequence (numbers)
X "Convert list of sorted numbers to ranges."
X (let* ((numbers (sort (copy-sequence numbers) '<)) ;Sort is destructive.
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 news group to gnus-newsrc-assoc."
X (let ((active (reverse gnus-active-assoc))
X (group nil))
X (while active
X (setq group (car (car active)))
X (if (null (assoc group gnus-newsrc-assoc))
X ;; Found new news group.
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 news group: %s is subscribed." group))
X ))
X (setq active (cdr active))
X )))
X
X;;(defun gnus-clean-up-newsrc ()
X;; "Mark as read expired articles."
X;; (let ((newsrc gnus-newsrc-assoc)
X;; (group nil))
X;; (message "Checking expired articles...")
X;; (while newsrc
X;; (setq group (car (car newsrc))) ;News group name
X;; (setq newsrc (cdr newsrc))
X;; (if (assoc group gnus-active-assoc) ;Must be active group
X;; (gnus-update-unread-articles
X;; group (gnus-uncompress-sequence
X;; (nthcdr 2 (assoc group gnus-unread-assoc)))))
X;; )
X;; (gnus-make-newsrc-buffer)
X;; (message "Checking expired articles... Done.")
X;; ))
X
X(defun gnus-delete-bogus-news-group (&optional confirm)
X "Delete bogus news group.
XIf optional argument CONFIRM is non-nil, confirm deletion of news groups."
X (let ((oldrc gnus-newsrc-assoc)
X (newsrc nil))
X (message "Checking bogus news groups...")
X (while oldrc
X (if (or (assoc (car (car oldrc)) gnus-active-assoc)
X (and confirm
X (not (y-or-n-p (format "Delete bogus news group: %s "
X (car (car oldrc)))))))
X ;; Active news group.
X (setq newsrc (cons (car oldrc) newsrc))
X ;; Found bogus news group.
X (gnus-update-newsrc-buffer (car (car oldrc)) 'delete))
X (setq oldrc (cdr oldrc))
X )
X ;; Update newsrc.
X (setq gnus-newsrc-assoc (nreverse newsrc))
X (message "Checking bogus news groups... Done.")
X ))
X
X(defun gnus-read-active-file ()
X "Get active file from news server."
X (save-excursion
X (message "Reading active file...")
X (if (nntp-request-list) ;Get active file from server
X (progn
X ;; Save OLD active info.
X (setq gnus-octive-assoc gnus-active-assoc)
X ;; Take care of unexpected situations.
X (gnus-copy-to-buffer " *GNUS-active*")
X (goto-char (point-min))
X (kill-line 1) ;Kill NNTP status message.
X (gnus-active-to-gnus-format)
X ;; Define variable gnus-active-assoc.
X (eval-current-buffer)
X (kill-buffer (current-buffer))
X (message "Reading active file... Done.")
X )
X (error "Cannot read active file from news server."))
X ))
X
X(defun gnus-active-to-gnus-format ()
X "Convert NNTP active file format to internal format.
XBuffer becomes evaluable as lisp expression."
X ;; Delete unnecessary lines.
X (goto-char (point-min))
X (delete-matching-lines "^to\\..*$")
X ;; Process each lines.
X (goto-char (point-min))
X (while (not (eobp))
X (if (re-search-forward "^\\([^ \t]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([ymn]\\).*$" nil t)
X (replace-match
X (concat "(\"\\1\""
X (if (string-equal "y" (buffer-substring (match-beginning 4)
X (match-end 4)))
X " t " " nil ")
X "(\\3 . \\2))"))
X (error "Active format error."))
X (forward-line 1))
X ;; Make the buffer evaluable.
X (goto-char (point-min))
X (insert "(setq gnus-active-assoc '(\n")
X (goto-char (point-max))
X (insert "))\n")
X )
X
X(defun gnus-read-newsrc-file ()
X "Read in .newsrc FILE."
X (save-excursion
X ;; If there exists site dependent .newsrc file (.newsrc-HOST), use
X ;; it instead of standard .newsrc file.
X (let* ((newsrc-file gnus-current-startup-file)
X (quick-file (concat newsrc-file ".el"))
X (newsrc-mod (nth 5 (file-attributes newsrc-file)))
X (quick-mod (nth 5 (file-attributes quick-file))))
X ;; Reset variables.
X (setq gnus-newsrc-options nil)
X (setq gnus-newsrc-assoc nil)
X (cond ((not (file-exists-p newsrc-file)))
X ;; Some older version does not support function
X ;; `file-newer-than-file-p'.
X ((and newsrc-mod quick-mod
X ;; .newsrc.el is newer than .newsrc.
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 ;; Load quick .newsrc
X (condition-case nil
X (progn (load-file quick-file) (message "") t)
X (error nil))
X gnus-newsrc-assoc
X ))
X (t
X (message "Reading %s..." newsrc-file)
X (set-buffer (get-buffer-create " *GNUS-newsrc*"))
X (erase-buffer)
X (insert-file 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 complicated, or erroneous lines included in %s"
X newsrc-file))
X )
X (kill-buffer (current-buffer))
X (message "Reading %s... Done." newsrc-file))
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 news group.
X (goto-char (point-min))
X (replace-regexp "\\(^.*\\):\\(.*\\)$" "(\"\\1\" t . \\2)")
X ;; Process UnSubscribed news group.
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 ;; If there exists site dependent .newsrc file (.newsrc-HOST), use
X ;; it instead of standard .newsrc file.
X (message "Saving %s..." gnus-current-startup-file)
X (set-buffer (find-file-noselect gnus-current-startup-file))
X (let ((make-backup-files t)
X (version-control nil))
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 (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 ;; 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 ")"))
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;;(defun gnus-make-newsrc-buffer ()
X;; "Update .newsrc buffer completely."
X;; (save-excursion
X;; (set-buffer (find-file-noselect gnus-current-startup-file))
X;; (erase-buffer)
X;; (gnus-gnus-to-newsrc-format)
X;; ))
X;;
X;;(defun gnus-gnus-to-newsrc-format ()
X;; "Convert gnus-newsrc-assoc to .newsrc format."
X;; (let ((newsrc gnus-newsrc-assoc)
X;; (group nil))
X;; ;; Options line.
X;; (if gnus-newsrc-options
X;; (insert "options " gnus-newsrc-options "\n"))
X;; ;; Article information.
X;; (while newsrc
X;; (setq group (car newsrc))
X;; (insert (car group) ;Group name
X;; (if (nth 1 group) ;Subscribed?
X;; ": " "! "))
X;; (gnus-ranges-to-newsrc-format (nthcdr 2 group)) ;Read articles
X;; (insert "\n")
X;; (setq newsrc (cdr newsrc))
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 JUNET.
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 JUNET? ")
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 (= 0 (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 JUNET 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 JUNET? ")
X (let ((buffer (current-buffer))
X (subject nil)
X (newsgroups nil)
X (distribution nil))
X (save-restriction
X (and (not (= 0 (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 news group names are required for
X ;; completing read of news group.
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 (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 (news-server nntp-server-process)) ;Current news server process
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 news server.
X ;; News 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 JUNET...")
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 (gnus-inews)
X ;;
X (message "Posting to JUNET... done")
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 news server is opened by `news-inews', close it by myself.
X (or news-server
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 (lines 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 signature)))
X ;; Count lines of article body.
X (goto-char (point-min))
X (search-forward "\n\n")
X (setq lines (count-lines (point) (point-max)))
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 lines))
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]*|\\(.*\\)\\'" 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 ;;(message "Piping out article to program: %s" program)
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 ;;(message "Saving article copy to file: %s"
X ;; gnus-author-copy-file)
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 (message "Sending your article...")
X (if (nntp-request-post)
X (message "Sending your article... Done.")
X (message "Your article is rejected."))
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 (concat (gnus-inews-login-name) "@"
X (gnus-inews-domain-name)))))
X (message "The article is 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 0)
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 (lines)
X "Prepare article headers."
X (save-excursion
X (let* ((login-name (gnus-inews-login-name))
X (domain-name (gnus-inews-domain-name))
X (full-name (or (getenv "NAME")
X (user-full-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")
X 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: " login-name "@" domain-name
X (if (or (string-equal full-name "")
X (string-equal full-name "&"))
X "\n"
X (concat " (" 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 "Date: " (gnus-inews-date) "\n"
X "Organization: " organization "\n"
X "Lines: " (int-to-string lines) "\n"
X )
X (or (mail-fetch-field "distribution")
X (insert "Distribution: \n"))
X )))
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 ()
X "Return user's domain name"
X (let ((domain (or (getenv "DOMAINNAME")
X gnus-your-domain)))
X (if (or (null domain)
X (string-equal domain ""))
X (progn
X (setq domain (read-string "Your domain name (no host): "))
X (setq gnus-your-domain domain)))
X (concat (system-name)
X ;; Host name and domain name must be separated by
X ;; one period `.'.
X (if (string-equal "." (substring domain 0 1)) "" ".")
X domain
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 (number (random t)))
X ;;(if (< number 0) (setq number (- 0 number)))
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) "." ;(int-to-string number)
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 "GNUS: cannot understand current-time-string: %s." date))
X ))
X
X(defun gnus-inews-date ()
X "News format date string of today."
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 (gnus-unix-time-to-gmtime
X gnus-your-time-zone
X (substring date (match-beginning 3) (match-end 3))) ;Time
X " GMT")
X (error "GNUS: cannot understand current-time-string: %s." date))
X ))
X
X(defun gnus-unix-time-to-gmtime (time-zone time)
X "Convert unix time to GM time."
X (if (string-match "^\\([0-9]+\\):\\(.*\\)$" time)
X (concat
X (format "%02d"
X (+ time-zone (string-to-int (substring time
X (match-beginning 1)
X (match-end 1)))))
X ":"
X (substring time
X (match-beginning 2)
X (match-end 2)))
X (error "GNUS: cannot understand `%s' as unix time format." time)
X ))
X
X
X;;Local variables:
X;;eval: (put 'eval-in-buffer-window 'lisp-indent-hook 1)
X;;end:
*-*-END-of-gnus.el-*-*
--
Masanobu UMEDA
umerin@flab.flab.Fujitsu.JUNET
umerin%flab.flab.Fujitsu.JUNET@uunet.uu.NETumerin@flab.flab.fujitsu.JUNET (Masanobu UMEDA) (05/25/88)
: This is a shar archive. Extract with sh, not csh. : The rest of this file will extract: : nntp.el echo x nntp.el sed 's/^X//' > nntp.el << '*-*-END-of-nntp.el-*-*' X;;; NNTP (RFC977) Interface for GNU Emacs X;; Copyright (C) 1987, 1988 Fujitsu Laboratoris LTD. X;; Copyrigth (C) 1987, 1988 Masanobu UMEDA (umerin@flab.flab.Fujitsu.JUNET) X;; $Header: nntp.el,v 3.0 88/05/25 12:55:09 umerin Locked $ 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;; Select routine may signal an error or fall into infinite loop while X;; waiting for server response. In this case, you'd better not use X;; byte-compiled code but original source. If you still have a X;; trouble with it, set variable `nntp-buggy-select' to T. 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-server-process nil X "NNTP news server process.") X X;; Retrieving lots of headers by sending command asynchronously. X;; Access functions to headers are defined as macro. X X(defmacro nntp-headers-number (headers) X "Return article number in HEADERS." X (` (car (, headers)))) X X(defmacro nntp-headers-subject (headers) X "Return subject string in HEADERS." X (` (nth 1 (, headers)))) X X(defmacro nntp-headers-from (headers) X "Return author string in HEADERS." X (` (nth 2 (, headers)))) X X(defmacro nntp-headers-xref (headers) X "Return xref string in HEADERS." X (` (nth 3 (, headers)))) 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) ...)'. XNews group must be selected before calling me." X (save-excursion X (set-buffer (process-buffer nntp-server-process)) X (erase-buffer) X (let ((number (length sequence)) X (headers nil) ;Hold result list X (article 0) X (subject nil) X (xref nil) X (from nil) X (last-point (point-min)) X (count 0)) X ;; Send HEAD command. X (while sequence X (nntp-send-strings-to-server "HEAD" (car sequence)) X (setq sequence (cdr sequence)) X ;; Every 200 header requests we have to read stream in order X ;; to avoid deadlock. X (setq count (1+ count)) X (if (zerop (% count 200)) X (nntp-accept-response)) X ) X ;; Wait for completion of reply. X ;; We cannot do X ;;(nntp-accept-response) X ;; since all of replies may be accepted. X (accept-process-output) X (setq count 0) X (while (progn X (goto-char last-point) X (setq count (+ count (nntp-count-reply "^[0-9]"))) X (< count number)) X (setq last-point (point)) X ;; If number of headers is greater than 100, give informative X ;; messages. X (if (and (> number 100) X (zerop (% count 20))) X (message "NNTP: %d%% of headers received." X (/ (* count 100) number))) X (nntp-accept-response)) 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 recieved. X ;; First, delete unnecessary lines. X (goto-char (point-min)) X (delete-non-matching-lines X "^Subject:[ \t]\\|^Xref:[ \t]\\|^From:[ \t]\\|^[23]") X ;; Then examines replies. X (while (not (eobp)) X (cond ((looking-at "^[23].*[ \t]+\\([0-9]+\\)[ \t]+") ;Article exists. X (setq article (string-to-int X (buffer-substring (match-beginning 1) X (match-end 1)))) X (forward-line 1) X (setq subject nil) X (setq xref nil) X (setq from nil) X ;; It is better to extract From:, Subject: and Xref: X ;; field values in this order. X (while (looking-at "^[^23]") X (if (looking-at "^From:[ \t]\\(.*\\)\r$") X (progn X ;; Extract From: field. 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 ;; Extract Subject: field. X (setq subject (buffer-substring (match-beginning 1) X (match-end 1))) X (forward-line 1))) X (if (looking-at "^Xref:[ \t]\\(.*\\)\r$") X (progn X ;; Extract Xref: field. 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 (list article subject from xref) headers)) X ) X (t X (error "NNTP: Recieve error on line: %s" X (buffer-substring X (point) X (save-excursion (end-of-line) (point)))) X ))) X (nreverse headers) X ))) X X(defun nntp-count-reply (regexp) X "Count matches for REGEXP from point." X (let ((count 0)) X (while (and (not (eobp)) X (re-search-forward regexp nil 'move)) X (setq count (1+ count)) X ) X ;; Return count X count 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 (if (nntp-open-server-internal host service) X (progn X ;; Do check unexpected close of connection. X ;; Suggested by feldmark@hanako.stars.flab.fujitsu.junet. X (set-process-sentinel nntp-server-process 'nntp-default-sentinel) X (nntp-wait-for-response "^[23].*\r$") 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 (if (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 (memq (process-status nntp-server-process) '(run open)) 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-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 (eq (process-status nntp-server-process) 'closed)) 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. 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 (process-buffer nntp-server-process)) X ;; Insert newline at end of buffer. X (goto-char (point-max)) X (if (not (bolp)) X (insert "\n")) X ;; Delete `^M' at end of line. X (goto-char (point-min)) 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 (process-buffer nntp-server-process)) 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 (process-buffer nntp-server-process)) 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 (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 recieved 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 (save-excursion X ;; Clear communication buffer. X (set-buffer (process-buffer nntp-server-process)) X (erase-buffer)) X (copy-to-buffer (process-buffer nntp-server-process) begin end) X ;; We have to work on the buffer associated with NNTP server X ;; process because of NEmacs hack. X (set-buffer (process-buffer nntp-server-process)) 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 ;; Initialize communication buffer. X (set-buffer (get-buffer-create " *nntpd*")) 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 ;; You can change kanji-fileio-code in hooks. 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 (delete-process nntp-server-process) 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 (message "NNTP: Reading...") X (sleep-for 1) X (message "")) X (accept-process-output nntp-server-process) X )) *-*-END-of-nntp.el-*-* -- Masanobu UMEDA umerin@flab.flab.Fujitsu.JUNET umerin%flab.flab.Fujitsu.JUNET@uunet.uu.NET