;;; GNUS: NNTP Based News Reader for GNU Emacs ;; Copyright (C) 1987, 1988 Fujitsu Laboratoris LTD. ;; Copyrigth (C) 1987, 1988 Masanobu UMEDA (umerin@flab.flab.Fujitsu.JUNET) ;; $Header: gnus.el,v 2.0 88/02/02 10:02:32 umerin Locked $ ;; This file is part of GNU Emacs. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY. No author or distributor ;; accepts responsibility to anyone for the consequences of using it ;; or for whether it serves any particular purpose or works at all, ;; unless he says so in writing. Refer to the GNU Emacs General Public ;; License for full details. ;; Everyone is granted permission to copy, modify and redistribute ;; GNU Emacs, but only under the conditions described in the ;; GNU Emacs General Public License. A copy of this license is ;; supposed to have been given to you along with GNU Emacs so you ;; can know your rights and responsibilities. It should be in a ;; file named COPYING. Among other things, the copyright notice ;; and this notice must be preserved on all copies. ;; TO DO: ;; (1) stop using replace-regexp in format conversion because it is ;; too slow. ;; (2) caesar article body (rot13). ;; (3) select article by references. ;; (4) select article by author. (provide 'gnus) (require 'nntp) (require 'mail-utils) ;; Function `news-inews' overrides the function defined in ;; `rnewspost.el'. So, rnewspost.el must be loaded before it is ;; defined. (if (not (fboundp 'news-inews)) (load-library "rnewspost")) (defvar gnus-server-host (getenv "NNTPSERVER") "*Host the NNTP news server is running. Initialized from the NNTPSERVER environment variable.") (defvar gnus-startup-file "~/.newsrc" "*Your .newsrc file. Use `.newsrc-HOST' instead if it exists.") (defvar gnus-subject-lines-height 4 "*Number of subject lines displayed at once.") (defvar gnus-author-copy-file (getenv "AUTHORCOPY") "*File name saving copy of posted article. If the first character of the name is `|', the article is piped out to named program. Initialized from the AUTHORCOPY environment variable.") (defvar gnus-default-distribution "local" "*Use the value as distribution if no distribution is specified.") (defvar gnus-novice-user nil "*A little bit verbose in posting mode if T. Ask you news group name, subject, and distribution.") (defvar gnus-Group-mode-hook nil "*Hooks for GNUS Group mode.") (defvar gnus-Subject-mode-hook nil "*Hooks for GNUS Subject mode.") (defvar gnus-Article-mode-hook nil "*Hooks for GNUS Article mode.") ;; Site dependent variables. You have to define these variables in ;; site-init.el, default.el or your .emacs. (defvar gnus-your-domain "stars.flab.Fujitsu.JUNET" "*Your domain name without your host name. If environment variable `DOMAINNAME' is defined, it's instead used.") (defvar gnus-your-organization "Fujitsu Laboratories Ltd., Kawasaki, Japan." "*Your organization. If environment variable `ORGANIZATION' is defined, it's instead used.") (defvar gnus-your-time-zone -9 "*Difference between GMT and your time zone.") ;; Internal variables. (defvar gnus-environment-file "~/.gnus-environ.el" "File name to save environment of GNUS current session.") (defvar gnus-environ-sequence-number nil "Message id of article you will post. You should not change the value.") (defvar gnus-ignored-headers "^Path:\\|^Posting-Version:\\|^Article-I.D.:\\|^Expires:\\|^Date-Received:\\|^References:\\|^Control:\\|^Xref:\\|^Lines:\\|^Posted:\\|^Relay-Version:\\|^Message-ID:\\|^Nf-ID:\\|^Nf-From:\\|^Approved:\\|^Sender:" "All random fields within the header of a message.") (defvar gnus-newsrc-options nil "Options line in .newsrc file.") (defvar gnus-newsrc-assoc nil "Assoc list of read articles.") (defvar gnus-unread-assoc nil "Assoc list of unread articles.") (defvar gnus-active-assoc nil "Assoc list of active articles.") (defvar gnus-Group-display-buffer "*Newsgroup*") (defvar gnus-Subject-display-buffer "*Subject*") (defvar gnus-Article-display-buffer "*Article*") (defvar gnus-current-news-group nil) (defvar gnus-current-group-begin nil) (defvar gnus-current-group-end nil) (defvar gnus-current-group-articles nil "List of articles in current news group.") (defvar gnus-current-group-unread-articles nil "List of unread articles in current news group.") (defvar gnus-current-group-headers nil "List of (ARTICLE-NUMBER SUBJECT FROM XREF) in current news group.") (defvar gnus-current-article nil "Current article number.") (defvar gnus-previous-article nil "Previous article number.") (defvar gnus-Group-mode-map nil) (defvar gnus-Subject-mode-map nil) (defvar gnus-Article-mode-map nil) (defvar rmail-last-file (expand-file-name "~/XMBOX")) (defvar rmail-last-rmail-file (expand-file-name "~/XNEWS")) (autoload 'rmail-output "rmailout" "Append this message to Unix mail file named FILE-NAME." t) (put 'gnus-Group-mode 'mode-class 'special) (put 'gnus-Subject-mode 'mode-class 'special) (put 'gnus-Article-mode 'mode-class 'special) ;;(put 'eval-in-buffer-window 'lisp-indent-hook 1) (defmacro eval-in-buffer-window (buffer &rest forms) "Pop to BUFFER, evaluate FORMS, and then returns to original window." (` (let ((StartBufferWindow (selected-window))) (unwind-protect (progn (pop-to-buffer (, buffer)) (,@ forms)) (select-window StartBufferWindow))))) ;;; ;;; GNUS Group display mode ;;; (if gnus-Group-mode-map nil (setq gnus-Group-mode-map (make-keymap)) (suppress-keymap gnus-Group-mode-map) (define-key gnus-Group-mode-map " " 'gnus-Group-select-group) (define-key gnus-Group-mode-map "=" 'gnus-Group-select-group-no-article) (define-key gnus-Group-mode-map "j" 'gnus-Group-read-group) (define-key gnus-Group-mode-map "n" 'gnus-Group-next-unread-group) (define-key gnus-Group-mode-map "p" 'gnus-Group-prev-unread-group) (define-key gnus-Group-mode-map "\177" 'gnus-Group-prev-unread-group) (define-key gnus-Group-mode-map "N" 'gnus-Group-next-group) (define-key gnus-Group-mode-map "P" 'gnus-Group-prev-group) (define-key gnus-Group-mode-map "\C-n" 'gnus-Group-next-group) (define-key gnus-Group-mode-map "\C-p" 'gnus-Group-prev-group) (define-key gnus-Group-mode-map "/" 'isearch-forward) (define-key gnus-Group-mode-map "<" 'beginning-of-buffer) (define-key gnus-Group-mode-map ">" 'end-of-buffer) (define-key gnus-Group-mode-map "u" 'gnus-Group-unsubscribe-current-group) (define-key gnus-Group-mode-map "U" 'gnus-Group-unsubscribe-group) (define-key gnus-Group-mode-map "c" 'gnus-Group-catch-up) (define-key gnus-Group-mode-map "l" 'gnus-Group-list-groups) (define-key gnus-Group-mode-map "L" 'gnus-Group-list-all-groups) (define-key gnus-Group-mode-map "g" 'gnus-Group-get-new-news) (define-key gnus-Group-mode-map "b" 'gnus-Group-check-bogus-groups) (define-key gnus-Group-mode-map "a" 'gnus-post-news) (define-key gnus-Group-mode-map "?" 'describe-mode) (define-key gnus-Group-mode-map "x" 'gnus-Group-force-update) (define-key gnus-Group-mode-map "s" 'gnus-Group-force-update) (define-key gnus-Group-mode-map "q" 'gnus-Group-exit) (define-key gnus-Group-mode-map "Q" 'gnus-Group-quit)) (defun gnus-Group-mode () "Major mode for reading news using nntp based news server. All normal editing commands are turned off. Instead, these commands are available: \\[gnus-Group-select-group] Select this news group. \\[gnus-Group-select-group-no-article] List subjects in this news group. \\[gnus-Group-read-group] Jump to specified news group. \\[gnus-Group-next-unread-group] Move to Next unread news group. \\[gnus-Group-prev-unread-group] Move to Previous unread news group. \\[gnus-Group-next-group] Move to Next news group. \\[gnus-Group-prev-group] Move to Previous news group. \\[isearch-forward] Do incremental search forward. \\[beginning-of-buffer] Move point to beginning of this buffer. \\[end-of-buffer] Move point to end of this buffer. \\[gnus-Group-unsubscribe-current-group] Toggle this news group unsubscribe from/to subscribe. \\[gnus-Group-unsubscribe-group] Toggle news group unsubscribe from/to subscribe. \\[gnus-Group-catch-up] Mark all articles in this news group as read. \\[gnus-Group-list-groups] Revert this buffer. \\[gnus-Group-list-all-groups] List all of news groups. \\[gnus-Group-get-new-news] Get new news. \\[gnus-Group-check-bogus-groups] Check bogus news groups. \\[gnus-post-news] Post an article to JUNET (USENET). \\[describe-mode] Describe this mode. \\[gnus-Group-force-update] Save .newsrc file. \\[gnus-Group-exit] Quit reading news. \\[gnus-Group-quit] Quit reading news without saving .newsrc file. The following commands are available: \\{gnus-Group-mode-map} If there is a file named `~/.newsrc-HOST', it is used as startup file instead of standard one when talking to a news server on HOST. You are able to talk to hosts more than one by using different startup files for each. By giving an argument to command `\\[gnus]', you can choose news server host different from default one. If there is a file named `~/.signature-DISTRIBUTION', it is used as signature file instead of standard one when posting a news in DISTRIBUTION. If you are a novice to network news, it is recommended to set variable `gnus-novice-user' to non-NIL. You will be asked newsgroup, subject, and distribution when posting a new news if the value is set to non-NIL. Entry to this mode calls the value of gnus-Group-mode-hook with no arguments, if that value is non-nil." (interactive) (kill-all-local-variables) (setq major-mode 'gnus-Group-mode) ;;(setq mode-name "GNUS Newsgroup") (setq mode-name (concat "GNUS " gnus-server-host)) (setq mode-line-buffer-identification "GNUS: List of Newsgroups") ;;(make-local-variable 'revert-buffer-function) ;;(setq revert-buffer-function 'gnus-Group-revert-buffer) (use-local-map gnus-Group-mode-map) (setq buffer-read-only t) ;Disable modification (run-hooks 'gnus-Group-mode-hook)) (defun gnus (&optional ask-host) "Read news using nntp based news server. If optional argument ASK-HOST is non-nil, ask news server host." (interactive "P") (gnus-start-news-server ask-host) (switch-to-buffer (get-buffer-create gnus-Group-display-buffer)) (gnus-Group-mode) (let ((buffer-read-only nil)) (erase-buffer) (gnus-Group-startup-message) (sit-for 0) (gnus-setup-news-info) (erase-buffer)) (gnus-Group-list-groups nil) (sit-for 0)) (defun gnus-Group-startup-message () (insert "\n\n\n\n GNUS Version 2.0 NNTP Based News Reader for GNU Emacs If you have any troubles with this software, please let me know. I would fix your problems in the next release. Any comment, suggestion, and bug fix are welcome. Masanobu UMEDA umerin@flab.Fujitsu.JUNET")) (defun gnus-Group-list-groups (show-all) "List news groups in group selection buffer. If argument SHOW-ALL is non-nil, unsubscribed groups are also listed." (interactive "P") (gnus-Group-prepare-list show-all) (if (zerop (buffer-size)) (message "No news is good news.") ;; Adjust cursor point. (goto-char (point-min)) (search-forward ":" nil t) )) (defun gnus-Group-prepare-list (&optional all) "Prepare list of news groups in current buffer. If optional argument ALL is non-nil, unsubscribed groups are also listed." (save-excursion (let ((buffer-read-only nil) (unread gnus-unread-assoc) (group nil) ;; This specifies format of Group display buffer. (cntl "%s %5s: %s\n")) (erase-buffer) (goto-char (point-min)) ;; List news groups. (while unread (setq group (car unread)) (if (or all (and (> (nth 1 group) 0) ;There are unread articles. (nth 1 (assoc (car group) gnus-newsrc-assoc)))) (progn (insert (format cntl ;; Subscribed or not. (if (nth 1 (assoc (car group) gnus-newsrc-assoc)) " " "U") ;; Number of unread articles. (nth 1 group) ;; News group name. (car group))) )) (setq unread (cdr unread)) )) )) (defun gnus-Group-update-group (group &optional visible-only) "Update news group info of GROUP. If optional argument VISIBLE-ONLY is non-nil, non displayed group is ignored." (save-excursion (set-buffer (get-buffer gnus-Group-display-buffer)) (let ((buffer-read-only nil) (visible nil) (unread (assoc group gnus-unread-assoc)) ;; This specifies format of Group display buffer. (cntl "%s %5s: %s\n")) ;; Search point to modify. (goto-char (point-min)) (if (re-search-forward (concat "^.+: " (regexp-quote group) "$") nil t) ;; GROUP is listed in current buffer. (progn (setq visible t) (beginning-of-line) (kill-line) (kill-line) ;Delete old line. )) (if (or visible (not visible-only)) (insert (format cntl ;; Subscribed or not. (if (nth 1 (assoc group gnus-newsrc-assoc)) " " "U") ;; Number of unread articles. (nth 1 unread) ;; News group name. group)) )) )) ;; GNUS Group mode command (defun gnus-Group-group-name () "Get news group name around point." (save-excursion (beginning-of-line) (if (re-search-forward "^.[ \t]*[0-9]+:[ \t]+\\([^ \t\n]+\\)$" nil t) (buffer-substring (match-beginning 1) (match-end 1)) ))) (defun gnus-Group-select-group (all &optional no-article) "Select news group to read at current line. If argument ALL is non-nil, already read articles become readable. If optional argument NO-ARTICLE is non-nil, no article body is displayed." (interactive "P") (let ((group (gnus-Group-group-name))) ;News group name (if group (gnus-Subject-read-group group (or all (not (nth 1 (assoc group gnus-newsrc-assoc))) ;Unsubscribed (zerop (nth 1 (assoc group gnus-unread-assoc)))) ;No unread no-article )) )) (defun gnus-Group-select-group-no-article (all) "Select news group to read at current line. No article is selected automatically. If argument ALL is non-nil, already read articles become readable." (interactive "P") (gnus-Group-select-group all t)) (defun gnus-Group-read-group (group &optional all) "Start reading news in news GROUP. If argument ALL is non-nil, already read articles become readable." (interactive (list (completing-read "News group: " gnus-unread-assoc) current-prefix-arg)) (gnus-Subject-read-group group (or all (not (nth 1 (assoc group gnus-newsrc-assoc))) ;Unsubscribed (zerop (nth 1 (assoc group gnus-unread-assoc)))) ;No unread article )) (defun gnus-Group-search-forward (backward any-group) "Search for news group forward. If 1st argument BACKWARD is non-nil, search backward instead. If 2nd argument ANY-GROUP is non-nil, unsubscribed or empty group may be selected." (let ((func (if backward 're-search-backward 're-search-forward)) (regexp (format "^%s[ \t]+\\(%s\\):" (if any-group "." " ") (if any-group "[0-9]+" "[1-9][0-9]*"))) (found nil)) (if backward (beginning-of-line) (end-of-line)) (if (funcall func regexp nil t) (setq found t)) ;; Adjust cursor point. (beginning-of-line) (search-forward ":" nil t) ;; Return T if found. found )) (defun gnus-Group-next-group () "Go to next news group." (interactive) (if (gnus-Group-search-forward nil t) nil (message "No more news group."))) (defun gnus-Group-next-unread-group () "Go to next unread news group." (interactive) (if (gnus-Group-search-forward nil nil) nil (message "No more news group."))) (defun gnus-Group-prev-group () "Go to previous news group." (interactive) (gnus-Group-search-forward t t)) (defun gnus-Group-prev-unread-group () "Go to previous unread news group." (interactive) (gnus-Group-search-forward t nil)) (defun gnus-Group-catch-up (no-confirm) "Mark all articles in this news group as read. If argument NO-CONFIRM is non-nil, do without confirmations. Cross references (Xref: field) of articles are ignored." (interactive "P") (let ((group (gnus-Group-group-name))) (if (and group (or no-confirm (y-or-n-p "Do you really want to mark everything as read? "))) (progn (gnus-update-unread-articles group nil) (gnus-Group-update-group group) (gnus-Group-next-unread-group)) ))) (defun gnus-Group-unsubscribe-current-group () "Toggle subscribe from/to unsubscribe this group." (interactive) (gnus-Group-unsubscribe-group (gnus-Group-group-name))) (defun gnus-Group-unsubscribe-group (group) "Toggle subscribe from/to unsubscribe of GROUP." (interactive (list (completing-read "News group: " gnus-newsrc-assoc))) (let ((newsrc (assoc group gnus-newsrc-assoc))) (if newsrc (progn (setcar (nthcdr 1 newsrc) (not (nth 1 newsrc))) (gnus-Group-update-group group) (gnus-Group-next-group) )) )) (defun gnus-Group-list-all-groups () "List all of news groups in group selection buffer." (interactive) (gnus-Group-list-groups t)) (defun gnus-Group-get-new-news (all) "Re-read active file. If argument ALL is non-nil, unsubscribed or empty group is also listed." (interactive "P") (gnus-setup-news-info) (gnus-Group-list-groups all)) (defun gnus-Group-check-bogus-groups () "Check bogus news group." (interactive) (gnus-delete-bogus-news-group t) ;Require confirmation. (gnus-clean-up-newsrc)) (defun gnus-Group-force-update () "Update .newsrc file." (interactive) (gnus-save-newsrc-file gnus-startup-file)) (defun gnus-Group-exit () "Quit reading news after updating .newsrc." (interactive) (if (y-or-n-p "Are you sure you want to quit reading news? ") (progn (gnus-save-newsrc-file gnus-startup-file) (gnus-clear-system) (nntp-close-server)) )) (defun gnus-Group-quit () "Quit reading news without updating .newsrc." (interactive) (if (yes-or-no-p "Quit reading news without saving .newsrc? ") (progn (gnus-clear-system) (nntp-close-server)) )) ;;; ;;; GNUS Subject display mode ;;; (if gnus-Subject-mode-map nil (setq gnus-Subject-mode-map (make-keymap)) (suppress-keymap gnus-Subject-mode-map) (define-key gnus-Subject-mode-map " " 'gnus-Subject-next-page) (define-key gnus-Subject-mode-map "\177" 'gnus-Subject-prev-page) (define-key gnus-Subject-mode-map "n" 'gnus-Subject-next-unread-article) (define-key gnus-Subject-mode-map "p" 'gnus-Subject-prev-unread-article) (define-key gnus-Subject-mode-map "N" 'gnus-Subject-next-article) (define-key gnus-Subject-mode-map "P" 'gnus-Subject-prev-article) (define-key gnus-Subject-mode-map "\e\C-n" 'gnus-Subject-next-same-subject) (define-key gnus-Subject-mode-map "\e\C-p" 'gnus-Subject-prev-same-subject) (define-key gnus-Subject-mode-map "\C-c\C-n" 'gnus-Subject-next-digest) (define-key gnus-Subject-mode-map "\C-c\C-p" 'gnus-Subject-prev-digest) (define-key gnus-Subject-mode-map "\C-n" 'gnus-Subject-next-subject) (define-key gnus-Subject-mode-map "\C-p" 'gnus-Subject-prev-subject) (define-key gnus-Subject-mode-map "\en" 'gnus-Subject-next-unread-subject) (define-key gnus-Subject-mode-map "\ep" 'gnus-Subject-prev-unread-subject) (define-key gnus-Subject-mode-map "." 'gnus-Subject-first-unread-article) (define-key gnus-Subject-mode-map "/" 'isearch-forward) (define-key gnus-Subject-mode-map "s" 'gnus-Subject-search-article-body) (define-key gnus-Subject-mode-map "<" 'gnus-Subject-beginning-of-article) (define-key gnus-Subject-mode-map ">" 'gnus-Subject-end-of-article) (define-key gnus-Subject-mode-map "j" 'gnus-Subject-goto-article) (define-key gnus-Subject-mode-map "l" 'gnus-Subject-goto-last-article) (define-key gnus-Subject-mode-map "u" 'gnus-Subject-mark-unread-forward) (define-key gnus-Subject-mode-map "U" 'gnus-Subject-mark-unread-backward) (define-key gnus-Subject-mode-map "d" 'gnus-Subject-mark-read-forward) (define-key gnus-Subject-mode-map "D" 'gnus-Subject-mark-read-backward) (define-key gnus-Subject-mode-map "k" 'gnus-Subject-kill-same-subject) (define-key gnus-Subject-mode-map "c" 'gnus-Subject-catch-up) (define-key gnus-Subject-mode-map "\C-t" 'gnus-Subject-toggle-truncation) (define-key gnus-Subject-mode-map "t" 'gnus-Subject-show-all-headers) (define-key gnus-Subject-mode-map "v" 'gnus-Subject-show-all-headers) (define-key gnus-Subject-mode-map "a" 'gnus-Subject-post-news) (define-key gnus-Subject-mode-map "f" 'gnus-Subject-post-reply) (define-key gnus-Subject-mode-map "C" 'gnus-Subject-cancel) (define-key gnus-Subject-mode-map "r" 'gnus-Subject-mail-reply) (define-key gnus-Subject-mode-map "m" 'gnus-Subject-mail-other-window) (define-key gnus-Subject-mode-map "o" 'gnus-Subject-save-in-file) (define-key gnus-Subject-mode-map "\C-o" 'gnus-Subject-rmail-output) (define-key gnus-Subject-mode-map "|" 'gnus-Subject-pipe-output) (define-key gnus-Subject-mode-map "?" 'describe-mode) (define-key gnus-Subject-mode-map "q" 'gnus-Subject-exit) (define-key gnus-Subject-mode-map "Q" 'gnus-Subject-quit)) (defun gnus-Subject-mode () "Major mode for reading news in this news group. All normal editing commands are turned off. Instead, these commands are available: \\[gnus-Subject-next-page] Scroll to next page of this article. (If end of the article,\n\tmove to next article.) \\[gnus-Subject-prev-page] Scroll to previous page of this article. \\[gnus-Subject-next-unread-article] Move to Next unread article. \\[gnus-Subject-prev-unread-article] Move to Previous unread article. \\[gnus-Subject-next-article] Move to Next article whether read or not. \\[gnus-Subject-prev-article] Move to Previous article whether read or not. \\[gnus-Subject-next-same-subject] Move to Next article which has same subject as this article. \\[gnus-Subject-prev-same-subject] Move to Previous article which has same subject as this article. \\[gnus-Subject-next-digest] Scroll to next digested message in this article. \\[gnus-Subject-prev-digest] Scroll to previous digested message in this article. \\[gnus-Subject-next-subject] Move to next subject line. \\[gnus-Subject-prev-subject] Move to previous subject line. \\[gnus-Subject-next-unread-subject] Move to next unread article's subject. \\[gnus-Subject-prev-unread-subject] Move to previous unread article's subject. \\[gnus-Subject-first-unread-article] Jump to first unread article in this news group. \\[isearch-forward] Do incremental search forward. \\[gnus-Subject-search-article-body] Do incremental search forward on this article body. \\[gnus-Subject-beginning-of-article] Move point to beginning of this article. \\[gnus-Subject-end-of-article] Move point to end of this article. \\[gnus-Subject-goto-article] Jump to article specified by numeric article ID. \\[gnus-Subject-goto-last-article] Jump to article you read last. \\[gnus-Subject-mark-unread-forward] Mark this article as unread, and go forward. \\[gnus-Subject-mark-unread-backward] Mark this article as unread, and go backward. \\[gnus-Subject-mark-read-forward] Mark this article as read, and go forward. \\[gnus-Subject-mark-read-backward] Mark this article as read, and go backward. \\[gnus-Subject-kill-same-subject] Mark articles which has same subject as this article as read. \\[gnus-Subject-catch-up] Mark all of articles in this news group as read. \\[gnus-Subject-toggle-truncation] Toggle truncation of subject lines. \\[gnus-Subject-show-all-headers] Show all headers of this article. \\[gnus-Subject-post-news] Post an article. \\[gnus-Subject-post-reply] Post a reply article. \\[gnus-Subject-cancel] Cancel this article. (The article must be yours). \\[gnus-Subject-mail-reply] Mail a message to the author. \\[gnus-Subject-mail-other-window] Mail a message in other window. \\[gnus-Subject-save-in-file] Append this article to file. \\[gnus-Subject-rmail-output] Append this article to file in Unix mail format. \\[gnus-Subject-pipe-output] Pipe this article to subprocess. \\[describe-mode] Describe this mode. \\[gnus-Subject-exit] Quit reading news in this news group. \\[gnus-Subject-quit] Quit reading news without updating read articles information. The following commands are available: \\{gnus-Subject-mode-map} Entry to this mode calls the value of gnus-Subject-mode-hook with no arguments, if that value is non-nil." (interactive) (kill-all-local-variables) (setq major-mode 'gnus-Subject-mode) ;;(setq mode-name "GNUS Subject") (setq mode-name (concat "GNUS " gnus-current-news-group)) (gnus-Subject-set-mode-line) (use-local-map gnus-Subject-mode-map) (setq buffer-read-only t) ;Disable modification (setq truncate-lines t) ;Stop folding of lines. (run-hooks 'gnus-Subject-mode-hook)) (defun gnus-Subject-read-group (group &optional show-all no-article) "Start reading news in news GROUP. If optional 1st argument SHOW-ALL is non-nil, already read articles are also listed. If optional 2nd argument NO-ARTICLE is non-nil, no article body is displayed." (message "Retrieving news group: %s..." group) (if (gnus-select-news-group group show-all) (progn (switch-to-buffer (get-buffer-create gnus-Subject-display-buffer)) (gnus-Subject-mode) (gnus-Subject-prepare-list) (message "") ;Erase message. (if (zerop (buffer-size)) ;; This news group is empty. (progn (setq gnus-current-group-unread-articles nil) (gnus-Subject-exit) (message "No unread news.")) ;; Show first unread article. (goto-char (point-min)) (if (not no-article) (gnus-Subject-first-unread-article) ;; Kill article display buffer because I sometime get ;; confused by old article buffer. (if (get-buffer gnus-Article-display-buffer) (kill-buffer gnus-Article-display-buffer) )) ;; Adjust cursor point. (beginning-of-line) (search-forward ":" nil t) )) ;; Cannot select news GROUP. (message "No such news group: %s" group) ;; Run checking bogus news groups. (gnus-delete-bogus-news-group t) ;Confirm )) (defun gnus-Subject-prepare-list () "Prepare subject list of current news group in current buffer." (save-excursion (let* ((buffer-read-only nil) (id 0) (headers gnus-current-group-headers) (unread (copy-sequence gnus-current-group-unread-articles)) ;; These define format of subject display buffer. (name-length (length "umerin@photon")) (cntl (format "%%s %%%ds: [%%%ds] %%s\n" (length (prin1-to-string gnus-current-group-end)) name-length))) ;; News group must be selected before calling me. (erase-buffer) (while headers (setq id (nntp-headers-number (car headers))) (setq unread (delq id unread)) (insert (format cntl (if (memq id gnus-current-group-unread-articles) " " "D") ;Subscribed or not. id ;Article ID. (substring (concat (mail-strip-quoted-names (nntp-headers-from (car headers))) (make-string name-length ? )) 0 name-length) (nntp-headers-subject (car headers)))) (setq headers (cdr headers)) ) ;; If unread is non-nil, there exists expired articles. In this ;; case, these articles must be removed from unread articles. (while unread (setq gnus-current-group-unread-articles (delq (car unread) gnus-current-group-unread-articles)) (setq unread (cdr unread))) ))) (defun gnus-Subject-set-mode-line () "Set Subject mode line string." (let ((subject (nntp-headers-subject (assoc gnus-current-article gnus-current-group-headers)))) (setq mode-line-process (concat " " (if (integerp gnus-current-group-begin) (int-to-string gnus-current-group-begin) "?") "-" (if (integerp gnus-current-group-end) (int-to-string gnus-current-group-end) "?") )) (setq mode-line-buffer-identification (concat "GNUS: " subject ;; Enough spaces to pad subject to 17 positions. (substring " " 0 (max 0 (- 17 (length subject)))))) (set-buffer-modified-p t) (sit-for 0) )) ;; GNUS Subject display mode command. (defun gnus-Subject-search-subject (backward unread subject) "Search for article forward. If 1st argument BACKWARD is non-nil, search backward. If 2nd argument UNREAD is non-nil, only unread article is selected. If 3rd argument SUBJECT is non-nil, the article which has the same subject will be searched for." (let ((func (if backward 're-search-backward 're-search-forward)) (article nil) (case-fold-search nil) ;Don't ignore case. (regexp (format "^%s[ \t]+\\([0-9]+\\):[ \t]+\\[.*\\][ \t]+%s" (if unread " " ".") (if subject (concat "\\([Rr][Ee]:[ \t]+\\)*" (regexp-quote (gnus-simplify-subject subject)) ;; Ignore words in parentheses. "\\([ \t]*(.*)\\)*[ \t]*$") "") ))) (if backward (beginning-of-line) (end-of-line)) (if (funcall func regexp nil t) (setq article (string-to-int (buffer-substring (match-beginning 1) (match-end 1)))) ) ;; Adjust cursor point. (beginning-of-line) (search-forward ":" nil t) ;; This is the result. article )) (defun gnus-Subject-search-forward (&optional unread subject) "Search for article forward. If 1st optional argument UNREAD is non-nil, only unread article is selected. If 2nd optional argument SUBJECT is non-nil, the article which has the same subject will be searched for." (gnus-Subject-search-subject nil unread subject)) (defun gnus-Subject-search-backward (&optional unread subject) "Search for article backward. If 1st optional argument UNREAD is non-nil, only unread article is selected. If 2nd optional argument SUBJECT is non-nil, the article which has the same subject will be searched for." (gnus-Subject-search-subject t unread subject)) (defun gnus-Subject-article-number () "Article number around point." (save-excursion (beginning-of-line) (if (re-search-forward "^.[ \t]+\\([0-9]+\\):" nil t) (string-to-int (buffer-substring (match-beginning 1) (match-end 1))) ;; If search fail, return current article number. gnus-current-article) )) (defun gnus-Subject-subject-string () "Return current subject string or nil if non." (save-excursion ;; It is possible to implement this function using ;; `gnus-Subject-article-number' and `gnus-current-group-headers'. (beginning-of-line) (if (re-search-forward "^.[ \t]+[0-9]+:[ \t]+\\[.*\\][ \t]+\\(.*\\)$" nil t) (let ((subject (buffer-substring (match-beginning 1) (match-end 1)))) ;; Trim spaces of subject. (if (string-match "\\`[ \t]+\\([^ \t].*\\)\\'" subject) (setq subject (substring subject (match-beginning 1)))) ;; Return subject string. subject ) nil ))) (defun gnus-Subject-goto-subject (article) "Move point to ARTICLE." (interactive "NArticle ID: ") (goto-char (point-min)) (re-search-forward (format "^.[ \t]+%d:" article) nil t)) ;; Walking around subject lines. (defun gnus-Subject-next-subject (unread) "Go to next subject line. If argument UNREAD is non-nil, only unread article is selected." (interactive "P") (cond ((gnus-Subject-search-forward unread)) (unread (message "No more unread articles.")) (t (message "No more articles.")) )) (defun gnus-Subject-next-unread-subject () "Go to next unread subject line." (interactive) (gnus-Subject-next-subject t)) (defun gnus-Subject-prev-subject (unread) "Go to previous subject line. If argument UNREAD is non-nil, only unread article is selected." (interactive "P") (cond ((gnus-Subject-search-backward unread)) (unread (message "No more unread articles.")) (t (message "No more articles.")) )) (defun gnus-Subject-prev-unread-subject () "Go to previous unread subject line." (interactive) (gnus-Subject-prev-subject t)) ;; Walking around subject lines with displaying articles. (defun gnus-Subject-configure-window () "Use two window mode. One is for reading subjects and the other is article." (if (one-window-p t) (progn (switch-to-buffer gnus-Subject-display-buffer) (split-window-vertically (1+ gnus-subject-lines-height)) (other-window 1) (gnus-Article-setup-buffer) (switch-to-buffer gnus-Article-display-buffer) (other-window 1) ))) (defun gnus-Subject-display-article (article &optional all-header) "Display ARTICLE in article display buffer." (if article (progn (gnus-Subject-configure-window) (let ((window (selected-window))) (gnus-Article-prepare article all-header) (pop-to-buffer gnus-Article-display-buffer) (select-window window) (gnus-Subject-set-mode-line))) )) (defun gnus-Subject-next-article (unread &optional subject) "Select article after current one. If argument UNREAD is non-nil, only unread article is selected." (interactive "P") (cond ((gnus-Subject-display-article (gnus-Subject-search-forward unread subject))) (unread (message "No more unread articles.")) (t (message "No more articles.")) )) (defun gnus-Subject-next-unread-article () "Select unread article after current one." (interactive) (gnus-Subject-next-article t)) (defun gnus-Subject-prev-article (unread &optional subject) "Select article before current one. If argument UNREAD is non-nil, only unread article is selected." (interactive "P") (cond ((gnus-Subject-display-article (gnus-Subject-search-backward unread subject))) (unread (message "No more unread articles.")) (t (message "No more articles.")) )) (defun gnus-Subject-prev-unread-article () "Select unred article before current one." (interactive) (gnus-Subject-prev-article t)) (defun gnus-Subject-next-page () "Show next page of selected article. If end of artile, select next article." (interactive) (let ((article (gnus-Subject-article-number)) (endp nil)) (if (or (null gnus-current-article) (/= article gnus-current-article)) ;; Selected subject is different from current article's. (gnus-Subject-display-article article) (gnus-Subject-configure-window) (eval-in-buffer-window gnus-Article-display-buffer (setq endp (gnus-Article-next-page))) (if endp (gnus-Subject-next-unread-article))) )) (defun gnus-Subject-prev-page () "Show previous page of selected article." (interactive) (let ((article (gnus-Subject-article-number))) (if (or (null gnus-current-article) (/= article gnus-current-article)) ;; Selected subject is different from current article's. (gnus-Subject-display-article article) (gnus-Subject-configure-window) (eval-in-buffer-window gnus-Article-display-buffer (gnus-Article-prev-page)) ))) (defun gnus-Subject-next-same-subject () "Select next article which has the same subject as current one." (interactive) (gnus-Subject-next-article nil (gnus-Subject-subject-string))) (defun gnus-Subject-prev-same-subject () "Select previous article which has the same subject as current one." (interactive) (gnus-Subject-prev-article nil (gnus-Subject-subject-string))) (defun gnus-Subject-next-digest () "Move to head of next digested message." (interactive) (gnus-Subject-configure-window) (eval-in-buffer-window gnus-Article-display-buffer (gnus-Article-next-digest) )) (defun gnus-Subject-prev-digest () "Move to head of previous digested message." (interactive) (gnus-Subject-configure-window) (eval-in-buffer-window gnus-Article-display-buffer (gnus-Article-prev-digest) )) (defun gnus-Subject-first-unread-article () "Select first unread article." (interactive) (let ((begin (point))) (goto-char (point-min)) (if (re-search-forward "^ [ \t]+[0-9]+:" nil t) (gnus-Subject-display-article (gnus-Subject-article-number)) ;; If there is no unread articles, stay there. (goto-char begin) (gnus-Subject-display-article (gnus-Subject-article-number)) ) )) (defun gnus-Subject-search-article-body () "Search on article body." (interactive) (eval-in-buffer-window gnus-Article-display-buffer (call-interactively 'isearch-forward) )) (defun gnus-Subject-beginning-of-article () "Go to beginning of article body" (interactive) (eval-in-buffer-window gnus-Article-display-buffer (beginning-of-buffer) )) (defun gnus-Subject-end-of-article () "Go to end of article body" (interactive) (eval-in-buffer-window gnus-Article-display-buffer (end-of-buffer) )) (defun gnus-Subject-goto-article (article) "Go to ARTICLE." (interactive (list (string-to-int (completing-read "NArticle number: " (mapcar '(lambda (headers) (list (int-to-string (nntp-headers-number headers)))) gnus-current-group-headers))))) (if (gnus-Subject-goto-subject article) (gnus-Subject-display-article article))) (defun gnus-Subject-goto-last-article () "Go to last subject line." (interactive) (if gnus-previous-article (gnus-Subject-goto-article gnus-previous-article))) (defun gnus-Subject-show-all-headers () "Show all article header." (interactive) (gnus-Subject-display-article gnus-current-article t)) (defun gnus-Subject-kill-same-subject () "Mark articles which has the same subject as read." (interactive) (let* ((article (gnus-Subject-article-number)) (cntl (format "^.[ \t]+%d:" article)) (subject nil) (count 0)) (save-excursion (goto-char (point-min)) (if (re-search-forward cntl nil t) (progn (setq subject (gnus-Subject-subject-string)) (gnus-Subject-mark-read article) (setq count (1+ count)) (while (and subject (gnus-Subject-search-forward t subject)) (gnus-Subject-mark-read (gnus-Subject-article-number)) (setq count (1+ count))) )) ) (gnus-Subject-next-unread-article) (message "%d articles are marked as read." count) )) (defun gnus-Subject-mark-unread-forward (&optional article) "Mark current subject as unread, and then go forward. If optional argument ARTICLE is non-nil, the ARTICLE rather than current is marked as unread." (interactive) (gnus-Subject-mark-unread (or article (gnus-Subject-article-number))) (gnus-Subject-next-subject nil)) (defun gnus-Subject-mark-unread-backward (&optional article) "Mark current subject as unread, and then go backward. If optional argument ARTICLE is non-nil, the ARTICLE rather than current is marked as unread." (interactive) (gnus-Subject-mark-unread (or article (gnus-Subject-article-number))) (gnus-Subject-prev-subject nil)) (defun gnus-Subject-mark-unread (article) "Mark ARTICLE's subject as unread." (save-excursion (set-buffer gnus-Subject-display-buffer) (let ((buffer-read-only nil)) (if (not (memq article gnus-current-group-unread-articles)) (progn ;; Add to list. (setq gnus-current-group-unread-articles (cons article gnus-current-group-unread-articles)) (if (gnus-Subject-goto-subject article) (progn (beginning-of-line) (delete-region (point) (1+ (point))) (insert " "))) )) ))) (defun gnus-Subject-mark-read-forward (&optional article) "Mark current subject as read, and then go forward. If optional argument ARTICLE is non-nil, the ARTICLE rather than current is marked as read." (interactive) (gnus-Subject-mark-read (or article (gnus-Subject-article-number))) (gnus-Subject-next-subject t)) (defun gnus-Subject-mark-read-backward (&optional article) "Mark current subject as read, and then go backward. If optional argument ARTICLE is non-nil, the ARTICLE rather than current is marked as read." (interactive) (gnus-Subject-mark-read (or article (gnus-Subject-article-number))) (gnus-Subject-prev-subject t)) (defun gnus-Subject-mark-read (article) "Mark ARTICLE's subject as read." (save-excursion (set-buffer gnus-Subject-display-buffer) (let ((buffer-read-only nil)) (if (memq article gnus-current-group-unread-articles) (progn ;; Remove from list. (setq gnus-current-group-unread-articles (delq article gnus-current-group-unread-articles)) (if (gnus-Subject-goto-subject article) (progn (beginning-of-line) (delete-region (point) (1+ (point))) (insert "D"))) )) ))) (defun gnus-Subject-catch-up () "Mark all articles in this news group as read." (interactive) (if (y-or-n-p "Do you really want to mark everything as read? ") (progn (setq gnus-current-group-unread-articles nil) (gnus-Subject-exit)) )) (defun gnus-Subject-toggle-truncation (arg) "Toggle truncation of subject lines. With arg, turn line truncation on iff arg is positive." (interactive "P") (setq truncate-lines (if (null arg) (not truncate-lines) (> (prefix-numeric-value arg) 0))) (redraw-display)) (defun gnus-Subject-post-news () "Post a news article." (interactive) (if (get-buffer gnus-Article-display-buffer) (switch-to-buffer gnus-Article-display-buffer)) (delete-other-windows) (gnus-post-news)) (defun gnus-Subject-post-reply () "Post a reply article." (interactive) (if (get-buffer gnus-Article-display-buffer) (switch-to-buffer gnus-Article-display-buffer) (gnus-Subject-display-article (gnus-Subject-article-number)) (switch-to-buffer gnus-Article-display-buffer)) (delete-other-windows) (gnus-news-reply)) (defun gnus-Subject-cancel () "Cancel an article you posted." (interactive) (if (get-buffer gnus-Article-display-buffer) (display-buffer gnus-Article-display-buffer) (gnus-Subject-display-article (gnus-Subject-article-number))) (if (yes-or-no-p "Do you really want to cancel this article? ") (eval-in-buffer-window gnus-Article-display-buffer (gnus-inews-control-cancel)) )) (defun gnus-Subject-mail-reply () "Reply mail to news author." (interactive) (if (get-buffer gnus-Article-display-buffer) (switch-to-buffer gnus-Article-display-buffer) (gnus-Subject-display-article (gnus-Subject-article-number)) (switch-to-buffer gnus-Article-display-buffer)) (delete-other-windows) (news-mail-reply)) (defun gnus-Subject-mail-other-window () "Reply mail to news author in other window." (interactive) (if (get-buffer gnus-Article-display-buffer) (switch-to-buffer gnus-Article-display-buffer)) (delete-other-windows) (news-mail-other-window)) (defun gnus-Subject-rmail-output () "Append this article to Unix mail file." (interactive) (if (get-buffer gnus-Article-display-buffer) (save-excursion (set-buffer gnus-Article-display-buffer) (call-interactively 'rmail-output)) )) (defun gnus-Subject-save-in-file (file) "Append this article to FILE." (interactive "FSave article in file: ") (if (get-buffer gnus-Article-display-buffer) (save-excursion (set-buffer gnus-Article-display-buffer) (append-to-file (point-min) (point-max) file)) )) (defun gnus-Subject-pipe-output (command) "Pipe this article to COMMAND subprocess." (interactive "sShell command on article: ") (if (not (get-buffer gnus-Article-display-buffer)) (gnus-Subject-display-article (gnus-Subject-article-number))) (eval-in-buffer-window gnus-Article-display-buffer (shell-command-on-region (point-min) (point-max) command nil) )) (defun gnus-Subject-exit () "Exit reading current news group, and then return to group selection mode." (interactive) (let ((updated nil)) (gnus-update-unread-articles gnus-current-news-group gnus-current-group-unread-articles) (setq updated (gnus-mark-as-read-by-xref gnus-current-news-group gnus-current-group-headers gnus-current-group-unread-articles)) ;; Return to Group selection mode. (if (get-buffer gnus-Subject-display-buffer) (bury-buffer gnus-Subject-display-buffer)) (if (get-buffer gnus-Article-display-buffer) (bury-buffer gnus-Article-display-buffer)) (switch-to-buffer gnus-Group-display-buffer) (delete-other-windows) ;; Update cross referenced group info. (while updated (gnus-Group-update-group (car updated) t) ;Ignore non-visible group. (setq updated (cdr updated))) (gnus-Group-update-group gnus-current-news-group) (gnus-Group-next-unread-group) )) (defun gnus-Subject-quit () "Quit reading current news group without updating read article info." (interactive) (if (y-or-n-p "Do you really wanna quit reading this group? ") (progn ;; Return to Group selection mode. (if (get-buffer gnus-Subject-display-buffer) (bury-buffer gnus-Subject-display-buffer)) (if (get-buffer gnus-Article-display-buffer) (bury-buffer gnus-Article-display-buffer)) (switch-to-buffer gnus-Group-display-buffer) (delete-other-windows) (gnus-Group-next-unread-group) ))) ;;; ;;; GNUS Article display mode ;;; (if gnus-Article-mode-map nil (setq gnus-Article-mode-map (make-keymap)) (suppress-keymap gnus-Article-mode-map) (define-key gnus-Article-mode-map " " 'scroll-up) (define-key gnus-Article-mode-map "\177" 'scroll-down) (define-key gnus-Article-mode-map "h" 'gnus-Article-show-subjects) (define-key gnus-Article-mode-map "s" 'gnus-Article-show-subjects) (define-key gnus-Article-mode-map "?" 'describe-mode) (define-key gnus-Article-mode-map "q" 'gnus-Subject-exit) (define-key gnus-Article-mode-map "Q" 'gnus-Subject-quit)) (defun gnus-Article-mode () "Major mode for reading news articles. All normal editing commands are turned off. Instead, these commands are available: \\{gnus-Article-mode-map} Entry to this mode calls the value of gnus-Article-mode-hook with no arguments, if that value is non-nil." (interactive) (kill-all-local-variables) (setq major-mode 'gnus-Article-mode) (setq mode-name "GNUS") (gnus-Article-set-mode-line) (use-local-map gnus-Article-mode-map) (setq buffer-read-only t) ;Disable modification (run-hooks 'gnus-Article-mode-hook)) (defun gnus-Article-setup-buffer () "Initialize article display buffer." (save-excursion (if (get-buffer gnus-Article-display-buffer) nil (set-buffer (get-buffer-create gnus-Article-display-buffer)) (gnus-Article-mode)) )) (defun gnus-Article-prepare (article &optional all-headers) "Prepare ARTICLE in article display buffer. If optional argument ALL-HEADERS is non-nil, all headers are inserted." (save-excursion (gnus-Article-setup-buffer) (set-buffer gnus-Article-display-buffer) (let ((buffer-read-only nil)) (erase-buffer) (if (nntp-request-article article) (progn ;; Setup article buffer (gnus-copy-to-buffer (current-buffer)) (gnus-Article-convert-format all-headers) ;; Set article pointer. (setq gnus-previous-article gnus-current-article) (setq gnus-current-article article) (if (not (eq gnus-previous-article gnus-current-article)) (gnus-Subject-mark-read gnus-current-article)) ;; Next function must be called after setting ;; `gnus-current-article' variable. (gnus-Article-set-mode-line) ) (gnus-Subject-mark-read article) (error "No such article (may be canceled).")) ))) (defun gnus-Article-show-all-headers () "Show all article headers in article display buffer." (gnus-Article-prepare gnus-current-article t)) (defun gnus-Article-set-mode-line () "Set Article mode line string." (setq mode-line-process (concat " " (if (integerp gnus-current-article) (int-to-string gnus-current-article) "??") "/" (if (integerp gnus-current-group-end) (int-to-string gnus-current-group-end) gnus-current-group-end))) (setq mode-line-buffer-identification (concat "GNUS: " gnus-current-news-group ;; Enough spaces to pad group name to 17 positions. (substring " " 0 (max 0 (- 17 (length gnus-current-news-group)))))) (set-buffer-modified-p t) (sit-for 0)) (defun gnus-Article-convert-format (&optional all-headers) "Beautify article text. If optional argument ALL-HEADERS is non-nil, all of headers will be displayed." (save-excursion (save-restriction (goto-char (point-min)) (kill-line) (kill-line) ;Kill NNTP status message. (let* ((start (point)) (end (condition-case () (progn (search-forward "\n\n") (point)) (error nil))) (has-from nil) (has-date nil)) (if end (progn (narrow-to-region start end) (goto-char start) (setq has-from (search-forward "\nFrom:" nil t)) (goto-char start) (setq has-date (search-forward "\nDate:" nil t)) (if (and (not has-from) has-date) (progn (goto-char start) (search-forward "\nDate:") (beginning-of-line) (kill-line) (kill-line))) (if (not all-headers) (gnus-Article-delete-headers start)) )) )))) (defun gnus-Article-delete-headers (pos) "Delete unnecessary headers." (goto-char pos) (and (stringp gnus-ignored-headers) (while (re-search-forward gnus-ignored-headers nil t) (beginning-of-line) (delete-region (point) (progn (re-search-forward "\n[^ \t]") (forward-char -1) (point)))))) ;; Working on article's buffer (defun gnus-Article-next-page () "Show next page of current article. If end of article, return T. Otherwise return nil." (move-to-window-line -1) (if (eobp) t (scroll-up) nil )) (defun gnus-Article-prev-page () "Show previous page of current article." (scroll-down)) (defun gnus-Article-next-digest () "Move to head of next digested message. Set mark at end of digested message." (end-of-line) (if (re-search-forward "^Subject:[ \t]" nil t) (let ((begin (progn (beginning-of-line) (point)))) ;; Search for end of this message. (end-of-line) (if (re-search-forward "^Subject:[ \t]" nil t) (progn (search-backward "\n\n") (forward-line 1)) (goto-char (point-max))) (push-mark) ;Set mark at end of digested message. (goto-char begin) ;; Show From: and Subject: fields. (recenter 1)) (message "End of message.") )) (defun gnus-Article-prev-digest () "Move to head of previous digested message." (beginning-of-line) (if (re-search-backward "^Subject:[ \t]" nil t) (let ((begin (point))) ;; Search for end of this message. (end-of-line) (if (re-search-forward "^Subject:[ \t]" nil t) (progn (search-backward "\n\n") (forward-line 1)) (goto-char (point-max))) (push-mark) ;Set mark at end of digested message. (goto-char begin) ;; Show From: and Subject: fields. (recenter 1)) (goto-char (point-min)) (message "Top of message.") )) (defun gnus-Article-show-subjects () "Reconfigure windows in order to show subjects." (interactive) (pop-to-buffer gnus-Subject-display-buffer) (delete-other-windows) (gnus-Subject-configure-window)) ;;; ;;; General functions. ;;; (defun gnus-start-news-server (&optional ask-host) "Open network stream to remote news server. If optional argument ASK-HOST is non-nil, ask you host name that news server is running even if it is defined." (if (and nntp-server-process (eq (process-status nntp-server-process) 'open)) ;; Stream is already opened. nil ;; Make sure the stream is closed. (if nntp-server-process (nntp-close-server-internal)) (if (or ask-host (null gnus-server-host)) (setq gnus-server-host (read-string "News Server host: " gnus-server-host))) ;; Actually open news server. (message "Connecting to News Server on %s" gnus-server-host) (if (null (nntp-open-server gnus-server-host)) (error "Cannot open News Server on %s" gnus-server-host)) )) (defun gnus-select-news-group (group &optional show-all) "Select news GROUP. If optional argument SHOW-ALL is non-nil, all of articles in the group are selected." (if (not (nntp-request-group group)) ;; No such news group. nil (setq gnus-current-news-group group) (if show-all (progn ;; Select all active articles. (setq gnus-current-group-begin (car (nth 2 (assoc group gnus-active-assoc)))) (setq gnus-current-group-end (cdr (nth 2 (assoc group gnus-active-assoc)))) (setq gnus-current-group-articles (gnus-uncompress-sequence (nthcdr 2 (assoc group gnus-active-assoc)))) ) ;; Select unread articles only. (setq gnus-current-group-begin (car (nth 2 (assoc group gnus-unread-assoc)))) (setq gnus-current-group-end (cdr (car (reverse (nthcdr 2 (assoc group gnus-unread-assoc)))))) (setq gnus-current-group-articles (gnus-uncompress-sequence (nthcdr 2 (assoc group gnus-unread-assoc)))) ) ;; Reset article pointer and etc. (setq gnus-current-article nil) (setq gnus-previous-article nil) (setq gnus-current-group-unread-articles (gnus-uncompress-sequence (nthcdr 2 (assoc group gnus-unread-assoc)))) (setq gnus-current-group-headers (nntp-retrieve-headers gnus-current-group-articles)) ;; GROUP is selected. t )) (defun gnus-clear-system () "Clear all variables and buffer." ;; Clear variables. (setq gnus-active-assoc nil) (setq gnus-newsrc-assoc nil) (setq gnus-unread-assoc nil) ;; Kill buffers (if (get-buffer gnus-Article-display-buffer) (kill-buffer gnus-Article-display-buffer)) (if (get-buffer gnus-Subject-display-buffer) (kill-buffer gnus-Subject-display-buffer)) (if (get-buffer gnus-Group-display-buffer) (kill-buffer gnus-Group-display-buffer))) (defun gnus-copy-to-buffer (buffer &optional append) "Copy server response to BUFFER (or buffer name). If optional argument APPEND is non-nil, append to buffer." (let ((buffer (get-buffer-create buffer))) (set-buffer buffer) (goto-char (point-max)) (save-excursion (set-buffer (process-buffer nntp-server-process)) (if append (append-to-buffer buffer (point-min) (point-max)) (copy-to-buffer buffer (point-min) (point-max)))) ;; Return BUFFER itself. buffer )) (defun gnus-simplify-subject (subject) "Remove `Re:' and words in parentheses." ;; Remove `Re:' (let ((case-fold-search t)) ;Ignore case. (if (string-match "\\`re: " subject) (while (string-match "\\`re: " subject) (setq subject (substring subject 4)) (if (string-match "\\`[ \t]+\\([^ \t].*\\)\\'" subject) (setq subject (substring subject (match-beginning 1)))) )) ;; Remove words in parentheses. ;; (string-match "([ \t]*in[ \t]+.*)" subject) (while (string-match "(.*)" subject) (setq subject (concat (substring subject 0 (1- (match-beginning 0))) (substring subject (match-end 0)))) ) ;; Return subject string. subject )) ;;; ;;; Get information about active articles, already read articles, and ;;; still unread articles. ;;; ;; GNUS internal format of gnus-newsrc-assoc: ;; (("general" t (1 . 1)) ;; ("misc" t (1 . 10) (12 . 15)) ;; ("test" nil (1 . 99)) ...) ;; GNUS internal format of gnus-active-assoc: ;; (("general" t (1 . 1)) ;; ("misc" t (1 . 10)) ;; ("test" nil (1 . 99)) ...) ;; GNUS internal format of gnus-unread-assoc: ;; (("general" 1 (1 . 1)) ;; ("misc" 14 (1 . 10) (12 . 15)) ;; ("test" 99 (1 . 99)) ...) (defun gnus-setup-news-info (&optional force) "Setup news information. If optional argument FORCE is non-nil, initialize completely." (if (and gnus-active-assoc gnus-newsrc-assoc gnus-unread-assoc (not force)) (progn ;; Re-read active file only. (gnus-read-active-file) (gnus-add-new-news-group) (gnus-get-unread-articles)) ;; Read .newsrc file and active file. (gnus-read-newsrc-file gnus-startup-file) (gnus-read-active-file) (gnus-add-new-news-group) (gnus-get-unread-articles) )) (defun gnus-get-unread-articles () "Compute diffs between active and read articles." (let ((read gnus-newsrc-assoc) (group nil) (range nil) (unread nil)) (message "Checking new news...") (while read (setq group (car read)) ;About one news group (setq range (gnus-difference-of-range (nth 2 (assoc (car group) gnus-active-assoc)) (nthcdr 2 group))) (setq unread (cons (cons (car group) ;Group name (cons (gnus-number-of-articles range) range)) ;Range of unread articles unread)) (setq read (cdr read)) ) (setq gnus-unread-assoc (nreverse unread)) (message "Checking new news... Done.") )) (defun gnus-mark-as-read-by-xref (group headers unreads) "Mark as read using cross reference info. of GROUP with HEADERS and UNREADS. Return list of updated news group." (let ((xref-list nil) (header nil) (xrefs nil)) ;One Xref: field info. (while headers (setq header (car headers)) (if (memq (nntp-headers-number header) unreads) ;; This article is not yet marked as read. nil (setq xrefs (gnus-parse-xref-field (nntp-headers-xref header))) ;; For each cross reference info. on one Xref: field. (while xrefs (let* ((xref (car xrefs)) (group-xref (assoc (car xref) xref-list))) (if (string-equal group (car xref)) ;; Ignore this group. nil (if group-xref (if (memq (cdr xref) (cdr group-xref)) nil ;Alread marked. (setcdr group-xref (cons (cdr xref) (cdr group-xref)))) ;; Create new assoc entry for GROUP. (setq xref-list (cons (list (car xref) (cdr xref)) xref-list))) )) (setq xrefs (cdr xrefs)) )) (setq headers (cdr headers))) ;; Mark cross referenced articles as read. (gnus-mark-xref-as-read xref-list) ;;(message "%s %s" (prin1-to-string unreads) (prin1-to-string xref-list)) ;; Return list of updated group name. (mapcar '(lambda (elt) (car elt)) xref-list) )) (defun gnus-parse-xref-field (xref-value) "Parse Xref: field value, and return list of `(group . article-id)'." (let ((xref-list nil) (xref-value (or xref-value ""))) ;; Remove server host name. (if (string-match "\\`[ \t]*[^ \t,]+[ \t,]+\\(.*\\)\\'" xref-value) (setq xref-value (substring xref-value (match-beginning 1))) (setq xref-value nil)) ;; Process each xref info. (while xref-value (if (string-match "\\`[ \t,]*\\([^ \t,]+\\):\\([0-9]+\\)[^0-9]*" xref-value) (progn (setq xref-list (cons (cons ;; Group name (substring xref-value (match-beginning 1) (match-end 1)) ;; Article-ID (string-to-int (substring xref-value (match-beginning 2) (match-end 2)))) xref-list)) (setq xref-value (substring xref-value (match-end 2)))) (setq xref-value nil))) ;; Return alist. xref-list )) (defun gnus-mark-xref-as-read (xrefs) "Update unread article information using XREFS alist." (let ((group nil) (idlist nil) (unread nil)) (while xrefs (setq group (car (car xrefs))) (setq idlist (cdr (car xrefs))) (setq unread (gnus-uncompress-sequence (nthcdr 2 (assoc group gnus-unread-assoc)))) (while idlist (setq unread (delq (car idlist) unread)) (setq idlist (cdr idlist))) (gnus-update-unread-articles group unread) (setq xrefs (cdr xrefs)) ))) (defun gnus-update-unread-articles (group unread-list) "Update unread article information of news GROUP using UNREAD-LIST." (let ((active (nth 2 (assoc group gnus-active-assoc))) (unread (assoc group gnus-unread-assoc))) ;; Update gnus-unread-assoc. (if unread-list (setcdr (cdr unread) (gnus-compress-sequence unread-list)) ;; All of the articles are read. (setcdr (cdr unread) '((0 . 0)))) ;; Number of unread articles. (setcar (cdr unread) (gnus-number-of-articles (nthcdr 2 unread))) ;; Update gnus-newsrc-assoc. (if (> (car active) 0) ;; Articles from 1 to N are not active. (setq active (cons 1 (cdr active)))) (setcdr (cdr (assoc group gnus-newsrc-assoc)) (gnus-difference-of-range active (nthcdr 2 unread))) )) (defun gnus-compress-sequence (numbers) "Convert list of sorted numbers to ranges." (let* ((numbers (sort (copy-sequence numbers) '<)) ;Sort is destructive. (first (car numbers)) (last (car numbers)) (result nil)) (while numbers (cond ((= last (car numbers)) nil) ;Omit duplicated number ((= (1+ last) (car numbers)) ;Still in sequence (setq last (car numbers))) (t ;End of one sequence (setq result (cons (cons first last) result)) (setq first (car numbers)) (setq last (car numbers))) ) (setq numbers (cdr numbers)) ) (nreverse (cons (cons first last) result)) )) (defun gnus-uncompress-sequence (ranges) "Expand compressed format of sequence." (let ((first nil) (last nil) (result nil)) (while ranges (setq first (car (car ranges))) (setq last (cdr (car ranges))) (while (< first last) (setq result (cons first result)) (setq first (1+ first))) (setq result (cons first result)) (setq ranges (cdr ranges)) ) (nreverse result) )) (defun gnus-number-of-articles (range) "Compute number of articles from RANGE `((beg1 . end1) (beg2 . end2) ...)'." (let ((count 0)) (while range (if (/= (cdr (car range)) 0) ;; If end1 is 0, it must be skipped. Usually no articles in ;; this group. (setq count (+ count 1 (- (cdr (car range)) (car (car range)))))) (setq range (cdr range)) ) count ;Result )) (defun gnus-difference-of-range (src obj) "Compute (SRC - OBJ) on range. Range of SRC is expressed as `(beg . end)'. Range of OBJ is expressed as `((beg1 . end1) (beg2 . end2) ...)." (let ((beg (car src)) (end (cdr src)) (range nil)) ;This is result. ;; Src may be nil. (while (and src obj) (let ((beg1 (car (car obj))) (end1 (cdr (car obj)))) (cond ((> beg end) (setq obj nil)) ;Terminate loop ((< beg beg1) (setq range (cons (cons beg (min (1- beg1) end)) range)) (setq beg (1+ end1))) ((>= beg beg1) (setq beg (max beg (1+ end1)))) ) (setq obj (cdr obj)) ;Next OBJ )) ;; Src may be nil. (if (and src (<= beg end)) (setq range (cons (cons beg end) range))) ;; Result (if range (nreverse range) (list (cons 0 0))) )) (defun gnus-add-new-news-group () "Add new news group to gnus-newsrc-assoc." (let ((active (reverse gnus-active-assoc)) (group nil)) (while active (setq group (car (car active))) (if (null (assoc group gnus-newsrc-assoc)) ;; Found new news group. (let ((subscribe (not (or (string-equal group "control") (string-equal group "junk"))))) (setq gnus-newsrc-assoc (cons (list group subscribe) gnus-newsrc-assoc)) (if subscribe (message "New news group: %s is subscribed." group)) )) (setq active (cdr active)) ))) (defun gnus-clean-up-newsrc () "Mark as read expired articles." (let ((newsrc gnus-newsrc-assoc) (group nil)) (message "Checking expired articles...") (while newsrc (setq group (car (car newsrc))) ;News group name (setq newsrc (cdr newsrc)) (if (assoc group gnus-active-assoc) ;Must be active group (gnus-update-unread-articles group (gnus-uncompress-sequence (nthcdr 2 (assoc group gnus-unread-assoc))))) ) (message "Checking expired articles... Done.") )) (defun gnus-delete-bogus-news-group (&optional confirm) "Delete bogus news group. If optional argument CONFIRM is non-nil, confirm deletion of news groups." (let ((oldrc gnus-newsrc-assoc) (newsrc nil)) (message "Checking bogus news groups...") (while oldrc (if (or (assoc (car (car oldrc)) gnus-active-assoc) (and confirm (not (y-or-n-p (format "Delete bogus news group: %s " (car (car oldrc))))))) ;; Active news group. (setq newsrc (cons (car oldrc) newsrc))) (setq oldrc (cdr oldrc)) ) ;; Update newsrc. (setq gnus-newsrc-assoc (nreverse newsrc)) (message "Checking bogus news groups... Done.") )) (defun gnus-read-active-file () "Get active file from news server." (save-excursion (message "Reading active file...") (if (nntp-request-list) ;Get active file from server (progn ;; Take care of unexpected situations. (gnus-copy-to-buffer " *GNUS-active*") (goto-char (point-min)) (kill-line) (kill-line) ;Kill NNTP status message. (gnus-active-to-gnus-format) ;; Define variable gnus-active-assoc. (eval-current-buffer) (kill-buffer (current-buffer)) (message "Reading active file... Done.") ) (error "Cannot read active file from news server.")) )) (defun gnus-active-to-gnus-format () "Convert NNTP active file format to internal format. Buffer becomes evaluable as lisp expression." ;; Delete unnecessary lines. (goto-char (point-min)) (delete-matching-lines "^to\\..*$") ;; Process each lines. (goto-char (point-min)) (while (not (eobp)) (if (re-search-forward "^\\([^ \t]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([ymn]\\).*$" nil t) (replace-match (concat "(\"\\1\"" (if (string-equal "y" (buffer-substring (match-beginning 4) (match-end 4))) " t " " nil ") "(\\3 . \\2))")) (error "Active format error.")) (forward-line 1)) ;; Make the buffer evaluable. (goto-char (point-min)) (insert "(setq gnus-active-assoc '(\n") (goto-char (point-max)) (insert "))\n") ) (defun gnus-read-newsrc-file (file) "Read in .newsrc FILE." (save-excursion ;; If there exists site dependent .newsrc file (.newsrc-HOST), use ;; it instead of standard .newsrc file. (if (file-exists-p (expand-file-name (concat file "-" gnus-server-host) nil)) (setq file (concat file "-" gnus-server-host))) (let* ((newsrc-file (expand-file-name file nil)) (quick-file (expand-file-name (concat file ".el") nil)) (newsrc-mod (nth 5 (file-attributes newsrc-file))) (quick-mod (nth 5 (file-attributes quick-file)))) (setq gnus-newsrc-options nil) ;Clear options line. (cond ((not (file-exists-p newsrc-file)) ;; No read articles. (setq gnus-newsrc-assoc nil)) ((and newsrc-mod quick-mod ;; .newsrc.el is newer than .newsrc. (or (< (car newsrc-mod) (car quick-mod)) (and (= (car newsrc-mod) (car quick-mod)) (< (nth 1 newsrc-mod) (nth 1 quick-mod))))) ;; Load quick .newsrc (load-file quick-file) (message "")) (t (message "Reading %s..." file) (set-buffer (get-buffer-create " *GNUS-newsrc*")) (insert-file newsrc-file) (gnus-newsrc-to-gnus-format) ;; Define variable gnus-newsrc-assoc. (eval-current-buffer) (kill-buffer (current-buffer)) (message "Reading %s... Done." file)) )))) (defun gnus-newsrc-to-gnus-format () "Convert newsrc format to gnus internal format. Buffer becomes evaluable as lisp expression." ;; Make it easy to edit. (goto-char (point-min)) (replace-regexp "$" " ") (goto-char (point-min)) (replace-string "," " , ") ;; Make sure .newsrc file is formated in standard way. (goto-char (point-min)) (replace-string ":" ": ") (goto-char (point-min)) (replace-string "!" "! ") ;; Save options line to variable. (goto-char (point-min)) (if (re-search-forward "^options[ \t]*\\(.*[^ \t]\\)[ \t]*$" nil t) (progn (setq gnus-newsrc-options (buffer-substring (match-beginning 1) (match-end 1))) ;; Delete options line. (beginning-of-line) (kill-line) (kill-line) ;Kill just one line. )) ;; num -> (num . num) (goto-char (point-min)) (replace-regexp "[ \t]\\([0-9]+\\)[ \t]" "(\\1 . \\1)") ;; num1-num2 -> (num1 . num2) (goto-char (point-min)) (while (re-search-forward "[ \t]\\([0-9]+\\)-\\([0-9]+\\)[ \t]" nil t) (replace-match "(\\1 . \\2)") ;; Need retry on this line. (beginning-of-line)) ;; Delete ','. (goto-char (point-min)) (replace-string "," " ") ;; Put range of read article in list form. (goto-char (point-min)) (replace-regexp "\\(^.*[!:][ ]*\\)\\(.*\\)$" "\\1(\\2)") ;; Process Subscribed news group. (goto-char (point-min)) (replace-regexp "\\(^.*\\):\\(.*\\)$" "(\"\\1\" t . \\2)") ;; Process UnSubscribed news group. (goto-char (point-min)) (replace-regexp "\\(^.*\\)!\\(.*\\)$" "(\"\\1\" nil . \\2)") ;; Make the buffer evaluable. (goto-char (point-min)) (insert "(setq gnus-newsrc-assoc '(\n") (goto-char (point-max)) (insert "))\n") ) (defun gnus-save-newsrc-file (file) "Save to .newsrc FILE." (if gnus-newsrc-assoc (save-excursion ;; If there exists site dependent .newsrc file (.newsrc-HOST), use ;; it instead of standard .newsrc file. (if (file-exists-p (expand-file-name (concat file "-" gnus-server-host) nil)) (setq file (concat file "-" gnus-server-host))) (message "Saving %s..." file) (set-buffer (get-buffer-create " *GNUS-newsrc*")) ;; Row .newsrc. (erase-buffer) (gnus-gnus-to-newsrc-format) (write-file (expand-file-name file nil)) ;; Quickly accessible .newsrc. (erase-buffer) (gnus-gnus-to-quick-newsrc-format) (write-file (expand-file-name (concat file ".el") nil)) (kill-buffer (current-buffer)) (message "Saving %s... Done." file) ) )) (defun gnus-gnus-to-quick-newsrc-format () "Insert gnus-newsrc-assoc as evaluable format." ;; Save options line. (if gnus-newsrc-options (insert "(setq gnus-newsrc-options \"" gnus-newsrc-options "\")\n")) ;; Save newsrc assoc list. (insert "(setq gnus-newsrc-assoc '") (insert (prin1-to-string gnus-newsrc-assoc)) (insert ")")) (defun gnus-gnus-to-newsrc-format () "Convert gnus-newsrc-assoc to .newsrc format." (let ((newsrc gnus-newsrc-assoc) (group nil)) ;; Options line. (if gnus-newsrc-options (insert "options " gnus-newsrc-options "\n")) ;; Article information. (while newsrc (setq group (car newsrc)) (insert (car group) ;Group name (if (nth 1 (assoc (car group) gnus-newsrc-assoc)) ;Subscribed? ": " "! ")) (gnus-ranges-to-newsrc-format (nthcdr 2 group)) ;Read articles (insert "\n") (setq newsrc (cdr newsrc)) ) )) (defun gnus-ranges-to-newsrc-format (ranges) "Insert ranges of read articles." (let ((range nil)) ;Range is a pair of BEGIN and END. (while ranges (setq range (car ranges)) (setq ranges (cdr ranges)) (cond ((= (car range) (cdr range)) (if (= (car range) 0) (setq ranges nil) ;No unread articles. (insert (int-to-string (car range))) (if ranges (insert ",")) )) (t (insert (int-to-string (car range)) "-" (int-to-string (cdr range))) (if ranges (insert ",")) )) ))) ;;; ;;; Post A News using NNTP ;;; (defun gnus-news-reply () "Compose and post a reply (aka a followup) to the current article on JUNET. While composing the followup, use \\[news-reply-yank-original] to yank the original message into it." (interactive) (if (y-or-n-p "Are you sure you want to followup to all of JUNET? ") (let (from cc subject date to followup-to newsgroups message-of references distribution message-id (buffer (current-buffer))) (save-restriction (and (not (= 0 (buffer-size))) ;;(equal major-mode 'news-mode) (equal major-mode 'gnus-Article-mode) (progn ;; (news-show-all-headers) (gnus-Article-show-all-headers) (narrow-to-region (point-min) (progn (goto-char (point-min)) (search-forward "\n\n") (- (point) 2))))) (setq from (mail-fetch-field "from") news-reply-yank-from from subject (mail-fetch-field "subject") date (mail-fetch-field "date") followup-to (mail-fetch-field "followup-to") newsgroups (or followup-to (mail-fetch-field "newsgroups")) references (mail-fetch-field "references") distribution (mail-fetch-field "distribution") message-id (mail-fetch-field "message-id") news-reply-yank-message-id message-id) (pop-to-buffer "*post-news*") (news-reply-mode) (erase-buffer) (and subject (progn (if (string-match "\\`Re: " subject) (while (string-match "\\`Re: " subject) (setq subject (substring subject 4)))) (setq subject (concat "Re: " subject)))) (and from (progn (let ((stop-pos (string-match " *at \\| *@ \\| *(\\| *<" from))) (setq message-of (concat (if stop-pos (substring from 0 stop-pos) from) "'s message of " date))))) (news-setup nil subject message-of newsgroups buffer) (if followup-to (progn (news-reply-followup-to) (insert followup-to))) (mail-position-on-field "References") (if references (insert references)) (if (and references message-id) (insert " ")) (if message-id (insert message-id)) ;; Make sure the article is posted by GNUS. ;;(mail-position-on-field "Posting-Software") ;;(insert "GNUS: NNTP Based News Reader for GNU Emacs") ;; Insert Distribution: field. ;; This feature is suggested by ichikawa@flab.fujitsu.junet. (mail-position-on-field "Distribution") (insert (or distribution gnus-default-distribution "")) (goto-char (point-max)))) (message ""))) (defun gnus-post-news () "Begin editing a new JUNET news article to be posted. Type \\[describe-mode] once editing the article to get a list of commands." (interactive) (if (y-or-n-p "Are you sure you want to post to all of JUNET? ") (let ((buffer (current-buffer)) (subject nil) (newsgroups nil) (distribution nil)) (save-restriction (and (not (= 0 (buffer-size))) ;;(equal major-mode 'news-mode) (equal major-mode 'gnus-Article-mode) (progn ;;(news-show-all-headers) (gnus-Article-show-all-headers) (narrow-to-region (point-min) (progn (goto-char (point-min)) (search-forward "\n\n") (- (point) 2))))) (setq news-reply-yank-from (mail-fetch-field "from") news-reply-yank-message-id (mail-fetch-field "message-id"))) (pop-to-buffer "*post-news*") (news-reply-mode) (erase-buffer) ;; Ask newsgroups, subject and distribution if you are a ;; novice user. ;; This feature is suggested by yuki@flab.fujitsu.junet. (if gnus-novice-user (progn ;; Subscribed news group names are required for ;; completing read of news group. (or gnus-newsrc-assoc (gnus-read-newsrc-file gnus-startup-file)) ;; Which do you like? (UMERIN) ;; (setq newsgroups (read-string "Newsgroups: " "general")) (setq newsgroups (completing-read "Newsgroup: " gnus-newsrc-assoc)) (setq subject (read-string "Subject: ")) (setq distribution (substring newsgroups 0 (string-match "\\." newsgroups))) (if (string-equal distribution newsgroups) ;; Newsgroup may be general or control. In this ;; case, use default distribution. (setq distribution gnus-default-distribution)) (setq distribution (read-string "Distribution: " distribution)) (if (string-equal distribution "") (setq distribution nil)) )) (news-setup () subject () newsgroups buffer) ;; Make sure the article is posted by GNUS. ;;(mail-position-on-field "Posting-Software") ;;(insert "GNUS: NNTP Based News Reader for GNU Emacs") ;; Insert Distribution: field. ;; This feature is suggested by ichikawa@flab.fujitsu.junet. (mail-position-on-field "Distribution") (insert (or distribution gnus-default-distribution "")) (goto-char (point-max)) ) (message ""))) ;; `news-inews' in `newspost.el' is re-defined. (defun news-inews () "Send a news message using NNTP." (interactive) (let* (newsgroups subject (case-fold-search nil) (news-server nntp-server-process)) ;Current news server process (save-excursion ;; It is possible to post a news without reading news using ;; `gnus' before. ;; This feature is suggested by yuki@flab.fujitsu.junet. (gnus-start-news-server) ;Use default news server. ;; News server must be opened before current buffer is modified. (save-restriction (goto-char (point-min)) (search-forward (concat "\n" mail-header-separator "\n")) (narrow-to-region (point-min) (point)) (setq newsgroups (mail-fetch-field "newsgroups") subject (mail-fetch-field "subject"))) (widen) (goto-char (point-min)) (search-forward (concat "\n" mail-header-separator "\n")) (replace-match "\n\n") (goto-char (point-max)) ;; require a newline at the end for inews to append .signature to (or (= (preceding-char) ?\n) (insert ?\n)) (message "Posting to JUNET...") ;; Call inews. ;;(call-process-region (point-min) (point-max) ;; news-inews-program nil 0 nil ;; "-h" ; take all header lines! ;; "-t" subject ;; "-n" newsgroups) ;; Post to NNTP server. (gnus-inews) ;; (message "Posting to JUNET... done") (goto-char (point-min)) ;restore internal header separator (search-forward "\n\n") (replace-match (concat "\n" mail-header-separator "\n")) (set-buffer-modified-p nil)) ;; If news server is opened by `news-inews', close it by myself. (or news-server (nntp-close-server)) (and (fboundp 'bury-buffer) (bury-buffer)))) (defun gnus-inews () "NNTP inews interface." (let ((signature (expand-file-name "~/.signature" nil)) (distribution nil) (lines nil)) (save-excursion (copy-to-buffer " *GNUS-posting*" (point-min) (point-max)) (set-buffer " *GNUS-posting*") ;; Get distribution. (save-restriction (goto-char (point-min)) (search-forward "\n\n") (narrow-to-region (point-min) (point)) (setq distribution (mail-fetch-field "distribution"))) (widen) ;; Change signature file by distribution. ;; This feature is suggested by hyoko@flab.fujitsu.junet. (if (file-exists-p (concat signature "-" distribution)) (setq signature (concat signature "-" distribution))) ;; Insert signature. (if (file-exists-p signature) (progn (goto-char (point-max)) (insert "--\n") (insert-file signature))) ;; Count lines of article body. (goto-char (point-min)) (search-forward "\n\n") (setq lines (count-lines (point) (point-max))) ;; Prepare article headers. (save-restriction (goto-char (point-min)) (search-forward "\n\n") (narrow-to-region (point-min) (point)) (gnus-inews-insert-headers lines)) (widen) ;; Save author copy of posted article. The article must be ;; copied before being posted because `nntp-request-post' ;; modifies the buffer. (cond ((and (stringp gnus-author-copy-file) (string-match "\\`[ \t]*|\\(.*\\)\\'" gnus-author-copy-file)) (let ((program (substring gnus-author-copy-file (match-beginning 1) (match-end 1)))) ;; This feature is suggested by yuki@flab.fujitsu.junet. ;;(message "Piping out article to program: %s" program) ;; Pipe out article to named program. (call-process-region (point-min) (point-max) shell-file-name nil nil nil "-c" program) )) ((stringp gnus-author-copy-file) ;; This feature is suggested by hyoko@flab.fujitsu.junet. ;;(message "Saving article copy to file: %s" ;; gnus-author-copy-file) ;; Save article in Unix mail format. ;; This is much convenient for Emacs user. (rmail-output gnus-author-copy-file))) ;; Post article to NNTP server. (message "Sending your article...") (if (nntp-request-post) (message "Sending your article... Done.") (message "Your article is rejected.")) (kill-buffer (current-buffer)) ))) (defun gnus-inews-control-cancel () "Cancel an article you posted." (let ((from nil) (newsgroups nil) (message-id nil) (distribution nil)) (save-excursion ;; Get header info. from original article. (save-restriction (gnus-Article-show-all-headers) (goto-char (point-min)) (search-forward "\n\n") (narrow-to-region (point-min) (point)) (setq from (mail-fetch-field "from")) (setq newsgroups (mail-fetch-field "newsgroups")) (setq message-id (mail-fetch-field "message-id")) (setq distribution (mail-fetch-field "distribution"))) ;; Verify the article is absolutely user's by comparing user id ;; with value of its From: field. (if (not (string-equal (downcase (mail-strip-quoted-names from)) (downcase (concat (gnus-inews-login-name) "@" (gnus-inews-domain-name))))) (message "The article is not yours.") ;; Create control article. (set-buffer (get-buffer-create " *GNUS-posting*")) (erase-buffer) (insert "Newsgroups: " newsgroups "\n" "Subject: cancel " message-id "\n" "Control: cancel " message-id "\n" ;; We should not use the value of ;; `gnus-default-distribution' as default value, ;; because distribution must be as same as original ;; article. "Distribution: " (or distribution "") "\n" ) ;; Prepare article headers. (gnus-inews-insert-headers 0) (goto-char (point-max)) ;; Insert empty line. (insert "\n") ;; Post control article to NNTP server. (message "Canceling your article...") (if (nntp-request-post) (message "Canceling your article... Done.") (message "Failed to cancel your article.")) (kill-buffer (current-buffer)) )) )) (defun gnus-inews-insert-headers (lines) "Prepare article headers." (save-excursion (let* ((login-name (gnus-inews-login-name)) (domain-name (gnus-inews-domain-name)) (full-name (or (getenv "NAME") (user-full-name))) ;; Message-ID should not contain slash `/' and should be ;; terminated by a number. I don't know the reason why it ;; is so. (UMERIN@flab) (id (concat (upcase login-name) ".GNUS" (int-to-string (gnus-inews-gensym)))) (organization (or (getenv "ORGANIZATION") gnus-your-organization))) ;; Insert from top of headers. (goto-char (point-min)) (insert "Path: " gnus-server-host "!" login-name "\n" "From: " login-name "@" domain-name (if (or (string-equal full-name "") (string-equal full-name "&")) "\n" (concat " (" full-name ")\n")) ) ;; If there is no subject, make Subject: field. (or (mail-fetch-field "subject") (insert "Subject: \n")) ;; Insert random headers. ;; Message-ID is catenation of user's login name, slash (/), ;; user's sequcne number, at sign (@) and user's domain name. (insert "Message-ID: <" id "@" domain-name ">\n" "Date: " (gnus-inews-date) "\n" "Organization: " organization "\n" "Lines: " (int-to-string lines) "\n" ) (or (mail-fetch-field "distribution") (insert "Distribution: \n")) ))) (defun gnus-inews-login-name () "Return user's login name." (or (getenv "USER") (getenv "LOGNAME") (user-login-name))) (defun gnus-inews-domain-name () "Return user's domain name" (let ((domain (or (getenv "DOMAINNAME") gnus-your-domain))) (if (or (null domain) (string-equal domain "")) (progn (setq domain (read-string "Your domain name (no host): ")) (setq gnus-your-domain domain))) (concat (system-name) ;; Host name and domain name must be separated by ;; one period `.'. (if (string-equal "." (substring domain 0 1)) "" ".") domain ) )) (defun gnus-inews-gensym () "Generate next sequence number of article." (let ((env-file (expand-file-name gnus-environment-file nil))) ;; If there exits environment file, we have to load it every time ;; because it may be shared by concurrently running Emacses. (if (file-exists-p env-file) (progn ;; Restore previous session status. ;; The file will setq `gnus-environ-sequence-number'. (load-file env-file) (message ""))) ;; Initialize only once. (if (or (not (boundp 'gnus-environ-sequence-number)) (null gnus-environ-sequence-number)) (setq gnus-environ-sequence-number 0)) ;; Increment sequnce number. (setq gnus-environ-sequence-number (1+ gnus-environ-sequence-number)) ;; We have to save the sequence number every time because there ;; may be no chance to save it else where. (save-excursion (set-buffer (get-buffer-create " *GNUS-environemnt*")) (erase-buffer) (insert ";; You should not change this file.\n" (format "(setq gnus-environ-sequence-number %d)" gnus-environ-sequence-number)) (write-file env-file) (message "") (kill-buffer (current-buffer))) ;; Return sequence number gnus-environ-sequence-number )) (defun gnus-inews-date () "News format date string of today." (let ((date (current-time-string))) (if (string-match "^[^ ]+ \\(.+\\) \\([0-9]+\\) \\([0-9:]+\\) [0-9][0-9]\\([0-9][0-9]\\)" date) (concat (substring date (match-beginning 2) (match-end 2)) ;Day " " (substring date (match-beginning 1) (match-end 1)) ;Month " " (substring date (match-beginning 4) (match-end 4)) ;Year " " (gnus-unix-time-to-gmtime gnus-your-time-zone (substring date (match-beginning 3) (match-end 3))) ;Time " GMT") (error "Invalid date format.")) )) (defun gnus-unix-time-to-gmtime (time-zone time) "Convert unix time to GM time." (if (string-match "^\\([0-9]+\\):\\(.*\\)$" time) (concat (format "%02d" (+ time-zone (string-to-int (substring time (match-beginning 1) (match-end 1))))) ":" (substring time (match-beginning 2) (match-end 2))) (error "Invalid time format.") )) ;;Local variables: ;;eval: (put 'eval-in-buffer-window 'lisp-indent-hook 1) ;;end: