umerin@flab.flab.fujitsu.JUNET (Masanobu UMEDA) (02/02/88)
This is 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. Any comment, suggestion, and bug fix are
welcome. (Do not forget installing `nntp.el'.)
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 2.0 88/02/02 10:02:32 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 nil
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-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-environment-file "~/.gnus-environ.el"
X "File name to save environment of GNUS current session.")
X
X(defvar gnus-environ-sequence-number nil
X "Message id of article you will post. You should not change the value.")
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-Group-display-buffer "*Newsgroup*")
X(defvar gnus-Subject-display-buffer "*Subject*")
X(defvar gnus-Article-display-buffer "*Article*")
X
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-no-article)
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-no-article] 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.
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 "GNUS Newsgroup")
X (setq mode-name (concat "GNUS " gnus-server-host))
X (setq mode-line-buffer-identification "GNUS: List of Newsgroups")
X ;;(make-local-variable 'revert-buffer-function)
X ;;(setq revert-buffer-function 'gnus-Group-revert-buffer)
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 2.0
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 ;; 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 (if (or all
X (and (> (nth 1 group) 0) ;There are unread articles.
X (nth 1 (assoc (car group) gnus-newsrc-assoc))))
X (progn
X (insert
X (format cntl
X ;; Subscribed or not.
X (if (nth 1 (assoc (car group) gnus-newsrc-assoc))
X " " "U")
X ;; Number of unread articles.
X (nth 1 group)
X ;; News group name.
X (car group)))
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 (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) (kill-line) ;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-no-article (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-clean-up-newsrc))
X
X(defun gnus-Group-force-update ()
X "Update .newsrc file."
X (interactive)
X (gnus-save-newsrc-file gnus-startup-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 gnus-startup-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" '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-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 "GNUS Subject")
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 ;; 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") ;Subscribed 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 ;; 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-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-configure-window)
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-configure-window)
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 (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 (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 (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-display-article gnus-current-article t))
X
X(defun gnus-Subject-kill-same-subject ()
X "Mark articles which has the same subject as read."
X (interactive)
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 (gnus-Subject-next-unread-article)
X (message "%d articles are marked as read." count)
X ))
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 (if (get-buffer gnus-Article-display-buffer)
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 (if (get-buffer gnus-Article-display-buffer)
X (switch-to-buffer gnus-Article-display-buffer)
X (gnus-Subject-display-article (gnus-Subject-article-number))
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 (if (get-buffer gnus-Article-display-buffer)
X (display-buffer gnus-Article-display-buffer)
X (gnus-Subject-display-article (gnus-Subject-article-number)))
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 (if (get-buffer gnus-Article-display-buffer)
X (switch-to-buffer gnus-Article-display-buffer)
X (gnus-Subject-display-article (gnus-Subject-article-number))
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 (if (get-buffer gnus-Article-display-buffer)
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 (if (get-buffer gnus-Article-display-buffer)
X (save-excursion
X (set-buffer gnus-Article-display-buffer)
X (call-interactively 'rmail-output))
X ))
X
X(defun gnus-Subject-save-in-file (file)
X "Append this article to FILE."
X (interactive "FSave article in file: ")
X (if (get-buffer gnus-Article-display-buffer)
X (save-excursion
X (set-buffer gnus-Article-display-buffer)
X (append-to-file (point-min) (point-max) file))
X ))
X
X(defun gnus-Subject-pipe-output (command)
X "Pipe this article to COMMAND subprocess."
X (interactive "sShell command on article: ")
X (if (not (get-buffer gnus-Article-display-buffer))
X (gnus-Subject-display-article (gnus-Subject-article-number)))
X (eval-in-buffer-window gnus-Article-display-buffer
X (shell-command-on-region (point-min) (point-max) command 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) (kill-line) ;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) (kill-line)))
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 (not (nntp-request-group group))
X ;; No such news group.
X nil
X (setq gnus-current-news-group group)
X (if show-all
X (progn
X ;; Select all active articles.
X (setq gnus-current-group-begin
X (car (nth 2 (assoc group gnus-active-assoc))))
X (setq gnus-current-group-end
X (cdr (nth 2 (assoc group gnus-active-assoc))))
X (setq gnus-current-group-articles
X (gnus-uncompress-sequence
X (nthcdr 2 (assoc group gnus-active-assoc))))
X )
X ;; Select unread articles only.
X (setq gnus-current-group-begin
X (car (nth 2 (assoc group gnus-unread-assoc))))
X (setq gnus-current-group-end
X (cdr (car (reverse
X (nthcdr 2 (assoc group gnus-unread-assoc))))))
X (setq gnus-current-group-articles
X (gnus-uncompress-sequence
X (nthcdr 2 (assoc group gnus-unread-assoc))))
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
X (nthcdr 2 (assoc group gnus-unread-assoc))))
X (setq gnus-current-group-headers
X (nntp-retrieve-headers gnus-current-group-articles))
X ;; GROUP is selected.
X t
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 (1- (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 (gnus-read-newsrc-file gnus-startup-file)
X (gnus-read-active-file)
X (gnus-add-new-news-group)
X (gnus-get-unread-articles)
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 (range nil)
X (unread nil))
X (message "Checking new news...")
X (while read
X (setq group (car read)) ;About one news group
X (setq range (gnus-difference-of-range
X (nth 2 (assoc (car group) gnus-active-assoc))
X (nthcdr 2 group)))
X (setq unread
X (cons (cons (car group) ;Group name
X (cons (gnus-number-of-articles range)
X range)) ;Range of unread articles
X unread))
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 (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 (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 (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 ;; Take care of unexpected situations.
X (gnus-copy-to-buffer " *GNUS-active*")
X (goto-char (point-min))
X (kill-line) (kill-line) ;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 (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 (if (file-exists-p (expand-file-name
X (concat file "-" gnus-server-host) nil))
X (setq file (concat file "-" gnus-server-host)))
X (let* ((newsrc-file (expand-file-name file nil))
X (quick-file (expand-file-name (concat file ".el") nil))
X (newsrc-mod (nth 5 (file-attributes newsrc-file)))
X (quick-mod (nth 5 (file-attributes quick-file))))
X (setq gnus-newsrc-options nil) ;Clear options line.
X (cond ((not (file-exists-p newsrc-file))
X ;; No read articles.
X (setq gnus-newsrc-assoc nil))
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 (load-file quick-file)
X (message ""))
X (t
X (message "Reading %s..." file)
X (set-buffer (get-buffer-create " *GNUS-newsrc*"))
X (insert-file newsrc-file)
X (gnus-newsrc-to-gnus-format)
X ;; Define variable gnus-newsrc-assoc.
X (eval-current-buffer)
X (kill-buffer (current-buffer))
X (message "Reading %s... Done." 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) (kill-line) ;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 (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 (if (file-exists-p (expand-file-name
X (concat file "-" gnus-server-host) nil))
X (setq file (concat file "-" gnus-server-host)))
X (message "Saving %s..." file)
X (set-buffer (get-buffer-create " *GNUS-newsrc*"))
X ;; Row .newsrc.
X (erase-buffer)
X (gnus-gnus-to-newsrc-format)
X (write-file (expand-file-name file nil))
X ;; Quickly accessible .newsrc.
X (erase-buffer)
X (gnus-gnus-to-quick-newsrc-format)
X (write-file (expand-file-name (concat file ".el") nil))
X (kill-buffer (current-buffer))
X (message "Saving %s... Done." file)
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-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 (assoc (car group) gnus-newsrc-assoc)) ;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(defun gnus-ranges-to-newsrc-format (ranges)
X "Insert ranges of read articles."
X (let ((range nil)) ;Range is a pair of BEGIN and END.
X (while ranges
X (setq range (car ranges))
X (setq ranges (cdr ranges))
X (cond ((= (car range) (cdr range))
X (if (= (car range) 0)
X (setq ranges nil) ;No unread articles.
X (insert (int-to-string (car range)))
X (if ranges (insert ","))
X ))
X (t
X (insert (int-to-string (car range))
X "-"
X (int-to-string (cdr range)))
X (if ranges (insert ","))
X ))
X )))
X
X
X;;;
X;;; Post A News using NNTP
X;;;
X
X(defun gnus-news-reply ()
X "Compose and post a reply (aka a followup) to the current article on 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 ;; This feature is 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 ;; This feature is 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 gnus-startup-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 ;; This feature is 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 ;; This feature is 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 ;; This feature is 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 ;; This feature is 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 ;; This feature is 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 ;; Create 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 (concat (upcase login-name)
X ".GNUS"
X (int-to-string (gnus-inews-gensym))))
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 ;; Message-ID is catenation of user's login name, slash (/),
X ;; user's sequcne number, at sign (@) and user's domain name.
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-gensym ()
X "Generate next sequence number of article."
X (let ((env-file (expand-file-name gnus-environment-file nil)))
X ;; If there exits environment file, we have to load it every time
X ;; because it may be shared by concurrently running Emacses.
X (if (file-exists-p env-file)
X (progn
X ;; Restore previous session status.
X ;; The file will setq `gnus-environ-sequence-number'.
X (load-file env-file)
X (message "")))
X ;; Initialize only once.
X (if (or (not (boundp 'gnus-environ-sequence-number))
X (null gnus-environ-sequence-number))
X (setq gnus-environ-sequence-number 0))
X ;; Increment sequnce number.
X (setq gnus-environ-sequence-number
X (1+ gnus-environ-sequence-number))
X ;; We have to save the sequence number every time because there
X ;; may be no chance to save it else where.
X (save-excursion
X (set-buffer (get-buffer-create " *GNUS-environemnt*"))
X (erase-buffer)
X (insert ";; You should not change this file.\n"
X (format "(setq gnus-environ-sequence-number %d)"
X gnus-environ-sequence-number))
X (write-file env-file)
X (message "")
X (kill-buffer (current-buffer)))
X ;; Return sequence number
X gnus-environ-sequence-number
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 "Invalid date format."))
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 "Invalid time format.")
X ))
X
X
X;;Local variables:
X;;eval: (put 'eval-in-buffer-window 'lisp-indent-hook 1)
X;;end:
*-*-END-of-gnus.el-*-*
exit 0
--
Masanobu UMEDA
umerin@flab.flab.Fujitsu.JUNET
umerin%flab.flab.Fujitsu.JUNET@uunet.uu.NETumerin@flab.flab.fujitsu.JUNET (Masanobu UMEDA) (02/02/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 2.0 88/02/02 10:01:52 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 depends on 1.2a NNTP software bundled with X;; 4.3BSD. X X(provide 'nntp) X X(defvar nntp-server-process nil X "NNTP news server process.") 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(defconst nntp-magic-tick 10 X "Number of time waiting for server response using `accept-process-output'. XThe value strongly depends on your machine and news server Xperformance. It is recommended to re-define it in site-init.el or your X.emacs file. X XOptimal values for well-known machines are as follows: X X SUN3/260: 10 X S-3500 UTS: 1") 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 (let ((number (length sequence)) X (headers nil) ;Hold result list X (article 0) X (subject nil) X (xref nil) X (from nil) X (count 0)) X (set-buffer (process-buffer nntp-server-process)) X (erase-buffer) X ;; Send HEAD command. X (while sequence X (nntp-send-strings-to-server "HEAD" (car sequence)) X (setq sequence (cdr sequence))) X ;; Wait for completion of reply. X (sleep-for 1) X ;;(accept-process-output) X (goto-char (point-min)) X (while (< (nntp-count-reply "^[0-9]") number) X ;;(message "Reading...: %d" count) X ;; I'm not sure which is the fastest way to wait for X ;; completion of request, sleep-for or accept-process-output. X (if (or (> count nntp-magic-tick) X (> number 10)) X (progn X ;; Fujitsu UTS requires the next code. I don't know why? X ;; Usg-unix-v which supports TCP/IP stream is assumed as X ;; Fujitsu UTS system. X (if (eq system-type 'usg-unix-v) X (message "Reading...")) X (sleep-for 1) X (if (eq system-type 'usg-unix-v) X (message ""))) X (setq count (1+ count)) X (accept-process-output)) X (goto-char (point-min)) X ) X ;; Wait for text of last command. X (goto-char (point-max)) X (re-search-backward "^[0-9]") X (if (looking-at "^[23]") X (while (progn X (goto-char (- (point-max) 3)) X (not (looking-at "^\\.\r$"))) X ;;(sleep-for 1) X (accept-process-output) X )) 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 (and subject from) X (setq headers X (cons (list article subject from xref) headers)) X ;; Subject: and From: field must be specified. X (error "NNTP: recieve error(1) on line: %s" X (buffer-substring X (point) X (save-excursion (end-of-line) (point))))) X ) X (t ;No matching lines X (error "NNTP: recieve error(2) 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 following point." X (let ((count 0)) X (save-excursion X (while (and (not (eobp)) X (re-search-forward regexp nil t)) 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 (nntp-wait-for-response "^[23].*\r$")) X )) X X(defun nntp-close-server () X "Close news server." X (unwind-protect 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 (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;; 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 (progn X (kill-line) X (kill-line))) 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 (count 0)) 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 ;; I'm not sure which is better method for waiting for X ;; completion of NNTP command. At least communication between X ;; photon and flab works fine by `accept-process-output'. X ;;(sleep-for 1) X (accept-process-output) 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 X ;;(message "Reading...: %d" count) X ;; I'm not sure `accept-process-output' causes infinite X ;; loop. X (if (> count nntp-magic-tick) X (sleep-for 1) X (setq count (1+ count)) X (accept-process-output)) X )) X ) X (if status X (progn X (setq wait t) X (setq count 0) ;Reset counter. 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 "Reading...: %d" count) X ;; I'm not sure `accept-process-output' causes X ;; infinite loop. X (if (> count nntp-magic-tick) X (progn X ;; Fujitsu UTS requires the next code. I don't X ;; know why? (UMERIN) X (message "Reading...") X (sleep-for 1) X (message "")) X (setq count (1+ count)) X (accept-process-output)) 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 (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 (prog1 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 )) 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)) *-*-END-of-nntp.el-*-* exit 0 -- Masanobu UMEDA umerin@flab.flab.Fujitsu.JUNET umerin%flab.flab.Fujitsu.JUNET@uunet.uu.NET