Path: utzoo!utgpu!water!watmath!clyde!att!osu-cis!tut.cis.ohio-state.edu!mailrus!nrl-cmf!ames!pasteur!ucbvax!decwrl!sun!pitstop!sundc!seismo!uunet!kddlab!titcca!fgw!flab!umerin From: umerin@flab.flab.fujitsu.JUNET (Masanobu UMEDA) Newsgroups: comp.emacs,fj.editor.emacs Subject: GNUS 3.8: a NNTP-base news reader for GNU Emacs (2 of 4) Message-ID: <4127@flab.flab.fujitsu.JUNET> Date: 19 Sep 88 03:20:12 GMT Reply-To: umerin@flab.flab.fujitsu.JUNET (Masanobu UMEDA) Organization: Fujitsu Laboratories Ltd., Kawasaki, Japan Lines: 1485 ---- Cut Here and unpack ---- #!/bin/sh # this is part 2 of a multipart archive # do not concatenate these parts, unpack them in order with /bin/sh # file gnus.el continued # CurArch=2 if test ! -r s2_seq_.tmp then echo "Please unpack part 1 first!" exit 1; fi ( read Scheck if test "$Scheck" != $CurArch then echo "Please unpack part $Scheck next!" exit 1; else exit 0; fi ) < s2_seq_.tmp || exit 1 sed 's/^X//' << 'SHAR_EOF' >> gnus.el X (count-lines (point) (point-max))) X (recenter (/ (- (window-height) 2) 2)))) X X;; Walking around subject lines. X X(defun gnus-Subject-next-subject (n &optional unread) X "Go to next N'th subject line. XIf optional argument UNREAD is non-nil, only unread article is selected." X (interactive "p") X (while (and (> n 1) X (gnus-Subject-search-forward unread)) X (setq n (1- n))) X (cond ((gnus-Subject-search-forward unread) X (gnus-Subject-recenter)) X (unread X (message "No more unread articles.")) X (t X (message "No more articles.")) X )) X X(defun gnus-Subject-next-unread-subject (n) X "Go to next N'th unread subject line." X (interactive "p") X (gnus-Subject-next-subject n t)) X X(defun gnus-Subject-prev-subject (n &optional unread) X "Go to previous N'th subject line. XIf optional argument UNREAD is non-nil, only unread article is selected." X (interactive "p") X (while (and (> n 1) X (gnus-Subject-search-backward unread)) X (setq n (1- n))) X (cond ((gnus-Subject-search-backward unread) X (gnus-Subject-recenter)) X (unread X (message "No more unread articles.")) X (t X (message "No more articles.")) X )) X X(defun gnus-Subject-prev-unread-subject (n) X "Go to previous N'th unread subject line." X (interactive "p") X (gnus-Subject-prev-subject n t)) X X;; Walking around subject lines with displaying articles. X X(defun gnus-Subject-configure-window () X "Configure GNUS windows. XOne is for reading subjects and the other is for articles." X (interactive) X (if (or (one-window-p t) X (null (get-buffer-window gnus-Article-buffer)) X (null (get-buffer-window gnus-Subject-buffer))) X (progn X ;; We have to prepare article buffer first to prevent X ;; displaying subject buffer twice. X ;; Suggested by Juha HeinanenX (gnus-Article-setup-buffer) X (switch-to-buffer gnus-Subject-buffer) X (delete-other-windows) X (split-window-vertically X (max window-min-height (1+ gnus-subject-lines-height))) X (other-window 1) X (switch-to-buffer gnus-Article-buffer) X (other-window 1) X ))) X X(defun gnus-Subject-display-article (article &optional all-header) X "Display ARTICLE in article display buffer." X (if (null article) X nil X (gnus-Subject-configure-window) X (gnus-Article-prepare article all-header) X (gnus-Subject-recenter) X (gnus-Subject-set-mode-line) X (run-hooks 'gnus-Select-article-hook) X ;; Successfully display article. X t X )) X X(defun gnus-Subject-select-article (&optional all-headers force) X "Select current article. XOptional argument ALL-HEADERS is non-nil, show all headers." X (let ((article (gnus-Subject-article-number))) X (if (or (null gnus-current-article) X (/= article gnus-current-article) X (and force (not (eq all-headers gnus-have-all-headers)))) X ;; Selected subject is different from current article's. X (gnus-Subject-display-article article all-headers) X (gnus-Subject-configure-window)) X )) X X;;(defun gnus-Subject-next-article (unread &optional subject) X;; "Select article after current one. X;;If argument UNREAD is non-nil, only unread article is selected." X;; (interactive "P") X;; (cond ((gnus-Subject-display-article X;; (gnus-Subject-search-forward unread subject))) X;; (unread X;; (message "No more unread articles.")) X;; (t X;; (message "No more articles.")) X;; )) X X(defun gnus-Subject-next-article (unread &optional subject) X "Select article after current one. XIf argument UNREAD is non-nil, only unread article is selected." X (interactive "P") X (cond ((gnus-Subject-display-article X (gnus-Subject-search-forward unread subject))) X ((and subject X gnus-auto-select-same X (gnus-set-difference gnus-current-group-unreads X gnus-current-group-marked) X (memq (key-binding (this-command-keys)) X '(gnus-Subject-next-unread-article X gnus-Subject-next-page X ;;gnus-Subject-next-article X ;;gnus-Subject-next-same-subject X ;;gnus-Subject-next-unread-same-subject X ))) X ;; No more articles with same subject, so jump to the first X ;; unread article. X (let ((last-point (point))) X (gnus-Subject-first-unread-article) X (if (< (point) last-point) X (message "Wrapped.")) X )) X (t X (let* ((keyseq (this-command-keys)) X (cmd (string-to-char keyseq)) X (group (gnus-Subject-next-group-name)) X (auto-select X (and gnus-auto-select-next X (or (null subject) X (null X (gnus-set-difference gnus-current-group-unreads X gnus-current-group-marked))) X (memq (key-binding keyseq) X '(gnus-Subject-next-unread-article X gnus-Subject-next-article X gnus-Subject-next-page X gnus-Subject-next-same-subject X gnus-Subject-next-unread-same-subject X )) X ;; Ignore characters typed ahead. X (not (input-pending-p)) X ))) X (message "No more%s articles%s" X (if unread " unread" "") X (if auto-select X (if group X (format " (Type %s to %s [%d])" X (key-description (char-to-string cmd)) X group X (nth 1 (gnus-gethash group X gnus-unread-hashtb))) X (format " (Type %s to exit %s)" X (key-description (char-to-string cmd)) X gnus-current-group-name X )) X ".")) X ;; Select next unread newsgroup automagically. X (if auto-select X (let ((char nil)) X (setq char (read-char)) X (message "") X (if (= char cmd) X (if (null group) X (gnus-Subject-exit) X (gnus-Subject-exit t) ;Exit temporary. X (gnus-Subject-read-group group nil nil) X (or (eq (current-buffer) X (get-buffer gnus-Subject-buffer)) X (eq gnus-auto-select-next t) X ;; Expected newsgroup has nothing to read X ;; since the articles are marked as read X ;; by cross-referencing. So, try next X ;; newsgroup. X (let ((group X (save-excursion X (set-buffer gnus-Group-buffer) X (gnus-Group-group-name)))) X (if group X (gnus-Subject-read-group group nil nil)))) X ) X (setq unread-command-char char)) X )) X )) X )) X X(defun gnus-Subject-next-group-name () X "Return next unread newsgroup name." X (save-excursion X (set-buffer gnus-Group-buffer) X (save-excursion X ;; We don't want to alter current point of group selection buffer. X (if (gnus-Group-search-forward nil nil) X (gnus-Group-group-name)) X ))) X X(defun gnus-Subject-next-unread-article () X "Select unread article after current one." X (interactive) X (gnus-Subject-next-article t (and gnus-auto-select-same X (gnus-Subject-subject-string)))) X X(defun gnus-Subject-prev-article (unread &optional subject) X "Select article before current one. XIf argument UNREAD is non-nil, only unread article is selected." X (interactive "P") X (cond ((gnus-Subject-display-article X (gnus-Subject-search-backward unread subject))) X ((and subject X gnus-auto-select-same X (gnus-set-difference gnus-current-group-unreads X gnus-current-group-marked) X (memq (key-binding (this-command-keys)) X '(gnus-Subject-prev-unread-article X ;;gnus-Subject-prev-page X ;;gnus-Subject-prev-article X ;;gnus-Subject-prev-same-subject X ;;gnus-Subject-prev-unread-same-subject X ))) X ;; Ignore given SUBJECT, and try again. X (gnus-Subject-prev-article unread nil)) X (unread X (message "No more unread articles.")) X (t X (message "No more articles.")) X )) X X(defun gnus-Subject-prev-unread-article () X "Select unred article before current one." X (interactive) X (gnus-Subject-prev-article t (and gnus-auto-select-same X (gnus-Subject-subject-string)))) X X(defun gnus-Subject-next-page (lines) X "Show next page of selected article. XIf end of artile, select next article. XArgument LINES specifies lines to be scrolled up." X (interactive "P") X (let ((article (gnus-Subject-article-number)) X (endp nil)) X (if (or (null gnus-current-article) X (/= article gnus-current-article)) X ;; Selected subject is different from current article's. X (gnus-Subject-display-article article) X (gnus-Subject-configure-window) X (eval-in-buffer-window gnus-Article-buffer X (setq endp (gnus-Article-next-page lines))) X (if endp X (gnus-Subject-next-unread-article))) X )) X X(defun gnus-Subject-prev-page (lines) X "Show previous page of selected article. XArgument LINES specifies lines to be scrolled down." X (interactive "P") X (let ((article (gnus-Subject-article-number))) X (if (or (null gnus-current-article) X (/= article gnus-current-article)) X ;; Selected subject is different from current article's. X (gnus-Subject-display-article article) X (gnus-Subject-configure-window) X (eval-in-buffer-window gnus-Article-buffer X (gnus-Article-prev-page lines)) X ))) X X(defun gnus-Subject-next-same-subject () X "Select next article which has the same subject as current one." X (interactive) X (gnus-Subject-next-article nil (gnus-Subject-subject-string))) X X(defun gnus-Subject-prev-same-subject () X "Select previous article which has the same subject as current one." X (interactive) X (gnus-Subject-prev-article nil (gnus-Subject-subject-string))) X X(defun gnus-Subject-next-unread-same-subject () X "Select next unread article which has the same subject as current one." X (interactive) X (gnus-Subject-next-article t (gnus-Subject-subject-string))) X X(defun gnus-Subject-prev-unread-same-subject () X "Select previous unread article which has the same subject as current one." X (interactive) X (gnus-Subject-prev-article t (gnus-Subject-subject-string))) X X(defun gnus-Subject-goto-parent-article () X "Select parent article of current article in currently visible subjects." X (interactive) X (gnus-Subject-select-article t t) ;Request all headers. X (let ((message-id nil)) X ;; Look for parent Message-ID. X (eval-in-buffer-window gnus-Article-buffer X (save-restriction X (widen) X (goto-char (point-min)) X (narrow-to-region (point) X (save-excursion X (search-forward "\n\n" nil t) (point))) X (if (re-search-forward X "^References:[ \t].*\\(<[^<>]+>\\)[ \t]*$" nil t) X (setq message-id X (buffer-substring (match-beginning 1) (match-end 1)))) X )) X (if (stringp message-id) X (let ((parent X (nntp-find-header-by-id gnus-current-group-headers X message-id))) X (if parent X (gnus-Subject-goto-article (nntp-header-number parent)) X (message "Cannot find parent article."))) X (message "No parent article.")) X )) X X(defun gnus-Subject-next-digest (nth) X "Move to head of NTH next digested message." X (interactive "p") X (gnus-Subject-select-article) X (eval-in-buffer-window gnus-Article-buffer X (gnus-Article-next-digest (or nth 1)) X )) X X(defun gnus-Subject-prev-digest (nth) X "Move to head of NTH previous digested message." X (interactive "p") X (gnus-Subject-select-article) X (eval-in-buffer-window gnus-Article-buffer X (gnus-Article-prev-digest (or nth 1)) X )) X X(defun gnus-Subject-first-unread-article () X "Select first unread article. Return non-nil if successfully selected." X (interactive) X (let ((begin (point))) X (goto-char (point-min)) X (if (re-search-forward "^ [ \t]+[0-9]+:" nil t) X (gnus-Subject-display-article (gnus-Subject-article-number)) X ;; If there is no unread articles, stay there. X (goto-char begin) X ;;(gnus-Subject-display-article (gnus-Subject-article-number)) X (message "No more unread articles.") X nil X ) X )) X X(defun gnus-Subject-search-article-body () X "Search on article body." X (interactive) X (gnus-Subject-select-article) X (eval-in-buffer-window gnus-Article-buffer X (call-interactively 'isearch-forward) X )) X X(defun gnus-Subject-beginning-of-article () X "Go to beginning of article body" X (interactive) X (gnus-Subject-select-article) X (eval-in-buffer-window gnus-Article-buffer X (widen) X (beginning-of-buffer) X (if gnus-break-pages X (narrow-to-page)) X )) X X(defun gnus-Subject-end-of-article () X "Go to end of article body" X (interactive) X (gnus-Subject-select-article) X (eval-in-buffer-window gnus-Article-buffer X (widen) X (end-of-buffer) X (if gnus-break-pages X (narrow-to-page)) X )) X X(defun gnus-Subject-goto-article (article) X "Read ARTICLE if exists." X (interactive X (list X (string-to-int X (completing-read "Article number: " X (mapcar X (function X (lambda (headers) X (list X (int-to-string (nntp-header-number headers))))) X gnus-current-group-headers) X nil 'require-match)))) X (if (gnus-Subject-goto-subject article) X (gnus-Subject-display-article article))) X X(defun gnus-Subject-goto-last-article () X "Go to last subject line." X (interactive) X (if gnus-previous-article X (gnus-Subject-goto-article gnus-previous-article))) X X(defun gnus-Subject-toggle-header () X "Show original article header if pruned header currently shown, or vice versa." X (interactive) X (gnus-Subject-select-article (not gnus-have-all-headers) t)) X X(defun gnus-Subject-show-all-headers () X "Show original article header." X (interactive) X (gnus-Subject-select-article t t)) X X(defun gnus-Subject-stop-page-breaking () X "Stop page breaking by linefeed temporary (Widen article buffer)." X (interactive) X (gnus-Subject-select-article) X (eval-in-buffer-window gnus-Article-buffer X (widen) X )) X X(defun gnus-Subject-kill-same-subject (unmark) X "Mark articles which has the same subject as read. XIf argument UNMARK is non-nil, mark articles as unread instead." X (interactive "P") X (let ((count X (gnus-Subject-mark-same-subject X (gnus-Subject-subject-string) unmark))) X (gnus-Subject-next-article (not unmark)) X (message "%d articles are marked as %s." X count (if unmark "unread" "read")) X )) X X(defun gnus-Subject-kill-same-subject-without-reading (unmark) X "Mark articles which has the same subject as read. XDon't select article after that. XIf argument UNMARK is non-nil, mark articles as unread instead." X (interactive "P") X (let ((count X (gnus-Subject-mark-same-subject X (gnus-Subject-subject-string) unmark))) X (gnus-Subject-next-subject 1 (not unmark)) X (message "%d articles are marked as %s." X count (if unmark "unread" "read")) X )) X X(defun gnus-Subject-mark-same-subject (subject &optional unmark) X "Mark articles with same SUBJECT as read. XReturn number of articles marked as read. XIf optional argument UNMARK is non-nil, mark as unread instead." X (save-excursion X (let ((count 1)) X (if unmark X (gnus-Subject-mark-as-unread) X (gnus-Subject-mark-as-read)) X (while (and subject X (gnus-Subject-search-forward nil subject)) X (if unmark X (gnus-Subject-mark-as-unread) X (gnus-Subject-mark-as-read)) X (setq count (1+ count)) X ) X ;; Return number of articles marked as read. X count X ))) X X(defun gnus-Subject-mark-unread-forward () X "Mark current subject as unread, and then go forward." X (interactive) X (gnus-Subject-mark-as-unread) X (gnus-Subject-next-subject 1 nil)) X X(defun gnus-Subject-mark-unread-backward () X "Mark current subject as unread, and then go backward." X (interactive) X (gnus-Subject-mark-as-unread) X (gnus-Subject-prev-subject 1 nil)) X X(defun gnus-Subject-mark-as-unread (&optional article) X "Mark current article as unread. XOptional argument ARTICLE specifies article to be marked as unread." X (save-excursion X (set-buffer gnus-Subject-buffer) X (let* ((buffer-read-only nil) X (current (gnus-Subject-article-number)) X (article (or article current))) X ;; Add to unread and marked list. X (or (memq article gnus-current-group-unreads) X (setq gnus-current-group-unreads X (cons article gnus-current-group-unreads))) X (or (memq article gnus-current-group-marked) X (setq gnus-current-group-marked X (cons article gnus-current-group-marked))) X (if (or (eq article current) X (gnus-Subject-goto-subject article)) X (progn X (beginning-of-line) X (delete-char 1) X (insert "-"))) X ))) X X(defun gnus-Subject-mark-read-forward () X "Mark current subject as read, and then go forward." X (interactive) X (gnus-Subject-mark-as-read) X (gnus-Subject-next-subject 1 'marked)) X X(defun gnus-Subject-mark-read-backward () X "Mark current subject as read, and then go backward." X (interactive) X (gnus-Subject-mark-as-read) X (gnus-Subject-prev-subject 1 'marked)) X X(defun gnus-Subject-mark-as-read (&optional article) X "Mark ARTICLE's subject as read." X (save-excursion X (set-buffer gnus-Subject-buffer) X (let* ((buffer-read-only nil) X (current (gnus-Subject-article-number)) X (article (or article current))) X (if (memq article gnus-current-group-unreads) X (progn X ;; Remove from unread and marked list. X (setq gnus-current-group-unreads X (delq article gnus-current-group-unreads)) X (setq gnus-current-group-marked X (delq article gnus-current-group-marked)) X (if (or (eq article current) X (gnus-Subject-goto-subject article)) X (progn X (beginning-of-line) X (delete-char 1) X (insert "D"))) X )) X ))) X X(defun gnus-Subject-catch-up () X "Mark all articles in this newsgroup as read." X (interactive) X (if (y-or-n-p "Do you really want to mark everything as read? ") X (let ((unreads gnus-current-group-unreads)) X (while unreads X (gnus-Subject-mark-as-read (car unreads)) X (setq unreads (cdr unreads)) X )) X )) X X(defun gnus-Subject-catch-up-and-exit () X "Mark all articles in this newsgroup as read, and then exit." X (interactive) X (if (y-or-n-p "Do you really want to mark everything as read? ") X (progn X (setq gnus-current-group-unreads nil) X (setq gnus-current-group-marked nil) X (gnus-Subject-exit)) X )) X X(defun gnus-Subject-toggle-truncation (arg) X "Toggle truncation of subject lines. XWith arg, turn line truncation on iff arg is positive." X (interactive "P") X (setq truncate-lines X (if (null arg) (not truncate-lines) X (> (prefix-numeric-value arg) 0))) X (redraw-display)) X X(defun gnus-Subject-sort-by-number (reverse) X "Sort subject display buffer by article number. XArgument REVERSE means reverse order." X (interactive "P") X (gnus-Subject-sort-subjects X (function X (lambda (a b) X (< (nntp-header-number a) (nntp-header-number b)))) X reverse X )) X X(defun gnus-Subject-sort-by-author (reverse) X "Sort subject display buffer by author name alphabetically. XArgument REVERSE means reverse order." X (interactive "P") X (gnus-Subject-sort-subjects X (function X (lambda (a b) X (string-lessp (nntp-header-from a) (nntp-header-from b)))) X reverse X )) X X(defun gnus-Subject-sort-by-subject (reverse) X "Sort subject display buffer by subject alphabetically. XArgument REVERSE means reverse order." X (interactive "P") X (gnus-Subject-sort-subjects X (function X (lambda (a b) X (string-lessp (nntp-header-subject a) (nntp-header-subject b)))) X reverse X )) X X(defun gnus-Subject-sort-by-date (reverse) X "Sort subject display buffer by posted date. XArgument REVERSE means reverse order." X (interactive "P") X (gnus-Subject-sort-subjects X (function X (lambda (a b) X (gnus-date-lessp (nntp-header-date a) (nntp-header-date b)))) X reverse X )) X X(defun gnus-Subject-sort-subjects (predicate &optional reverse) X "Sort subject display buffer by PREDICATE." X (let ((current (gnus-Subject-article-number))) X (setq gnus-current-group-headers X (if reverse X (nreverse (sort (nreverse gnus-current-group-headers) predicate)) X (sort gnus-current-group-headers predicate))) X (gnus-Subject-prepare) X (if current X (gnus-Subject-goto-subject current)) X )) X X(defun gnus-Subject-show-all-subjects () X "Show all subjects in this newsgroup." X (interactive) X (let ((current-subject (gnus-Subject-article-number)) X (current-unreads gnus-current-group-unreads) X (current-marked gnus-current-group-marked)) X (message "Retrieving newsgroup: %s..." gnus-current-group-name) X (if (gnus-select-news-group gnus-current-group-name t) X (progn X (setq gnus-current-group-unreads current-unreads) X (setq gnus-current-group-marked current-marked) X (run-hooks 'gnus-Select-group-hook) X (gnus-Subject-prepare) X (if current-subject X (gnus-Subject-goto-subject current-subject))) X ;; What's happening now? X (setq gnus-current-group-unreads current-unreads) X (setq gnus-current-group-marked current-marked)) X )) X X(defun gnus-Subject-caesar-message (rotnum) X "Caesar rotates all letters of current message by 13/47 places. XWith prefix arg, specifies the number of places to rotate each letter forward. XCaesar rotates Japanese letters by 47 places in any case." X (interactive "P") X (gnus-Subject-select-article) X (eval-in-buffer-window gnus-Article-buffer X (news-caesar-buffer-body rotnum) X )) X X(defun gnus-Subject-rmail-digest () X "Read digest message using RMAIL." X (interactive) X (gnus-Subject-select-article) X (let ((last-dir default-directory) X (file X (expand-file-name X (concat (upcase (user-login-name)) "-GNUS-Digest") X gnus-digest-temp-directory))) X (if (get-file-buffer file) X (progn X ;; Clear old contents. X (set-buffer (get-file-buffer file)) X (set-buffer-modified-p nil) X (kill-buffer (current-buffer)))) X ;; Once delete work file. X (if (file-exists-p file) X (delete-file file)) X (eval-in-buffer-window gnus-Article-buffer X (rmail-output file)) X (rmail-input file) ;Run RMAIL. X (setq default-directory last-dir) ;Restore directory. X (setq rmail-last-file X (if gnus-use-long-file-name X (gnus-savedir-pathname gnus-current-group-name) X (expand-file-name X (int-to-string gnus-current-article) X (gnus-savedir-pathname gnus-current-group-name)))) X (condition-case () X (progn X (undigestify-rmail-message) X (rmail-expunge) ;Delete original message. X (delete-other-windows)) X (error (message "Message is not a digest.") X (set-buffer-modified-p nil) X (kill-buffer (current-buffer)))) X )) X X(defun gnus-Subject-post-news () X "Post an article." X (interactive) X (gnus-Subject-select-article) X (switch-to-buffer gnus-Article-buffer) X (widen) X (delete-other-windows) X (bury-buffer gnus-Article-buffer) X (gnus-post-news)) X X(defun gnus-Subject-post-reply () X "Post a reply article." X (interactive) X (gnus-Subject-select-article) X (switch-to-buffer gnus-Article-buffer) X (widen) X (delete-other-windows) X (bury-buffer gnus-Article-buffer) X (gnus-news-reply)) X X(defun gnus-Subject-cancel () X "Cancel an article you posted." X (interactive) X (gnus-Subject-select-article) X (eval-in-buffer-window gnus-Article-buffer X (if (yes-or-no-p "Do you really want to cancel this article? ") X (gnus-inews-control-cancel)) X )) X X(defun gnus-Subject-mail-reply () X "Reply mail to news author." X (interactive) X (gnus-Subject-select-article) X (switch-to-buffer gnus-Article-buffer) X (widen) X (delete-other-windows) X (bury-buffer gnus-Article-buffer) X (news-mail-reply)) X X(defun gnus-Subject-mail-other-window () X "Reply mail to news author in other window." X (interactive) X (gnus-Subject-select-article) X (switch-to-buffer gnus-Article-buffer) X (widen) X (delete-other-windows) X (bury-buffer gnus-Article-buffer) X (news-mail-other-window)) X X(defun gnus-Subject-save-article () X "Save this article using default saver function. XVariable `gnus-article-default-saver' specifies the saver function." X (interactive) X (gnus-Subject-select-article) X (if (and gnus-article-default-saver X (fboundp gnus-article-default-saver)) X (call-interactively gnus-article-default-saver) X (error "No default saver function is defined."))) X X(defun gnus-Subject-save-in-mail (&optional file) X "Append this article to Unix mail file. XDirectory to save to is default to `gnus-article-save-directory' which Xis initialized from the SAVEDIR environment variable. XOptional argument FILE specifies the name of the file." X (interactive) X (gnus-Subject-save-in-file file 'unix)) X X(defun gnus-Subject-save-in-file (&optional file style) X "Append this article to file. XDirectory to save to is default to `gnus-article-save-directory' which Xis initialized from the SAVEDIR environment variable. XOptional 1st argument FILE specifies the name of the file. XOptional 2nd argument STYLE specifies saving format of the article. It Xmust be one of nil (for plain file) or unix (for unix mail format)." X (interactive) X (gnus-Subject-select-article) X (eval-in-buffer-window gnus-Article-buffer X (save-excursion X (save-restriction X (widen) X (let ((buffer-read-only nil) X (file X (or file X (read-file-name X (cond ((eq style 'unix) X "Save article in Unix mail file: ") X (t X "Save article in file: ")) X (if gnus-use-long-file-name X (gnus-savedir-pathname gnus-current-group-name) X (expand-file-name X (int-to-string gnus-current-article) X (gnus-savedir-pathname gnus-current-group-name))))))) X (gnus-make-directory (file-name-directory file)) X (cond ((eq style 'unix) X ;; Save in unix mail format. X (rmail-output file)) X (t X ;; Save as plain file. X (unwind-protect X ;; Append newline at end of the buffer as X ;; separator, and then save it to file. After X ;; that, delete the newline safely. X (progn X (goto-char (point-max)) X (insert "\n") X (append-to-file (point-min) (point-max) file)) X (delete-region (1- (point-max)) (point-max))))) X ;; Remember the directory name to save articles. X ;;(setq gnus-article-save-directory (file-name-directory file)) X ) X )) X )) X X(defun gnus-Subject-save-in-folder (&optional folder) X "Save this article to MH folder (using `rcvstore' in MH library). XFolder to save in is default to `gnus-article-mh-folder'. XOptional argument FOLDER specifies folder name to save in." X (interactive) X (gnus-Subject-select-article) X (eval-in-buffer-window gnus-Article-buffer X (save-restriction X (widen) X ;; Thanks to yuki@flab.Fujitsu.JUNET. X (shell-command-on-region X (point-min) (point-max) X (concat (expand-file-name "rcvstore" mh-lib) X " " X (or folder X (mh-prompt-for-folder "Save article in" X gnus-article-mh-folder t) X )) X nil) X ))) X X(defun gnus-Subject-pipe-output () X "Pipe this article to command subprocess." X (interactive) X (gnus-Subject-select-article) X (eval-in-buffer-window gnus-Article-buffer X (save-restriction X (widen) X (shell-command-on-region (point-min) (point-max) X (read-string "Shell command on article: ") nil)) X )) X X(defun gnus-Subject-exit (&optional temporary) X "Exit reading current newsgroup, and then return to group selection mode." X (interactive) X (let ((updated nil)) X (gnus-update-unread-articles gnus-current-group-name X gnus-current-group-unreads X gnus-current-group-marked) X (setq updated X (gnus-mark-as-read-by-xref gnus-current-group-name X gnus-current-group-headers X gnus-current-group-unreads)) X (if temporary X ;; Do not switch windows but change buffer to work. X (set-buffer gnus-Group-buffer) X ;; Return to Group selection mode. X (if (get-buffer gnus-Subject-buffer) X (bury-buffer gnus-Subject-buffer)) X (if (get-buffer gnus-Article-buffer) X (bury-buffer gnus-Article-buffer)) X (switch-to-buffer gnus-Group-buffer) X (delete-other-windows)) X ;; Update cross referenced group info. X (while updated X (gnus-Group-update-group (car updated) t) ;Ignore non-visible group. X (setq updated (cdr updated))) X (gnus-Group-update-group gnus-current-group-name) X (gnus-Group-next-unread-group 1) X )) X X(defun gnus-Subject-quit () X "Quit reading current newsgroup without updating read article info." X (interactive) X (if (y-or-n-p "Do you really wanna quit reading this group? ") X (progn X ;; Return to Group selection mode. X (if (get-buffer gnus-Subject-buffer) X (bury-buffer gnus-Subject-buffer)) X (if (get-buffer gnus-Article-buffer) X (bury-buffer gnus-Article-buffer)) X (switch-to-buffer gnus-Group-buffer) X (delete-other-windows) X (gnus-Group-next-unread-group 1) X ))) X X X;;; X;;; GNUS Article display mode X;;; X X(if gnus-Article-mode-map X nil X (setq gnus-Article-mode-map (make-keymap)) X (suppress-keymap gnus-Article-mode-map) X (define-key gnus-Article-mode-map " " 'gnus-Article-next-page) X (define-key gnus-Article-mode-map "\177" 'gnus-Article-prev-page) X (define-key gnus-Article-mode-map "h" 'gnus-Article-show-subjects) X (define-key gnus-Article-mode-map "s" 'gnus-Article-show-subjects) X (define-key gnus-Article-mode-map "?" 'describe-mode) X (define-key gnus-Article-mode-map "q" 'gnus-Subject-exit) X (define-key gnus-Article-mode-map "Q" 'gnus-Subject-quit)) X X(defun gnus-Article-mode () X "Major mode for reading news articles. XAll normal editing commands are turned off. XInstead, these commands are available: X\\{gnus-Article-mode-map} X XVarious hooks for customization: X gnus-Article-mode-hook X Entry to this mode calls the value with no arguments, if that X value is non-nil. X X gnus-Article-prepare-hook X Called with no arguments after an article is prepared for reading, X if that value is non-nil." X (interactive) X (kill-all-local-variables) X (setq major-mode 'gnus-Article-mode) X (setq mode-name "GNUS Article") X (gnus-Article-set-mode-line) X (use-local-map gnus-Article-mode-map) X (make-variable-buffer-local 'page-delimiter) X (setq page-delimiter gnus-page-delimiter) X (make-variable-buffer-local 'mail-header-separator) X (setq mail-header-separator "") ;For caesar function. X (setq buffer-read-only t) ;Disable modification X (run-hooks 'gnus-Article-mode-hook)) X X(defun gnus-Article-setup-buffer () X "Initialize article display buffer." X (or (get-buffer gnus-Article-buffer) X (save-excursion X (set-buffer (get-buffer-create gnus-Article-buffer)) X (gnus-Article-mode)) X )) X X(defun gnus-Article-prepare (article &optional all-headers) X "Prepare ARTICLE in article display buffer. XIf optional argument ALL-HEADERS is non-nil, all headers are inserted." X (save-excursion X (set-buffer gnus-Article-buffer) X (let ((buffer-read-only nil)) X (erase-buffer) X (if (nntp-request-article article) X (progn X ;; Setup article buffer X (gnus-copy-to-buffer (current-buffer)) X (gnus-Article-convert-format all-headers) X (setq gnus-have-all-headers all-headers) X (if gnus-break-pages X (narrow-to-page)) X (if (not (eq article gnus-current-article)) X (progn X ;; Set article pointer. X (setq gnus-previous-article gnus-current-article) X (setq gnus-current-article article) X (or (memq gnus-current-article gnus-current-group-marked) X (gnus-Subject-mark-as-read gnus-current-article)) X )) X ;; Next function must be called after setting X ;; `gnus-current-article' variable. X (gnus-Article-set-mode-line) X ;; Hooks for modifying contents of article. X (run-hooks 'gnus-Article-prepare-hook)) X (gnus-Subject-mark-as-read article) X (message "No such article (may be canceled).")) X ))) X X(defun gnus-Article-show-all-headers () X "Show all article headers in article display buffer." X (gnus-Article-setup-buffer) X (gnus-Article-prepare gnus-current-article t)) X X(defun gnus-Article-set-mode-line () X "Set Article mode line string." X (setq mode-line-buffer-identification X (concat "GNUS: " X gnus-current-group-name X (format "/%d" gnus-current-article) X ;; Enough spaces to pad group name to 17 positions. X (substring " " X 0 (max 0 (- 17 (length gnus-current-group-name)))))) X (set-buffer-modified-p t) X (sit-for 0)) X X(defun gnus-Article-convert-format (&optional all-headers) X "Beautify article text. XIf optional argument ALL-HEADERS is non-nil, all of headers will be displayed." X (save-excursion X (save-restriction X (goto-char (point-min)) X (narrow-to-region (point-min) X (condition-case () X (progn (search-forward "\n\n") (point)) X (error (point-max)))) X (if (not all-headers) X (gnus-Article-delete-headers)) X ))) X X(defun gnus-Article-delete-headers () X "Delete unnecessary headers." X (goto-char (point-min)) X (and (stringp gnus-ignored-headers) X (while (re-search-forward gnus-ignored-headers nil t) X (beginning-of-line) X (delete-region (point) X (progn (re-search-forward "\n[^ \t]") X (forward-char -1) X (point)))))) X X;; Working on article's buffer X X(defun gnus-Article-next-page (lines) X "Show next page of current article. XIf end of article, return non-nil. Otherwise return nil. XArgument LINES specifies lines to be scrolled up." X (interactive "P") X (move-to-window-line -1) X (if (eobp) X (if (or (not gnus-break-pages) X (save-restriction (widen) (eobp))) ;Real end-of-buffer? X t X (narrow-to-page 1) ;Go to next page. X nil X ) X (scroll-up lines) X nil X )) X X(defun gnus-Article-prev-page (lines) X "Show previous page of current article. XArgument LINES specifies lines to be scrolled down." X (interactive "P") X (move-to-window-line 0) X (if (and gnus-break-pages X (bobp) X (not (save-restriction (widen) (bobp)))) ;Real beginning-of-buffer? X (narrow-to-page -1) ;Go to previous page. X (scroll-down lines))) X X(defun gnus-Article-next-digest (nth) X "Move to head of NTH next digested message. XSet mark at end of digested message." X ;; Stop page breaking in digest mode. X (widen) X (end-of-line) X ;; Skip NTH - 1 digest. X ;; This feature is suggested by Khalid Sattar . X (while (and (> nth 1) X (re-search-forward "^Subject:[ \t]" nil 'move)) X (setq nth (1- nth))) X (if (re-search-forward "^Subject:[ \t]" nil t) X (let ((begin (point))) X ;; Search for end of this message. X (end-of-line) X (if (re-search-forward "^Subject:[ \t]" nil t) X (progn X (search-backward "\n\n") X (forward-line 1)) X (goto-char (point-max))) X (push-mark) ;Set mark at end of digested message. X (goto-char begin) X (beginning-of-line) X ;; Show From: and Subject: fields. X (recenter 1)) X (message "End of message.") X )) X X(defun gnus-Article-prev-digest (nth) X "Move to head of NTH previous digested message." X ;; Stop page breaking in digest mode. X (widen) X (beginning-of-line) X ;; Skip NTH - 1 digest. X ;; This feature is suggested by Khalid Sattar . X (while (and (> nth 1) X (re-search-backward "^Subject:[ \t]" nil 'move)) X (setq nth (1- nth))) X (if (re-search-backward "^Subject:[ \t]" nil t) X (let ((begin (point))) X ;; Search for end of this message. X (end-of-line) X (if (re-search-forward "^Subject:[ \t]" nil t) X (progn X (search-backward "\n\n") X (forward-line 1)) X (goto-char (point-max))) X (push-mark) ;Set mark at end of digested message. X (goto-char begin) X ;; Show From: and Subject: fields. X (recenter 1)) X (goto-char (point-min)) X (message "Top of message.") X )) X X(defun gnus-Article-show-subjects () X "Reconfigure windows in order to show subjects." X (interactive) X (delete-other-windows) ;Force re-configure windows. X (gnus-Subject-configure-window)) X X X;;; X;;; Kill file X;;; X X(if gnus-Kill-file-mode-map X nil X (setq gnus-Kill-file-mode-map (make-keymap)) X (define-key gnus-Kill-file-mode-map "\C-c\C-s" 'save-buffer) X (define-key gnus-Kill-file-mode-map "\C-c\C-c" 'gnus-Kill-file-exit)) X X(defun gnus-Kill-file-mode () X "Major mode for editing KILL file. X X\\[save-buffer] Save current KILL file. X\\[gnus-Kill-file-exit] Exit editing KILL file. X XKILL file is a file which contains SOURCE/REGEXP/COMMAND commands (one Xper line) to be applied to newsgroup when it is selected. The purpose Xof a KILL is to mark article as read on the basis of some set of XREGEXPs. Global KILL file is applied to every newsgroup while local XKILL file is applied to specified newsgroup. X XSOURCE specifies header field of articles which will be compared with XREGEXP. Currently SOURCE must be one of the following characters. The Xvalue is default to 's'. X X s means subject string. X a means author name (From: field value). X XCOMMAND specifies an operation to the article which matches REGEXP. X X d mark as read. X e FORM evalute lisp FORM. X XFor example, '/AI/d' will mark articles whose subject matches 'AI' as Xread. '/AI/e (gnus-Subject-mark-as-read)' also does the same thing. X XKILL file is initially disabled since it makes GNUS slower. You can Xenable it during this GNUS session by editing the KILL file or simply Xset variable `gnus-enable-kill-file' to non-nil. If you'd like to Xenable the KILL file in the future GNUS sessions, set the variable to Xnon-nil in your startup file `~/.emacs'. X XSince global KILL file is applied to every newsgroup, you'd better not Xuse global KILL file but local one for better performance. X XEntry to this mode calls the value of gnus-Kill-file-mode-hook with no Xarguments, if that value is non-nil." X (interactive) X (kill-all-local-variables) X (setq major-mode 'gnus-Kill-file-mode) X (setq mode-name "Edit Kill File") X (use-local-map gnus-Kill-file-mode-map) X (run-hooks 'gnus-Kill-file-mode-hook)) X X(defun gnus-Kill-file-edit-global () X "Edit global KILL file. XGlobal KILL file is applied to every newsgroup. Since KILL file makes XGNUS slower, you'd better not use global KILL file but local one. XKILL file is initially disabled. You can enable it temporary by Xediting the KILL file." X (interactive) X (gnus-Kill-file-edit (gnus-Kill-file-pathname t)) X (if gnus-enable-kill-file X (message "Editing global KILL file. (Type C-c C-c to exit)") X (message "Editing global KILL file. (Type C-c C-c to exit and enable it)") X )) X X(defun gnus-Kill-file-edit-local () X "Edit local KILL file. XLocal KILL file is applied to current newsgroup only. XKILL file is initially disabled. You can enable it temporary by Xediting the KILL file." X (interactive) X (gnus-Kill-file-edit (gnus-Kill-file-pathname nil)) X (if gnus-enable-kill-file X (message "Editing local KILL file. (Type C-c C-c to exit)") X (message "Editing local KILL file. (Type C-c C-c to exit and enable it)") X )) X X(defun gnus-Kill-file-edit (file) X "Edit kill FILE." X (interactive "f") X (gnus-make-directory (file-name-directory file)) X (find-file-other-window file) X (gnus-Kill-file-mode)) X X(defun gnus-Kill-file-exit () X "Save and enable KILL file, then return to previous buffer." X (interactive) X (save-buffer) X (or gnus-enable-kill-file X (not (y-or-n-p "Do you really want to enable KILL file? ")) X (setq gnus-enable-kill-file t)) ;Enable temporary. X (bury-buffer)) X X(defun gnus-Kill-file-mark-as-read () X "Mark as read using kill file." X (save-excursion X ;; Apply global kill file. X (let ((global (gnus-Kill-file-pathname t))) X (if (file-exists-p global) X (gnus-Kill-file-mark-as-read-using global))) X ;; And then apply local kill file. X (let ((local (gnus-Kill-file-pathname nil))) X (if (file-exists-p local) X (gnus-Kill-file-mark-as-read-using local))) X )) X X(defun gnus-Kill-file-pathname (global) X (cond (global X (expand-file-name gnus-kill-file-name (gnus-savedir-pathname ""))) X (gnus-use-long-file-name X (concat (gnus-savedir-pathname gnus-current-group-name) X "." gnus-kill-file-name)) X (t X (expand-file-name gnus-kill-file-name X (gnus-savedir-pathname gnus-current-group-name))) X )) X X(defun gnus-Kill-file-mark-as-read-using (file) X "Mark as read using kill FILE." X (set-buffer (find-file-noselect file)) X (goto-char (point-min)) X (while (re-search-forward "^\\([^/]*\\)/\\(.*\\)/\\([^/]*\\)[ \t]*$" nil t) X (let ((source (buffer-substring (match-beginning 1) (match-end 1))) X (pattern (buffer-substring (match-beginning 2) (match-end 2))) X (command (buffer-substring (match-beginning 3) (match-end 3))) X (headers gnus-current-group-headers) X (header nil)) X (while headers X (setq header (car headers)) X (if (cond ((or (string-equal "" source) X (string-equal "s" source)) X (string-match pattern (nntp-header-subject header))) X ((string-equal "a" source) X (string-match pattern (nntp-header-from header)))) X (cond ((string-match "^[ \t]*d" command) X ;; Mark as read. X (gnus-Subject-mark-as-read (nntp-header-number header))) X ((string-match "^[ \t]*e\\(.*\\)$" command) X ;; Eval expression. X (condition-case () X (save-excursion X (save-window-excursion X (let ((form X (substring command X (match-beginning 1) X (match-end 1)))) X (set-buffer gnus-Subject-buffer) X (gnus-Subject-goto-subject X (nntp-header-number header)) X (eval (read form)) X ))) X (error X (message "KILL file command failed: %s" command) X (sit-for 1)))) X (t X (message "Unknown KILL file command: %s" command) X (sit-for 1)) X )) X (setq headers (cdr headers))) X ))) X X X;;; X;;; General functions. X;;; X X(defun gnus-start-news-server (&optional confirm) X "Open network stream to remote NNTP server. XIf optional argument CONFIRM is non-nil, ask you host that NNTP server Xis running even if it is defined." X (if (nntp-server-opened) X ;; Stream is already opened. X nil X ;; Open NNTP server. X (if (or confirm X (null gnus-server-host)) X (setq gnus-server-host X (read-string "NNTP server host: " gnus-server-host))) X (if (or gnus-force-nntp X (not (string-equal gnus-server-host (system-name)))) X (message "Connecting to NNTP server on %s..." gnus-server-host) X ;; Use local news spool. X (require 'nnspool) X (message "Looking up local news spool...")) X (cond ((nntp-open-server gnus-server-host)) X ((and (stringp (nntp-status-message)) X (> (length (nntp-status-message)) 0)) X ;; Show valuable message if available. X (error (nntp-status-message))) X (t (error "Cannot open NNTP server on %s" gnus-server-host))) X )) X X(defun gnus-select-news-group (group &optional show-all) X "Select newsgroup GROUP. XIf optional argument SHOW-ALL is non-nil, all of articles in the group Xare selected." X (if (nntp-request-group group) X (let ((articles nil)) X (setq gnus-current-group-name group) X (setq gnus-current-group-unreads X (gnus-uncompress-sequence X (nthcdr 2 (gnus-gethash group gnus-unread-hashtb)))) X (cond (show-all X ;; Select all active articles. X (setq articles X (gnus-uncompress-sequence X (nthcdr 2 (gnus-gethash group gnus-active-hashtb))))) X (t X ;; Select unread articles only. X (setq articles gnus-current-group-unreads))) X ;; Get headers list. X (setq gnus-current-group-headers (nntp-retrieve-headers articles)) X ;; UNREADS may contain expired articles, so we have to remove X ;; them from the list. X (setq gnus-current-group-unreads X (gnus-intersection gnus-current-group-unreads X (mapcar X (function X (lambda (header) X (nntp-header-number header))) X gnus-current-group-headers))) X ;; Marked article must be a subset of unread articles. X (setq gnus-current-group-marked X (gnus-intersection gnus-current-group-unreads X (cdr (assoc group gnus-marked-assoc)))) X ;; Last article in this newsgroup. X (if gnus-current-group-headers X (setq gnus-current-group-end X (nntp-header-number X (gnus-last-element gnus-current-group-headers)))) X ;; Reset article pointer. X (setq gnus-current-article nil) X (setq gnus-previous-article nil) X (setq gnus-have-all-headers nil) X ;; GROUP is successfully selected. X t X ) X )) X X(defun gnus-clear-system () X "Clear all variables and buffer." X ;; Clear variables. X (setq gnus-newsrc-assoc nil) X (setq gnus-marked-assoc nil) X (setq gnus-active-hashtb nil) X (setq gnus-unread-hashtb nil) X ;; Kill buffers X (and gnus-current-startup-file X (get-file-buffer gnus-current-startup-file) X (kill-buffer (get-file-buffer gnus-current-startup-file))) X (setq gnus-current-startup-file nil) X (if (get-buffer gnus-Article-buffer) X (kill-buffer gnus-Article-buffer)) X (if (get-buffer gnus-Subject-buffer) X (kill-buffer gnus-Subject-buffer)) X (if (get-buffer gnus-Group-buffer) X (kill-buffer gnus-Group-buffer))) X X(defun gnus-copy-to-buffer (buffer &optional append) X "Copy server response to BUFFER (or buffer name). XIf optional argument APPEND is non-nil, append to buffer." X (let ((buffer (get-buffer-create buffer))) X (set-buffer buffer) X (goto-char (point-max)) X (save-excursion X (set-buffer nntp-server-buffer) X (if append X (append-to-buffer buffer (point-min) (point-max)) X (copy-to-buffer buffer (point-min) (point-max)))) X ;; Return BUFFER itself. X buffer X )) X X(defun gnus-simplify-subject (subject) X "Remove `Re:' and words in parentheses." X ;; Remove `Re:' X (let ((case-fold-search t)) ;Ignore case. X (if (string-match "^re: " subject) X (while (string-match "^re: " subject) X (setq subject (substring subject 4)) X (if (string-match "^[ \t]+\\([^ \t].*\\)$" subject) X (setq subject (substring subject (match-beginning 1)))) X )) X ;; Remove words in parentheses from end. X ;; (string-match "([ \t]*in[ \t]+.*)" subject) X (while (string-match "[ \t]*([^()]*)[ \t]*$" subject) X (setq subject (substring subject 0 (match-beginning 0)))) X ;; Return subject string. X subject X )) X X(defun gnus-date-lessp (date1 date2) X "Return T if DATE1 is earlyer than DATE2." X (string-lessp (gnus-comparable-date date1) X (gnus-comparable-date date2))) X X(defun gnus-comparable-date (date) X "Make comparable string by string-lessp from DATE." X (let* ((month '(("Jan" . " 1")("Feb" . " 2")("Mar" . " 3") X ("Apr" . " 4")("May" . " 5")("Jun" . " 6") X ("Jul" . " 7")("Aug" . " 8")("Sep" . " 9") X ("Oct" . "10")("Nov" . "11")("Dec" . "12")))) X (if (string-match "^\\([^ ]+\\) \\([^ ]+\\) \\([^ ]+\\) \\([^ ]+\\) " date) X (concat X ;; Year X (substring date (match-beginning 3) (match-end 3)) X ;; Month X (cdr (assoc (substring date (match-beginning 2) (match-end 2)) month)) X ;; Day X (format "%2d" (string-to-int X (substring date X (match-beginning 1) (match-end 1)))) X ;; Time X (substring date (match-beginning 4) (match-end 4))) X (or date "")) X )) X X(defun gnus-last-element (list) X "Return last element of LIST." X (let ((last nil)) X (while list X (if (null (cdr list)) X (setq last (car list))) X (setq list (cdr list))) X last X )) X X(defun gnus-set-difference (list1 list2) X "Return a list of elements of LIST1 that do not appear in LIST2." X (let ((list1 (if list2 (copy-sequence list1) list1))) X (while list2 X (setq list1 (delq (car list2) list1)) X (setq list2 (cdr list2))) X list1 X )) X X(defun gnus-intersection (list1 list2) X "Return a list of elements that appear in both LIST1 and LIST2." X (let ((result nil)) X (while list2 X (if (memq (car list2) list1) X (setq result (cons (car list2) result))) X (setq list2 (cdr list2))) X result X )) X X(defun gnus-savedir-pathname (group) X (expand-file-name X (if gnus-use-long-file-name X group X (gnus-group-directory-form group)) X (or gnus-article-save-directory "~/News"))) X X(defun gnus-group-directory-form (group) X "Make hierarchical directory name from newsgroup GROUP name." X (let ((group (substring group 0)) ;Copy string. X (len (length group)) X (idx 0)) X ;; Replace all occurence of `.' with `/'. X (while (< idx len) SHAR_EOF echo "End of part 2, continue with part 3" echo "3" > s2_seq_.tmp exit 0 -- Masanobu UMEDA umerin@flab.flab.Fujitsu.JUNET umerin%flab.flab.Fujitsu.JUNET@uunet.uu.NET