From: Masanobu UMEDA (umerin@flab.flab.fujitsu.JUNET) Subject: GNUS: a NNTP based news reader for GNU Emacs (1 of 2) This is the only article in this thread View: Original Format Newsgroups: comp.emacs Date: 1988-02-01 19:57:20 PST 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.NET