Xref: utzoo gnu.emacs.gnus:258 comp.emacs:6346 Path: utzoo!attcan!utgpu!jarvis.csri.toronto.edu!mailrus!tut.cis.ohio-state.edu!bob From: bob@tut.cis.ohio-state.edu (Bob Sutterfield) Newsgroups: gnu.emacs.gnus,comp.emacs Subject: GNUS 3.12 (03 of 10) Message-ID: Date: 26 Jun 89 13:16:34 GMT Sender: bob@tut.cis.ohio-state.edu Reply-To: Bob Sutterfield Followup-To: gnu.emacs.gnus Organization: The Ohio State University Dept of Computer & Information Science Lines: 1387 #!/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 18.52. X X gnus-digest-show-summary X Non-nil means that a summary of digest messages is shown when X reading a digest article using `gnus-Subject-rmail-digest' X command. X X gnus-digest-separator X Specifies a regexp separating messages in a digest article. X XVarious hooks for customization: X gnus-Subject-mode-hook X Entry to this mode calls the value with no arguments, if that X value is non-nil. X X gnus-Select-group-hook X Called with no arguments when newsgroup is selected, if that value X is non-nil. It is possible to sort subjects in this hook. See the X documentation of this variable for more information. X X gnus-Subject-prepare-hook X Called with no arguments after a subject list is created in the X Subject buffer, if that value is non-nil. If you'd like to modify X the buffer, you can use this hook. X X gnus-Select-article-hook X Called with no arguments when an article is selected, if that X value is non-nil. See the documentation of this variable for more X information. X X gnus-Select-digest-hook X Called with no arguments when reading digest messages using Rmail, X if that value is non-nil. This hook can be used to modify an X article so that Rmail can work with it. See the documentation of X the variable for more information. X X gnus-Rmail-digest-hook X Called with no arguments when reading digest messages using Rmail, X if that value is non-nil. This hook is intended to customize Rmail X mode. X X gnus-Apply-kill-hook X Called with no arguments when a newsgroup is selected and the X Subject buffer is prepared. This hook is intended to apply a KILL X file to the selected newsgroup. The format of KILL file is X completely different from that of version 3.8. You have to rewrite X them in the new format. See the documentation of Kill file mode X for more information. X X gnus-Mark-article-hook X Called with no arguments when an article is selected at the first X time. The hook is intended to mark an article as read (or unread) X automatically when it is selected. See the documentation of the X variable for more information. X X gnus-Exit-group-hook X Called with no arguments when exiting the current newsgroup, if X that value is non-nil. If your machine is so slow that exiting X from Subject mode takes very long time, inhibit marking articles X as read using cross-references by setting the variable X gnus-newsgroup-headers to nil in this hook." X (interactive) X (kill-all-local-variables) X ;; Gee. Why don't you upgrade? X (cond ((boundp 'mode-line-modified) X (setq mode-line-modified "--- ")) X ((listp (default-value 'mode-line-format)) 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-Subject-mode) X (setq mode-name "GNUS Subject") X ;;(setq mode-line-process '(" " gnus-newsgroup-name)) X (gnus-Subject-set-mode-line) X (use-local-map gnus-Subject-mode-map) X (buffer-flush-undo (current-buffer)) X (setq buffer-read-only t) ;Disable modification X (setq truncate-lines t) ;Stop line folding. X ;;(setq case-fold-search t) X (run-hooks 'gnus-Subject-mode-hook)) X X(defun gnus-Subject-setup-buffer () X "Initialize subject display buffer." X (if (get-buffer gnus-Subject-buffer) X (set-buffer gnus-Subject-buffer) X (set-buffer (get-buffer-create gnus-Subject-buffer)) X (gnus-Subject-mode) X )) X X(defun gnus-Subject-read-group (group &optional show-all no-article) X "Start reading news in newsgroup GROUP. XIf optional 1st argument SHOW-ALL is non-nil, already read articles are Xalso listed. XIf optional 2nd argument NO-ARTICLE is non-nil, no article is selected Xinitially." X (message "Retrieving newsgroup: %s..." group) X (if (gnus-select-newsgroup group show-all) X (progn X ;; Don't switch-to-buffer to prevent displaying old contents X ;; of the buffer until new subjects list is created. X ;; Suggested by Juha Heinanen X (gnus-Subject-setup-buffer) X ;; You can change the order of subjects in this hook. X (run-hooks 'gnus-Select-group-hook) X (gnus-Subject-prepare) X ;; Function `gnus-apply-kill-file' must be called in this hook. X (run-hooks 'gnus-Apply-kill-hook) X (if (zerop (buffer-size)) X ;; This newsgroup is empty. X (progn X (gnus-Subject-catch-up-and-exit nil t) ;Without confirmations. X (message "No unread news")) X ;; Show first unread article if requested. X (goto-char (point-min)) X (if (and (not no-article) X gnus-auto-select-first X (gnus-Subject-first-unread-article)) X ;; Window is configured automatically. X ;; Current buffer may be changed as a result of hook X ;; evaluation, especially by gnus-Subject-rmail-digest X ;; command, so we should not adjust cursor point here. X nil X (gnus-configure-windows 'SelectNewsgroup) X (pop-to-buffer gnus-Subject-buffer) X (gnus-Subject-set-mode-line) X ;; I sometime get confused with the old Article buffer. X (if (get-buffer gnus-Article-buffer) X (if (get-buffer-window gnus-Article-buffer) X (save-excursion X (set-buffer gnus-Article-buffer) X (let ((buffer-read-only nil)) X (erase-buffer))) X (kill-buffer gnus-Article-buffer))) X ;; Adjust cursor point. X (beginning-of-line) X (search-forward ":" nil t)) X )) X ;; Cannot select newsgroup GROUP. X (ding) (message "No such newsgroup: %s" group) X (sit-for 0) X ;; Run checking bogus newsgroups. X (gnus-check-bogus-newsgroups t) ;Confirm X )) X X(defun gnus-Subject-prepare () X "Prepare subject list of current newsgroup in Subject mode buffer." X (let* ((buffer-read-only nil) X (number 0) X (headers gnus-newsgroup-headers) X (header nil) X ;; This defines format of Subject mode buffer. X (cntl X (format "%%s %%%dd: [%%s] %%s\n" X (length (prin1-to-string gnus-newsgroup-end))))) X ;; Note: The next codes are not actually used because the user who X ;; want it can define them in gnus-Select-group-hook. X ;; Print verbose messages if too many articles are selected. X ;; (and (numberp gnus-large-newsgroup) X ;; (> (length gnus-newsgroup-headers) gnus-large-newsgroup) X ;; (message "Preparing headers...")) X (erase-buffer) X (while headers X (setq header (car headers)) X (if (vectorp header) ;Depends on nntp.el. X (progn X (setq number (nntp-header-number header)) X (insert X (format cntl X ;; Read or not. X (cond ((memq number gnus-newsgroup-marked) "-") X ((memq number gnus-newsgroup-unreads) " ") X (t "D")) X ;; Article number. X number X ;; Optional headers. X (or (and gnus-optional-headers X (funcall gnus-optional-headers header)) "") X ;; Its subject string. X (nntp-header-subject header))) X )) X (setq headers (cdr headers)) X ) X ;; Erase header retrieval message. X (message "") X ;; Call hooks for modifying Subject mode buffer. X ;; Suggested by sven@tde.LTH.Se (Sven Mattisson). X (goto-char (point-min)) X (run-hooks 'gnus-Subject-prepare-hook) X )) X X(defun gnus-Subject-set-mode-line () X "Set Subject mode line string." X (setq mode-line-buffer-identification X (list 17 X (concat "GNUS: " X (if gnus-current-headers X (nntp-header-subject gnus-current-headers) X gnus-newsgroup-name)))) X (set-buffer-modified-p t)) X X;; GNUS Subject mode command. X X(defun gnus-Subject-search-group (&optional backward) X "Search for next unread newsgroup. XIf optional argument BACKWARD is non-nil, search backward instead." X (save-excursion X (set-buffer gnus-Group-buffer) X (save-excursion X ;; We don't want to alter current point of Group mode buffer. X (if (gnus-Group-search-forward backward nil) X (gnus-Group-group-name)) X ))) X X(defun gnus-Subject-search-subject (backward unread subject) X "Search for article forward. XIf 1st argument BACKWARD is non-nil, search backward. XIf 2nd argument UNREAD is non-nil, only unread article is selected. XIf 3rd argument SUBJECT is non-nil, the article which has Xthe same subject will be searched for." X (let ((func (if backward 're-search-backward 're-search-forward)) X (article nil) X (regexp X (format "^%s[ \t]+\\([0-9]+\\):.\\[.*\\][ \t]+%s" X ;;(if unread " " ".") X (cond ((eq unread t) " ") (unread "[ ---]") (t ".")) X (if subject X (concat "\\([Rr][Ee]:[ \t]+\\)*" X (regexp-quote (gnus-simplify-subject subject)) X ;; Ignore words in parentheses. X "\\([ \t]*(.*)\\)*[ \t]*$") X "") X ))) X (if backward X (beginning-of-line) X (end-of-line)) X (if (funcall func regexp nil t) X (setq article X (string-to-int X (buffer-substring (match-beginning 1) (match-end 1))))) X ;; Adjust cursor point. X (beginning-of-line) X (search-forward ":" nil t) X ;; This is the result. X article X )) X X(defun gnus-Subject-search-forward (&optional unread subject) X "Search for article forward. XIf 1st optional argument UNREAD is non-nil, only unread article is selected. XIf 2nd optional argument SUBJECT is non-nil, the article which has Xthe same subject will be searched for." X (gnus-Subject-search-subject nil unread subject)) X X(defun gnus-Subject-search-backward (&optional unread subject) X "Search for article backward. XIf 1st optional argument UNREAD is non-nil, only unread article is selected. XIf 2nd optional argument SUBJECT is non-nil, the article which has Xthe same subject will be searched for." X (gnus-Subject-search-subject t unread subject)) X X(defun gnus-Subject-article-number () X "Article number around point. If nothing, return current number." X (save-excursion X (beginning-of-line) X (if (looking-at ".[ \t]+\\([0-9]+\\):") X (string-to-int X (buffer-substring (match-beginning 1) (match-end 1))) X ;; If search fail, return current article number. X gnus-current-article X ))) X X(defun gnus-Subject-subject-string () X "Return current subject string or nil if nothing." X (save-excursion X ;; It is possible to implement this function using X ;; `gnus-Subject-article-number' and `gnus-newsgroup-headers'. X (beginning-of-line) X (if (looking-at ".[ \t]+[0-9]+:.\\[.*\\][ \t]+\\(.*\\)$") X (buffer-substring (match-beginning 1) (match-end 1))) X )) X X(defun gnus-Subject-goto-subject (article) X "Move point to ARTICLE's subject." 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 (let ((current (point))) X (goto-char (point-min)) X (or (and article (re-search-forward (format "^.[ \t]+%d:" article) nil t)) X (progn (goto-char current) nil)) X )) X X(defun gnus-Subject-recenter () X "Center point in Subject mode window." X ;; Scroll window so as to cursor comes center of Subject mode window X ;; only when article is displayed. X ;; Suggested by earle@mahendo.JPL.NASA.GOV (Greg Earle). X ;; Recenter only when requested. X ;; Subbested by popovich@park.cs.columbia.edu X (and gnus-auto-center-subject X (get-buffer-window gnus-Article-buffer) X (< (/ (- (window-height) 1) 2) X (count-lines (point) (point-max))) X (recenter (/ (- (window-height) 2) 2)))) X X;; Walking around Group mode buffer. X X(defun gnus-Subject-next-group (no-article) X "Exit current newsgroup and then select next unread newsgroup. XIf prefix argument NO-ARTICLE is non-nil, no article is selected initially." X (interactive "P") X (let ((group (gnus-Subject-search-group))) X (if (null group) X (progn X (message "Exiting %s..." gnus-newsgroup-name) X (gnus-Subject-exit) X (message "")) X (message "Selecting %s..." group) X (gnus-Subject-exit t) ;Exit Subject mode temporary. X ;; Now current point of Group mode buffer is pointing GROUP. X (gnus-Subject-read-group group nil no-article) 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 since the articles X ;; are marked as read by cross-referencing. So, try next X ;; newsgroup. (Make sure we are in Group mode buffer now.) X (and (eq (current-buffer) X (get-buffer gnus-Group-buffer)) X (gnus-Group-group-name) X (gnus-Subject-read-group X (gnus-Group-group-name) nil no-article)) X ) X ))) X X(defun gnus-Subject-prev-group (no-article) X "Exit current newsgroup and then select previous unread newsgroup. XIf prefix argument NO-ARTICLE is non-nil, no article is selected initially." X (interactive "P") X (let ((group (gnus-Subject-search-group t))) X (if (null group) X (progn X (message "Exiting %s..." gnus-newsgroup-name) X (gnus-Subject-exit) X (message "")) X (message "Selecting %s..." group) X (gnus-Subject-exit t) ;Exit Subject mode temporary. X ;; We have to adjust point of Group mode buffer because current X ;; point is moved to next unread newsgroup by exiting. X (gnus-Group-jump-to-group group) X (gnus-Subject-read-group group nil no-article) 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 since the articles X ;; are marked as read by cross-referencing. So, try next X ;; newsgroup. (Make sure we are in Group mode buffer now.) X (and (eq (current-buffer) X (get-buffer gnus-Group-buffer)) X (gnus-Subject-search-group t) X (gnus-Subject-read-group X (gnus-Subject-search-group t) nil no-article)) X ) X ))) 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-expand-window () X "Expand Subject window to show headers full window." X (interactive) X (gnus-configure-windows 'ExpandSubject) X (pop-to-buffer gnus-Subject-buffer)) X X(defun gnus-Subject-display-article (article &optional all-header) X "Display ARTICLE in Article buffer." X (if (null article) X nil X (gnus-configure-windows 'SelectArticle) X (pop-to-buffer gnus-Subject-buffer) 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-configure-windows 'SelectArticle) X (pop-to-buffer gnus-Subject-buffer)) 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 ;; Wrap article pointer if there are unread articles. 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 ;; Select next newsgroup automatically if requested. 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-configure-windows 'SelectArticle) X (pop-to-buffer gnus-Subject-buffer) X (gnus-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-configure-windows 'SelectArticle) X (pop-to-buffer gnus-Subject-buffer) X (gnus-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 (gnus-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 (gnus-eval-in-buffer-window gnus-Article-buffer X ;; Look for parent Message-ID. X (let ((references (gnus-fetch-field "References"))) X ;; Get the last message-id in the references. 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 (gnus-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 (gnus-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 (gnus-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 (gnus-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-regexp X (concat "(default " gnus-last-search-regexp ") ")))))) X (if (string-equal regexp "") X (setq regexp (or gnus-last-search-regexp "")) X (setq gnus-last-search-regexp regexp)) X (if (gnus-Subject-search-article regexp nil) X (gnus-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-regexp X (concat "(default " gnus-last-search-regexp ") ")))))) X (if (string-equal regexp "") X (setq regexp (or gnus-last-search-regexp "")) X (setq gnus-last-search-regexp regexp)) X (if (gnus-Subject-search-article regexp t) X (gnus-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 (gnus-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 (gnus-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 (gnus-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 (gnus-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 to 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 (gnus-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(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 (gnus-eval-in-buffer-window gnus-Article-buffer X (require 'rnews) X (gnus-replace-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 (digbuf (get-buffer-create gnus-Digest-buffer)) X (mail-header-separator "")) X (set-buffer digbuf) 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-rmail-save-name X gnus-newsgroup-name X gnus-current-headers X gnus-newsgroup-last-rmail X )) X (setq rmail-last-file X (funcall gnus-mail-save-name X gnus-newsgroup-name X gnus-current-headers X gnus-newsgroup-last-mail X )) 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 ;; Display Rmail buffer in a window where Article buffer was X ;; displayed, and display Summary buffer in a window where X ;; Subject buffer was displayed. X (if gnus-digest-show-summary X (let ((grpwin (get-buffer-window gnus-Group-buffer))) X ;;(pop-to-buffer (current-buffer)) X (set-window-buffer X (get-buffer-window gnus-Article-buffer) digbuf) X (rmail-summary) X (if grpwin X (progn X (switch-to-buffer gnus-Group-buffer) X (pop-to-buffer rmail-summary-buffer))) 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 (gnus-configure-windows 'ExpandSubject) X (pop-to-buffer gnus-Subject-buffer) X (switch-to-buffer digbuf) X (message (substitute-command-keys X "Type \\[rmail-quit] to return to GNUS")) X )) X (error (set-buffer-modified-p nil) X (kill-buffer digbuf) 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 t nil) 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 (yank) X "Post a reply article. XIf prefix argument YANK is non-nil, original article is yanked automatically." X (interactive "P") X (gnus-Subject-select-article t nil) 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 yank)) X X(defun gnus-Subject-post-reply-with-original () X "Post a reply article with original article." X (interactive) X (gnus-Subject-post-reply t)) X X(defun gnus-Subject-cancel-article () X "Cancel this article you posted." X (interactive) X (gnus-Subject-select-article t nil) X (gnus-eval-in-buffer-window gnus-Article-buffer X (gnus-cancel-news))) X X(defun gnus-Subject-mail-reply (yank) X "Reply mail to news author. SHAR_EOF echo "End of part 3, continue with part 4" echo "4" > s2_seq_.tmp exit 0