Path: utzoo!attcan!uunet!kddlab!titcca!fgw!flab!umerin From: umerin@flab.flab.fujitsu.JUNET (Masanobu UMEDA) Newsgroups: comp.emacs,fj.editor.emacs Subject: GNUS 3.11: A GNU Emacs newsreader (3 of 9) Message-ID: <4801@flab.flab.fujitsu.JUNET> Date: 23 Feb 89 07:18:45 GMT Reply-To: umerin@flab.flab.fujitsu.JUNET (Masanobu UMEDA) Followup-To: comp.emacs Organization: Fujitsu Laboratories Ltd., Kawasaki, Japan. Lines: 1420 ---- Cut Here and unpack ---- #!/bin/sh # this is part 3 of a multipart archive # do not concatenate these parts, unpack them in order with /bin/sh # file gnus.el continued # CurArch=3 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 (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 Subject mode and Article mode 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 mode buffer first to prevent X ;; displaying subject buffer twice. X ;; Suggested by Juha Heinanen X (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 mode 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 the 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 ;; The selected subject is different from that of the current article. X (gnus-Subject-display-article article all-headers) X (gnus-Subject-configure-window)) X )) X X(defun gnus-Subject-set-current-mark (&optional current-mark) X "Put `+' at the current article. XOptional argument specifies CURRENT-MARK instead of `+'." X (save-excursion X (set-buffer gnus-Subject-buffer) X (let ((buffer-read-only nil)) X (goto-char (point-min)) X ;; First of all clear mark at last article. X (if (re-search-forward "^.[ \t]+[0-9]+:[^ \t]" nil t) X (progn X (delete-char -1) X (insert " ") X (goto-char (point-min)))) X (if (re-search-forward (format "^.[ \t]+%d:" gnus-current-article) nil t) X (progn X (delete-char 1) X (insert (or current-mark "+")))) 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-newsgroup-unreads X gnus-newsgroup-marked) X (memq this-command X '(gnus-Subject-next-unread-article X gnus-Subject-next-page X gnus-Subject-kill-same-subject-and-select X ;;gnus-Subject-next-article X ;;gnus-Subject-next-same-subject X ;;gnus-Subject-next-unread-same-subject X ))) X ;; Hook function, such as gnus-Subject-rmail-digest, may X ;; change current buffer, so need check. X (let ((buffer (current-buffer)) X (last-point (point))) X ;; No more articles with same subject, so jump to the first X ;; unread article. X (gnus-Subject-first-unread-article) X ;;(and (eq buffer (current-buffer)) X ;; (= (point) last-point) X ;; ;; Ignore given SUBJECT, and try again. X ;; (gnus-Subject-next-article unread nil)) X (and (eq buffer (current-buffer)) X (< (point) last-point) X (message "Wrapped")) X )) X (t X (let ((cmd (string-to-char (this-command-keys))) X (group (gnus-Subject-search-group)) X (auto-select X (and gnus-auto-select-next X ;;(null (gnus-set-difference gnus-newsgroup-unreads X ;; gnus-newsgroup-marked)) X (memq this-command 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 gnus-Subject-kill-same-subject X gnus-Subject-kill-same-subject-and-select 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 (and auto-select X (not (eq gnus-auto-select-next 'quietly))) 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-newsgroup-name X )) X "")) X ;; Select next unread newsgroup automagically. X (cond ((and auto-select X (eq gnus-auto-select-next 'quietly)) X ;; Select quietly. X (gnus-Subject-next-group nil)) X (auto-select X ;; Confirm auto selection. X (let ((char (read-char))) X (if (= char cmd) X (gnus-Subject-next-group nil) X (setq unread-command-char char)))) X ) X )) 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-newsgroup-unreads X gnus-newsgroup-marked) X (memq this-command 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 (cond ((and endp lines) X (message "End of message")) X ((and endp (null lines)) 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-scroll-up (lines) X "Scroll up (or down) one line current article. XArgument LINES specifies lines to be scrolled up (or down if negative)." X (interactive "p") X (gnus-Subject-select-article) X (eval-in-buffer-window gnus-Article-buffer X (cond ((> lines 0) X (if (gnus-Article-next-page lines) X (message "End of message"))) X ((< lines 0) X (gnus-Article-prev-page (- 0 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-refer-parent-article (child) X "Refer parent article of current article. XIf a prefix argument CHILD is non-nil, go back to the child article Xusing internally maintained articles history. XNOTE: This command may not work with nnspool.el." X (interactive "P") X (gnus-Subject-select-article t t) ;Request all headers. X (let ((referenced-id nil)) ;Message-id of parent or child article. X (if child X ;; Go back to child article using history. X (gnus-Subject-refer-article nil) X (eval-in-buffer-window gnus-Article-buffer X ;; Look for parent Message-ID. X (let ((references (gnus-fetch-field "References"))) X ;; Get message-id referenced last because the references may X ;; be edited. X (and references X (string-match "\\(<[^<>]+>\\)[ \t]*$" references) X (setq referenced-id X (substring references X (match-beginning 1) (match-end 1)))) X )) X (if (stringp referenced-id) X (gnus-Subject-refer-article referenced-id) X (error "No more parents")) X ))) X X(defun gnus-Subject-refer-article (message-id) X "Refer article specified by MESSAGE-ID. XIf the MESSAGE-ID is nil or an empty string, Message-ID is poped from Xinternally maintained articles history. XNOTE: This command may not work with nnspool.el." X (interactive "sMessage-ID: ") X ;; Make sure that this command depends on the fact that article X ;; related information is not updated when an article is retrieved X ;; by Message-ID. X (gnus-Subject-select-article t t) ;Request all headers. X (if (and (stringp message-id) X (> (length message-id) 0)) X (eval-in-buffer-window gnus-Article-buffer X ;; Construct the correct Message-ID if necessary. X ;; Suggested by tale@pawl.rpi.edu. X (or (string-match "^<" message-id) X (setq message-id (concat "<" message-id))) X (or (string-match ">$" message-id) X (setq message-id (concat message-id ">"))) X ;; Push current message-id on history. X ;; We cannot use gnus-current-headers to get current X ;; message-id because we may be looking at parent or refered X ;; article. X (let ((current (gnus-fetch-field "Message-ID"))) X (or (equal current message-id) ;Nothing to do. X (equal current (car gnus-current-history)) X (setq gnus-current-history X (cons current gnus-current-history))) X )) X ;; Pop message-id from history. X (setq message-id (car gnus-current-history)) X (setq gnus-current-history (cdr gnus-current-history))) X (if (stringp message-id) X ;; Retrieve article by message-id. This may not work with nnspool. X (gnus-Article-prepare message-id t) X (error "No such references")) 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-isearch-article () X "Do incremental search forward on current article." 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-search-article-forward (regexp) X "Search for an article containing REGEXP forward. Xgnus-Select-article-hook is not called during the search." X (interactive X (list (read-string X (concat "Search forward (regexp): " X (if gnus-last-search X (concat "(default " gnus-last-search ") ")))))) X (if (string-equal regexp "") X (setq regexp (or gnus-last-search "")) X (setq gnus-last-search regexp)) X (if (gnus-Subject-search-article regexp nil) X (eval-in-buffer-window gnus-Article-buffer X (recenter 0) X ;;(sit-for 1) X ) X (error "Search failed: \"%s\"" regexp) X )) X X(defun gnus-Subject-search-article-backward (regexp) X "Search for an article containing REGEXP backward. Xgnus-Select-article-hook is not called during the search." X (interactive X (list (read-string X (concat "Search backward (regexp): " X (if gnus-last-search X (concat "(default " gnus-last-search ") ")))))) X (if (string-equal regexp "") X (setq regexp (or gnus-last-search "")) X (setq gnus-last-search regexp)) X (if (gnus-Subject-search-article regexp t) X (eval-in-buffer-window gnus-Article-buffer X (recenter 0) X ;;(sit-for 1) X ) X (error "Search failed: \"%s\"" regexp) X )) X X(defun gnus-Subject-search-article (regexp &optional backward) X "Search for an article containing REGEXP. XOptional argument BACKWARD means do search for backward. Xgnus-Select-article-hook is not called during the search." X (let ((gnus-Select-article-hook nil) ;Disable hook. X (gnus-Mark-article-hook nil) ;Inhibit marking as read. X (re-search X (if backward X (function re-search-backward) (function re-search-forward))) X (found nil) X (last nil)) X ;; First of all, search current article. X ;; We don't want to read article again from NNTP server nor reset X ;; current point. X (gnus-Subject-select-article) X (message "Searching article: %d..." gnus-current-article) X (setq last gnus-current-article) X (eval-in-buffer-window gnus-Article-buffer X (save-restriction X (widen) X ;; Begin search from current point. X (setq found (funcall re-search regexp nil t)))) X ;; Then search next articles. X (while (and (not found) X (gnus-Subject-display-article X (gnus-Subject-search-subject backward nil nil))) X (message "Searching article: %d..." gnus-current-article) X (eval-in-buffer-window gnus-Article-buffer X (save-restriction X (widen) X (goto-char (if backward (point-max) (point-min))) X (setq found (funcall re-search regexp nil t))) X )) X (message "") X ;; Adjust article pointer. X (or (eq last gnus-current-article) X (setq gnus-last-article last)) X ;; Return T if found such article. X found X )) X X(defun gnus-Subject-execute-command (field regexp command &optional backward) X "If FIELD of article header matches REGEXP, execute COMMAND string. XIf FIELD is an empty string (or nil), entire article body is searched for. XIf optional (prefix) argument BACKWARD is non-nil, do backward instead." X (interactive X (list (let ((completion-ignore-case t)) X (completing-read "Field name: " X '(("Number")("Subject")("From") X ("Xref")("Lines")("Date")("Id")) X nil 'require-match)) X (read-string "Regexp: ") X (read-key-sequence "Command: ") X current-prefix-arg)) X ;; We don't want to change current point nor window configuration. X (save-excursion X (save-window-excursion X (message "Executing %s..." (key-description command)) X ;; We'd like to execute COMMAND interactively so as to give arguments. X (gnus-execute field regexp X (` (lambda () X (call-interactively '(, (key-binding command))))) X backward) X (message "Executing %s... done" (key-description command))))) 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 (gnus-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 (gnus-narrow-to-page)) X )) X X(defun gnus-Subject-goto-article (article &optional all-headers) X "Read ARTICLE if exists. XOptional argument ALL-HEADERS means all headers are shown." 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-newsgroup-headers) X nil 'require-match)))) X (if (gnus-Subject-goto-subject article) X (gnus-Subject-display-article article all-headers))) X X(defun gnus-Subject-goto-last-article () X "Go to last subject line." X (interactive) X (if gnus-last-article X (gnus-Subject-goto-article gnus-last-article))) X X(defun gnus-Subject-show-article () X "Force to show current article." X (interactive) X ;; The following is a trick to force read the current article again. X (setq gnus-have-all-headers (not gnus-have-all-headers)) X (gnus-Subject-select-article (not gnus-have-all-headers) t)) X X(defun gnus-Subject-toggle-header (arg) X "Show original header if pruned header currently shown, or vice versa. XWith arg, show original header iff arg is positive." X (interactive "P") X ;; Variable gnus-show-all-headers must be NIL to toggle really. X (let ((gnus-show-all-headers nil) X (all-headers X (if (null arg) (not gnus-have-all-headers) X (> (prefix-numeric-value arg) 0)))) X (gnus-Subject-select-article 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 (set-marker overlay-arrow-position nil) X (widen) X )) X X(defun gnus-Subject-kill-same-subject-and-select (unmark) X "Mark articles which has the same subject as read, and then select next. XIf argument UNMARK is positive, remove any kinds of marks. XIf argument UNMARK is negative, mark articles as unread instead." X (interactive "P") X (if unmark X (setq unmark (prefix-numeric-value unmark))) X (let ((count X (gnus-Subject-mark-same-subject X (gnus-Subject-subject-string) unmark))) X ;; Select next unread article. If auto-select-same mode, should X ;; select the first unread article. X (gnus-Subject-next-article t (and gnus-auto-select-same X (gnus-Subject-subject-string))) X (message "%d articles are marked as %s" X count (if unmark "unread" "read")) X )) X X(defun gnus-Subject-kill-same-subject (unmark) X "Mark articles which has the same subject as read. XIf argument UNMARK is positive, remove any kinds of marks. XIf argument UNMARK is negative, mark articles as unread instead." X (interactive "P") X (if unmark X (setq unmark (prefix-numeric-value unmark))) 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, and return marked number. XIf optional argument UNMARK is positive, remove any kinds of marks. XIf optional argument UNMARK is negative, mark articles as unread instead." X (save-excursion X (let ((count 1)) X (cond ((null unmark) X (gnus-Subject-mark-as-read nil "K")) X ((> unmark 0) X (gnus-Subject-mark-as-unread nil t)) X (t X (gnus-Subject-mark-as-unread))) X (while (and subject X (gnus-Subject-search-forward nil subject)) X (cond ((null unmark) X (gnus-Subject-mark-as-read nil "K")) X ((> unmark 0) X (gnus-Subject-mark-as-unread nil t)) X (t X (gnus-Subject-mark-as-unread))) X (setq count (1+ count)) X ) X ;; Return number of articles marked as read. X count X ))) X X(defun gnus-Subject-mark-as-unread-forward (count) X "Mark current article as unread, and then go forward. XArgument COUNT specifies number of articles marked as unread." X (interactive "p") X (while (> count 0) X (gnus-Subject-mark-as-unread nil nil) X (gnus-Subject-next-subject 1 nil) X (setq count (1- count)))) X X(defun gnus-Subject-mark-as-unread-backward (count) X "Mark current article as unread, and then go backward. XArgument COUNT specifies number of articles marked as unread." X (interactive "p") X (while (> count 0) X (gnus-Subject-mark-as-unread nil nil) X (gnus-Subject-prev-subject 1 nil) X (setq count (1- count)))) X X(defun gnus-Subject-mark-as-unread (&optional article clear-mark) X "Mark current article as unread. XOptional 1st argument ARTICLE specifies article number to be marked as unread. XOptional 2nd argument CLEAR-MARK remove any kinds of mark." 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 (gnus-mark-article-as-unread article clear-mark) X (if (or (eq article current) X (gnus-Subject-goto-subject article)) X (progn X (beginning-of-line) X (delete-char 1) X (insert (if clear-mark " " "-")))) X ))) X X(defun gnus-Subject-mark-as-read-forward (count) X "Mark current article as read, and then go forward. XArgument COUNT specifies number of articles marked as read" X (interactive "p") X (while (> count 0) X (gnus-Subject-mark-as-read) X (gnus-Subject-next-subject 1 'marked) X (setq count (1- count)))) X X(defun gnus-Subject-mark-as-read-backward (count) X "Mark current article as read, and then go backward. XArgument COUNT specifies number of articles marked as read" X (interactive "p") X (while (> count 0) X (gnus-Subject-mark-as-read) X (gnus-Subject-prev-subject 1 'marked) X (setq count (1- count)))) X X(defun gnus-Subject-mark-as-read (&optional article mark) X "Mark current article as read. XOptional 1st argument ARTICLE specifies article number to be marked as read. XOptional 2nd argument MARK specifies a string inserted at beginning of line. XAny kind of string (length 1) except for a space and `-' is ok." X (save-excursion X (set-buffer gnus-Subject-buffer) X (let* ((buffer-read-only nil) X (mark (or mark "D")) ;Default mark is `D'. X (current (gnus-Subject-article-number)) X (article (or article current))) X (gnus-mark-article-as-read article) X (if (or (eq article current) X (gnus-Subject-goto-subject article)) X (progn X (beginning-of-line) X (delete-char 1) X (insert mark))) X ))) X X(defun gnus-Subject-clear-mark-forward (count) X "Remove current article's mark, and go forward. XArgument COUNT specifies number of articles unmarked" X (interactive "p") X (while (> count 0) X (gnus-Subject-mark-as-unread nil t) X (gnus-Subject-next-subject 1 nil) X (setq count (1- count)))) X X(defun gnus-Subject-clear-mark-backward (count) X "Remove current article's mark, and go backward. XArgument COUNT specifies number of articles unmarked" X (interactive "p") X (while (> count 0) X (gnus-Subject-mark-as-unread nil t) X (gnus-Subject-prev-subject 1 nil) X (setq count (1- count)))) 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-delete-marked-as-read () X "Delete lines which is marked as read." X (interactive) X (if gnus-newsgroup-unreads X (let ((buffer-read-only nil)) X (save-excursion X (goto-char (point-min)) X (delete-non-matching-lines "^[ ---]")) X ;; Adjust point. X (if (eobp) X (gnus-Subject-prev-subject 1) X (beginning-of-line) X (search-forward ":" nil t))) X ;; It is not so good idea to make the buffer empty. X (message "All articles are marked as read") X )) X X(defun gnus-Subject-delete-marked-with (marks) X "Delete lines which are marked with MARKS (e.g. \"DK\")." X (interactive "sMarks: ") X (let ((buffer-read-only nil)) X (save-excursion X (goto-char (point-min)) X (delete-matching-lines (concat "^[" marks "]"))) X ;; Adjust point. X (or (zerop (buffer-size)) X (if (eobp) X (gnus-Subject-prev-subject 1) X (beginning-of-line) X (search-forward ":" nil t))) X )) X X;; NOTE: Compatibility with version 3.10. X(fset 'gnus-Subject-delete-marked X (symbol-function 'gnus-Subject-delete-marked-with)) 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. XIf case-fold-search is non-nil, case of letters is ignored. XArgument REVERSE means reverse order." X (interactive "P") X (gnus-Subject-sort-subjects X (function X (lambda (a b) X (gnus-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. `Re:'s are ignored. XIf case-fold-search is non-nil, case of letters is ignored. XArgument REVERSE means reverse order." X (interactive "P") X (gnus-Subject-sort-subjects X (function X (lambda (a b) X (gnus-string-lessp X (gnus-simplify-subject (nntp-header-subject a) 're-only) X (gnus-simplify-subject (nntp-header-subject b) 're-only)))) 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. XOptional argument REVERSE means reverse order." X (let ((current (gnus-Subject-article-number))) X (gnus-sort-headers predicate reverse) X (gnus-Subject-prepare) X (gnus-Subject-goto-subject current) X )) X X(defun gnus-Subject-reselect-current-group (show-all) X "Once exit and then reselect the current newsgroup. XPrefix argument SHOW-ALL means to select all articles." X (interactive "P") X (let ((current-subject (gnus-Subject-article-number))) X (gnus-Subject-exit t) X ;; We have to adjust the point of Group mode buffer because the X ;; current point was moved to the next unread newsgroup by X ;; exiting. X (gnus-Group-jump-to-group gnus-newsgroup-name) X (gnus-Group-read-group show-all t) X (gnus-Subject-goto-subject current-subject) 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 (require 'rnews) X (gnus-rebind-functions) X (save-restriction X (widen) X ;; We don't want to jump to the beginning of the message. X ;; `save-excursion' does not do its job. X (move-to-window-line 0) X (let ((last (point))) X (news-caesar-buffer-body rotnum) X (goto-char last) X (recenter 0) X )) X )) X X(defun gnus-Subject-rmail-digest () X "Run RMAIL on current digest article. Xgnus-Select-digest-hook will be called with no arguments, if that Xvalue is non-nil. It is possible to modify the article so that Rmail Xcan work with it. Xgnus-Rmail-digest-hook will be called with no arguments, if that value Xis non-nil. The hook is intended to customize Rmail mode." X (interactive) X (gnus-Subject-select-article) X (require 'rmail) X (let ((artbuf gnus-Article-buffer) X (tmpbuf (get-buffer-create gnus-Digest-buffer)) X (mail-header-separator "")) X (set-buffer tmpbuf) X (buffer-flush-undo (current-buffer)) X (setq buffer-read-only nil) X (erase-buffer) X (insert-buffer-substring artbuf) X (run-hooks 'gnus-Select-digest-hook) X (gnus-convert-article-to-rmail) X (goto-char (point-min)) X ;; Rmail initializations. X (rmail-insert-rmail-file-header) X (rmail-mode) X (rmail-set-message-counters) X (rmail-show-message) X (condition-case () X (progn X (undigestify-rmail-message) X (rmail-expunge) ;Delete original message. X ;; File name is meaningless but `save-buffer' requires it. X (setq buffer-file-name "GNUS Digest") X (setq mode-line-buffer-identification X (concat "Digest: " X (nntp-header-subject gnus-current-headers))) X ;; There is no need to write this buffer to a file. X (make-local-variable 'write-file-hooks) X (setq write-file-hooks X (list (function X (lambda () X (set-buffer-modified-p nil) X (message "(No changes need to be saved)") X 'no-need-to-write-this-buffer)))) X ;; Default file name saving digest messages. X (setq rmail-last-rmail-file X (funcall gnus-article-save-name X gnus-newsgroup-name X gnus-current-headers)) X (setq rmail-last-file rmail-last-rmail-file) X ;; Prevent generating new buffer named *** each time. X (setq rmail-summary-buffer X (get-buffer-create gnus-Digest-summary-buffer)) X (run-hooks 'gnus-Rmail-digest-hook) X (if gnus-digest-show-summary X (progn X (pop-to-buffer (current-buffer)) X (rmail-summary) X (message (substitute-command-keys X "Type \\[rmail-summary-quit] to return to GNUS")) X ) X (switch-to-buffer (current-buffer)) X (delete-other-windows) X (message (substitute-command-keys X "Type \\[rmail-quit] to return to GNUS")) X )) X (error (set-buffer-modified-p nil) X (kill-buffer (current-buffer)) X ;; This command should not signal an error because the X ;; command is called from hooks. X (ding) (message "Article is not a digest"))) 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 (set-marker overlay-arrow-position nil) 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 (set-marker overlay-arrow-position nil) 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-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 (set-marker overlay-arrow-position nil) X (widen) X (delete-other-windows) X (bury-buffer gnus-Article-buffer) X (news-mail-reply) X (gnus-rebind-functions)) 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 (set-marker overlay-arrow-position nil) X (widen) X (delete-other-windows) X (bury-buffer gnus-Article-buffer) X (news-mail-other-window) X (gnus-rebind-functions)) 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 (not (null gnus-save-all-headers)) gnus-save-all-headers) X (if gnus-article-default-saver X (call-interactively gnus-article-default-saver) X (error "No default saver is defined."))) X X(defun gnus-Subject-save-in-rmail (&optional filename) X "Append this article to Rmail file. XOptional argument FILENAME specifies file name. XDirectory to save to is default to `gnus-article-save-directory' which Xis initialized from the SAVEDIR environment variable." X (interactive) X (gnus-Subject-select-article X (not (null gnus-save-all-headers)) gnus-save-all-headers) X (eval-in-buffer-window gnus-Article-buffer X (save-excursion X (save-restriction X (widen) X (let* ((overlay-arrow-position nil) X (default-name X (funcall gnus-article-save-name X gnus-newsgroup-name X gnus-current-headers))) X (or filename X (setq filename X (read-file-name X (concat "Save article in Rmail file: (default " X (file-name-nondirectory default-name) X ") ") X (file-name-directory default-name) X default-name))) X (gnus-make-directory (file-name-directory filename)) X (gnus-output-to-rmail filename) X ;; Remember the directory name to save articles. X (setq gnus-newsgroup-last-file filename) X ))) X )) X X(defun gnus-Subject-save-in-mail (&optional filename) X "Append this article to Unix mail file. XOptional argument FILENAME specifies file name. XDirectory to save to is default to `gnus-article-save-directory' which Xis initialized from the SAVEDIR environment variable." X (interactive) X (gnus-Subject-select-article X (not (null gnus-save-all-headers)) gnus-save-all-headers) X (eval-in-buffer-window gnus-Article-buffer X (save-excursion X (save-restriction X (widen) X (let* ((overlay-arrow-position nil) X (default-name X (funcall gnus-article-save-name X gnus-newsgroup-name X gnus-current-headers))) X (or filename X (setq filename X (read-file-name X (concat "Save article in Unix mail file: (default " X (file-name-nondirectory default-name) X ") ") X (file-name-directory default-name) X default-name))) X (gnus-make-directory (file-name-directory filename)) X (rmail-output filename) X ;; Remember the directory name to save articles. X (setq gnus-newsgroup-last-file filename) X ))) X )) X X(defun gnus-Subject-save-in-file (&optional filename) X "Append this article to file. XOptional argument FILENAME specifies file name. XDirectory to save to is default to `gnus-article-save-directory' which Xis initialized from the SAVEDIR environment variable." X (interactive) X (gnus-Subject-select-article X (not (null gnus-save-all-headers)) gnus-save-all-headers) X (eval-in-buffer-window gnus-Article-buffer X (save-excursion X (save-restriction X (widen) X (let* ((overlay-arrow-position nil) X (default-name X (funcall gnus-article-save-name X gnus-newsgroup-name X gnus-current-headers))) X (or filename X (setq filename X (read-file-name X (concat "Save article in file: (default " X (file-name-nondirectory default-name) X ") ") X (file-name-directory default-name) X default-name))) X (gnus-make-directory (file-name-directory filename)) X (gnus-output-to-file filename) X ;; Remember the directory name to save articles. X (setq gnus-newsgroup-last-file filename) X ))) X )) X X(defun gnus-Subject-save-in-folder (&optional folder) X "Save this article to MH folder (using `rcvstore' in MH library). XOptional argument FOLDER specifies folder name. XFolder to save in is default to `gnus-article-mh-folder'." X (interactive) X (gnus-Subject-select-article X (not (null gnus-save-all-headers)) gnus-save-all-headers) X (eval-in-buffer-window gnus-Article-buffer X (save-restriction X (widen) X ;; Thanks to yuki@flab.Fujitsu.JUNET and ohm@kaba.junet. X (mh-find-path) X (let ((overlay-arrow-position nil) X (folder (or folder X (mh-prompt-for-folder "Save article in" X gnus-article-mh-folder t))) X (errbuf (get-buffer-create " *GNUS rcvstore*"))) X (unwind-protect X (call-process-region (point-min) (point-max) X (expand-file-name "rcvstore" mh-lib) X nil errbuf nil folder) X (set-buffer errbuf) X (if (zerop (buffer-size)) X (message "Article saved in folder: %s" folder) X (message "%s" (buffer-string))) X (kill-buffer errbuf)) X )) X )) X X(defun gnus-Subject-pipe-output () X "Pipe this article to subprocess." X (interactive) X ;; Ignore `gnus-save-all-headers' since this is not save command. X (gnus-Subject-select-article) X (eval-in-buffer-window gnus-Article-buffer X (save-restriction X (widen) X (let ((overlay-arrow-position nil) X (command (read-string X (concat X "Shell command on article: " X (if gnus-last-command X (concat "(default " gnus-last-command ") ")))))) X (if (string-equal command "") X (setq command gnus-last-command)) X (shell-command-on-region (point-min) (point-max) command nil) X (setq gnus-last-command command) 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-newsgroup-unreads)) X (message "") ;Erase "Yes or No" question. X (while unreads X (gnus-Subject-mark-as-read (car unreads) "C") X (setq unreads (cdr unreads)) X )) X )) X X(defun gnus-Subject-catch-up-and-exit (&optional quietly) X "Mark all articles in this newsgroup as read, and then exit." X (interactive) X (if (or quietly X (y-or-n-p "Do you really want to mark everything as read? ")) X (let ((unreads gnus-newsgroup-unreads)) X (message "") ;Erase "Yes or No" question. X (while unreads X (gnus-mark-article-as-read (car unreads)) X (setq unreads (cdr unreads))) X (gnus-Subject-exit)) X )) X X(defun gnus-Subject-edit-local-kill () X "Edit local KILL file applied to the current newsgroup." X (interactive) X (gnus-Kill-file-edit (gnus-Kill-file-name nil)) X (message X (substitute-command-keys X "Editing local KILL file (Type \\[gnus-Kill-file-exit] to exit)"))) X X(defun gnus-Subject-exit (&optional temporary) X "Exit reading current newsgroup, and then return to group selection mode. Xgnus-Exit-group-hook is called with no arguments if that value is non-nil." X (interactive) X (run-hooks 'gnus-Exit-group-hook) X (let ((updated nil)) X (gnus-update-unread-articles gnus-newsgroup-name X (append gnus-newsgroup-unselected X gnus-newsgroup-unreads) X gnus-newsgroup-marked) X (setq updated X (gnus-mark-as-read-by-xref gnus-newsgroup-name X gnus-newsgroup-headers X gnus-newsgroup-unreads)) X (if temporary X ;; Do not switch windows but change the 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 invisible group. X (setq updated (cdr updated))) X (gnus-Group-update-group gnus-newsgroup-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 (message "") ;Erase "Yes or No" question. 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-group 1) ;(gnus-Group-next-unread-group 1) X ))) X X(defun gnus-Subject-describe-briefly () X "Describe Subject mode commands briefly." X (interactive) X (message X (concat X (substitute-command-keys "\\[gnus-Subject-next-page]:Select ") X (substitute-command-keys "\\[gnus-Subject-next-unread-article]:Forward ") X (substitute-command-keys "\\[gnus-Subject-prev-unread-article]:Backward ") X (substitute-command-keys "\\[gnus-Subject-exit]:Exit ") X (substitute-command-keys "\\[gnus-Info-find-node]:Run Info ") X (substitute-command-keys "\\[gnus-Subject-describe-briefly]:This help") X ))) X X X;;; X;;; GNUS Article 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 "r" 'gnus-Article-refer-article) X (define-key gnus-Article-mode-map "o" 'gnus-Article-pop-article) 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 "?" 'gnus-Article-describe-briefly) X (define-key gnus-Article-mode-map "\C-c\C-i" 'gnus-Info-find-node)) X X(defun gnus-Article-mode () X "Major mode for browsing through an article. 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 (if (boundp 'mode-line-modified) X (setq mode-line-modified "--- ") X (setq mode-line-format X (cons "--- " (cdr (default-value 'mode-line-format))))) X (make-local-variable 'global-mode-string) X (setq global-mode-string nil) 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-local-variable 'page-delimiter) X (setq page-delimiter gnus-page-delimiter) X (make-local-variable 'mail-header-separator) X (setq mail-header-separator "") ;For caesar function. X ;; Overlay arrow does not work if it's buffer local. X (setq overlay-arrow-string gnus-more-message) X (setq overlay-arrow-position (make-marker)) X (buffer-flush-undo (current-buffer)) 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 mode 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 mode 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 ;; Marker may slow down editing command of Emacs. X (set-marker overlay-arrow-position nil) X (erase-buffer) X (if (nntp-request-article article) X (progn X ;; Prepare article buffer X (insert-buffer-substring nntp-server-buffer) X (setq gnus-have-all-headers (or all-headers gnus-show-all-headers)) X (if (and (numberp article) X (not (eq article gnus-current-article))) X ;; Seems me that a new article is selected. X (progn X ;; gnus-current-article must be an article number. X (setq gnus-last-article gnus-current-article) X (setq gnus-current-article article) X (setq gnus-current-headers X (gnus-find-header-by-number gnus-newsgroup-headers X gnus-current-article)) X ;; Clear articles history only when articles are X ;; retrieved by article numbers. X (setq gnus-current-history nil) X (run-hooks 'gnus-Mark-article-hook) X )) X ;; Hooks for modifying contents of the article. This hook X ;; must be called before being narrowed. X (run-hooks 'gnus-Article-prepare-hook) X ;; Delete unnecessary headers. X (or gnus-have-all-headers X (gnus-Article-delete-headers)) X ;; Do page break. X (goto-char (point-min)) X (if gnus-break-pages X (gnus-narrow-to-page)) X ;; Next function must be called after setting X ;; `gnus-current-article' variable and narrowed to page. X (gnus-Article-set-mode-line) X ) X (if (numberp article) X (gnus-Subject-mark-as-read article)) X (ding) (message "No such article (may be canceled)")) X ))) X X(defun gnus-Article-show-all-headers () X "Show all article headers in Article mode 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 (list 17 X (format "GNUS: %s {%d-%d} %d" X gnus-newsgroup-name X gnus-newsgroup-begin X gnus-newsgroup-end X gnus-current-article))) X (set-buffer-modified-p t)) X X(defun gnus-Article-delete-headers () X "Delete unnecessary headers." 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 (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 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 (gnus-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) SHAR_EOF echo "End of part 3, continue with part 4" echo "4" > s2_seq_.tmp exit 0