Path: utzoo!attcan!uunet!kddlab!ccut!titcca!fgw!flab!umerin From: umerin@flab.flab.fujitsu.JUNET (Masanobu UMEDA) Newsgroups: comp.emacs,fj.editor.emacs Subject: GNUS 3.10: an NNTP-based newsreader for GNU Emacs (2 of 5) Message-ID: <4376@flab.flab.fujitsu.JUNET> Date: 11 Nov 88 06:17:26 GMT Reply-To: umerin@flab.flab.fujitsu.JUNET (Masanobu UMEDA) Organization: Fujitsu Laboratories Ltd., Kawasaki, Japan Lines: 1358 ---- Cut Here and unpack ---- #!/bin/sh # this is part 2 of a multipart archive # do not concatenate these parts, unpack them in order with /bin/sh # file gnus.el continued # CurArch=2 if test ! -r s2_seq_.tmp then echo "Please unpack part 1 first!" exit 1; fi ( read Scheck if test "$Scheck" != $CurArch then echo "Please unpack part $Scheck next!" exit 1; else exit 0; fi ) < s2_seq_.tmp || exit 1 sed 's/^X//' << 'SHAR_EOF' >> gnus.el X\\[gnus-Subject-kill-same-subject-and-select] Mark articles which has same subject as current article as read, X and then select next unread article. X\\[gnus-Subject-kill-same-subject] Mark articles which has same subject as current article as read. X\\[gnus-Subject-execute-command] Execute a command for each article conditionally. X\\[gnus-Subject-catch-up] Mark all of articles of current newsgroup as read. X\\[gnus-Subject-catch-up-and-exit] Catch up and then exit current newsgroup. X\\[gnus-Subject-toggle-truncation] Toggle truncation of subject lines. X\\[gnus-Subject-delete-marked-as-read] Delete subject lines marked as read. X\\[gnus-Subject-delete-marked] Delete subject lines with specified marks. X\\[gnus-Subject-sort-by-number] Sort subjects by article number. X\\[gnus-Subject-sort-by-author] Sort subjects by article author name. X\\[gnus-Subject-sort-by-subject] Sort subjects alphabetically. X\\[gnus-Subject-sort-by-date] Sort subjects by posted date. X\\[delete-other-windows] Show subjects (delete article display window). X\\[gnus-Subject-show-all-subjects] Show all subjects of current newsgroup. X\\[gnus-Subject-stop-page-breaking] Stop page breaking by linefeed. X\\[gnus-Subject-caesar-message] Caesar rotates letters by 13/47 places. X\\[gnus-Subject-show-article] Force to show current article. X\\[gnus-Subject-toggle-header] Show original article header if pruned header currently shown, or vice versa. X\\[gnus-Subject-show-all-headers] Show original article header. X\\[gnus-Subject-rmail-digest] Run RMAIL on current digest article. X\\[gnus-Subject-post-news] Post an article. X\\[gnus-Subject-post-reply] Post a reply article. X\\[gnus-Subject-cancel] Cancel current article. (The article must be yours). X\\[gnus-Subject-mail-reply] Mail a message to the author. X\\[gnus-Subject-mail-other-window] Mail a message in other window. X\\[gnus-Subject-save-article] Save current article in your favorite format. X\\[gnus-Subject-save-in-mail] Append current article to file in Unix mail format. X\\[gnus-Subject-pipe-output] Pipe contents of current article to subprocess. X\\[gnus-Kill-file-edit-local] Edit local KILL file. X\\[gnus-version] Show version number of this GNUS. X\\[describe-mode] Describe this mode. X\\[gnus-Subject-exit] Quit reading news in current newsgroup. X\\[gnus-Subject-quit] Quit reading news without updating read articles information. X XUser customizable variables: X gnus-subject-lines-height X Height of subject display window. X X gnus-article-save-name X Specifies function generating file name saving an article to. This X function is called with 2 arguments, NEWSGROUP and HEADERS. Access X macros to the headers are defined as nntp-header-FIELD, and X functions are defined as gnus-header-FIELD. X X gnus-article-default-saver X Specifies your favorite article saver which is interactively X funcallable. Following functions are available: X X gnus-Subject-save-in-rmail (in Rmail format) X gnus-Subject-save-in-mail (in Unix mail format) X gnus-Subject-save-in-folder (in MH folder) X gnus-Subject-save-in-file (in plain file). X X gnus-article-save-directory X Specifies directory name to save an article to using the command X gnus-Subject-save-in-rmail, gnus-Subject-save-in-mail and X gnus-Subject-save-in-file. The variable is initialized from the X SAVEDIR environment variable. X X gnus-use-long-file-name X Non-nil means newsgroup name of an article to be saved is used as X file name. Directory form of the newsgroup is used instead if nil. X X gnus-article-mh-folder X Specifies MH folder name saving an article in using the command X gnus-Subject-save-in-folder. X X gnus-show-all-headers X Non-nil means all headers of an article are shown. X X gnus-save-all-headers X Non-nil means all headers of an article are saved in a file. X X gnus-auto-select-first X Non-nil means first unread article is selected automagically when X a newsgroup is selected normally (by gnus-Group-read-group). If X you'd like to prevent auto selection of first unread article in X some newsgroups, set the variable to nil in gnus-Select-group-hook X or gnus-Apply-kill-hook. X X gnus-auto-select-next X Non-nil means next newsgroup is selected automagically at the end X of the newsgroup. If the value is t and the next newsgroup is X empty (no unread articles), GNUS will exit Subject mode and go X back to Group mode. If the value is not nil nor t, GNUS won't exit X Subject mode but select following unread newsgroup. Especially, if X the value is a symbol `quietly', next unread newsgroup will be X selected without any confirmations. X X gnus-auto-select-same X Non-nil means an article with same subject as current article is X selected automagically like `rn -S'. X X gnus-break-pages X Non-nil means an article is broken in pages at page delimiter. X This may not work with some version of GNU Emacs before 18.50. X X gnus-page-delimiter X Specifies regexp describing line-beginnings that separate pages of X news article. X X gnus-more-message X Specifies message shown at end of pages in page break mode. X Length of the message string must be shorter than or equal to that X of page delimiter if GNU Emacs is earlier than 18.52. X X gnus-digest-show-summary X Non-nil means summary of digest messages is shown when reading X digest article using `gnus-Subject-rmail-digest' command. X X gnus-optional-headers X Specifies a function which generate a string displayed in GNUS X Subject mode buffer. The function is called with an article X headers. The result must be a string without `[' nor `]'. X Standard function returns a string like NNN:AUTHOR, where NNN is X lines of an article and AUTHOR is its author name. X X gnus-keep-subject-centered X Non-nil means a point of GNUS Subject mode window is always kept X centered. 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 X documentation of this variable for more information. X X gnus-Subject-prepare-hook X Called with no arguments after subject list is created, if that X value is non-nil. If you'd like to modify the buffer, you can use X this hook. X X gnus-Select-article-hook X Called with no arguments when article is selected, if that value X is non-nil. See documentation of this variable for more 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. The hook can be used to modify an X article so that Rmail can work with it. See documentation of the X 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. The hook is intended to customize Rmail mode. X X gnus-Apply-kill-hook X Called with no arguments when a newsgroup is selected and GNUS X Subject mode buffer is prepared. This hook is intended to apply a X KILL file to selected newsgroup. Format of KILL file is completely X different from that of 3.8 version. You need to rewrite them in X the new format. See documentation of Kill file mode for more X information. X X gnus-Mark-article-hook X Called with no arguments when an article is selected at first X time. The hook is intended to mark an article as read (or unread) X automatically when it is selected. See documentation of the X variable for more information. X X gnus-Exit-group-hook X Called with no arguments when exiting current newsgroup, if that X value is non-nil. If your machine is so slow that exiting from X Subject mode takes very long time, inhibit marking articles as X read using cross-references by setting variable X gnus-newsgroup-headers to 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-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 folding of lines. X (setq case-fold-search nil) ;Don't ignore case. 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-Kill-file-apply' 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 (setq gnus-newsgroup-unreads nil) X (gnus-Subject-exit) 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 (switch-to-buffer gnus-Subject-buffer) X (gnus-Subject-set-mode-line) X ;; Kill article display buffer because I sometime get X ;; confused by old article buffer. X (if (get-buffer gnus-Article-buffer) X (let ((article-window X (get-buffer-window gnus-Article-buffer))) X (if article-window X (delete-window article-window)) 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-delete-bogus-newsgroup 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 (erase-buffer) X (while headers X (setq header (car headers)) X (if header 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;;(defun gnus-Subject-set-mode-line () X;; "Set Subject mode line string." X;; (let ((subject (if gnus-current-headers X;; (nntp-header-subject gnus-current-headers) X;; gnus-newsgroup-name))) X;; (setq mode-line-process (concat " " gnus-newsgroup-name)) X;; (setq mode-line-buffer-identification X;; (concat "GNUS: " X;; subject X;; ;; Enough spaces to pad subject to 17 positions. X;; (substring " " X;; 0 (max 0 (- 17 (length subject)))))) X;; (set-buffer-modified-p t) X;; )) 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]+\\[.*\\][ \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]+\\[.*\\][ \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-keep-subject-centered 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-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 current article. XOptional argument ALL-HEADERS is non-nil, show all headers." X (let ((article (gnus-Subject-article-number))) X (if (or (null gnus-current-article) X (/= article gnus-current-article) X (and force (not (eq all-headers gnus-have-all-headers)))) X ;; Selected subject is different from current article's. X (gnus-Subject-display-article article all-headers) X (gnus-Subject-configure-window)) X )) X X;;(defun gnus-Subject-next-article (unread &optional subject) X;; "Select article after current one. X;;If argument UNREAD is non-nil, only unread article is selected." X;; (interactive "P") X;; (cond ((gnus-Subject-display-article X;; (gnus-Subject-search-forward unread subject))) X;; (unread X;; (message "No more unread articles")) X;; (t X;; (message "No more articles")) X;; )) X X(defun gnus-Subject-next-article (unread &optional subject) X "Select article after current one. XIf argument UNREAD is non-nil, only unread article is selected." X (interactive "P") X (cond ((gnus-Subject-display-article X (gnus-Subject-search-forward unread subject))) X ((and subject X gnus-auto-select-same X (gnus-set-difference gnus-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 argument CHILD is non-nil, go back to the child article using Xinternally 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 (ding) (message "No more parents")) X ))) X X(defun gnus-Subject-refer-article (message-id) X "Refer article specified by MESSAGE-ID. XIf message-id is nil, message-id is poped from internally maintained Xarticles 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 (string-match "<.*>" message-id)) X (eval-in-buffer-window gnus-Article-buffer 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 (ding) (message "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 "sSearch forward (regexp): ") 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 (progn X (message "") X (eval-in-buffer-window gnus-Article-buffer X (recenter 0) X ;;(sit-for 1) X )) X (ding) (message "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 "sSearch backward (regexp): ") 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 (progn X (message "") X (eval-in-buffer-window gnus-Article-buffer X (recenter 0) X ;;(sit-for 1) X )) X (ding) (message "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 seach 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 (message "Searching article: %d..." gnus-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 (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 ;; 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 (setq gnus-current-article nil) ;Force update. X (gnus-Subject-select-article 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-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 (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 () X "Mark all articles in this newsgroup as read, and then exit." X (interactive) X (if (y-or-n-p "Do you really want to mark everything as read? ") X (progn X (setq gnus-newsgroup-unreads nil) X (setq gnus-newsgroup-marked nil) X (gnus-Subject-exit)) X )) X X(defun gnus-Subject-toggle-truncation (arg) X "Toggle truncation of subject lines. XWith arg, turn line truncation on iff arg is positive." X (interactive "P") X (setq truncate-lines X (if (null arg) (not truncate-lines) X (> (prefix-numeric-value arg) 0))) X (redraw-display)) X X(defun gnus-Subject-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 (marks) X "Delete lines which matches MARKS (Example: \"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. XArgument REVERSE means reverse order." X (interactive "P") X (gnus-Subject-sort-subjects X (function X (lambda (a b) X (string-lessp (nntp-header-from a) (nntp-header-from b)))) X reverse X )) X X(defun gnus-Subject-sort-by-subject (reverse) X "Sort subject display buffer by subject alphabetically. `Re:'s are ignored. XArgument REVERSE means reverse order." X (interactive "P") X (gnus-Subject-sort-subjects X (function X (lambda (a b) X (string-lessp (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-show-all-subjects () X "Show all subjects in this newsgroup. Xgnus-Apply-kill-hook is not called." X (interactive) X (let ((current-subject (gnus-Subject-article-number)) X (current-unreads gnus-newsgroup-unreads) X (current-marked gnus-newsgroup-marked)) X (message "Retrieving newsgroup: %s..." gnus-newsgroup-name) X (if (gnus-select-newsgroup gnus-newsgroup-name t) X (progn X (setq gnus-newsgroup-unreads current-unreads) X (setq gnus-newsgroup-marked current-marked) X (run-hooks 'gnus-Select-group-hook) X (gnus-Subject-prepare) X ;;(run-hooks 'gnus-Apply-kill-hook) SHAR_EOF echo "End of part 2, continue with part 3" echo "3" > s2_seq_.tmp exit 0 -- Masanobu UMEDA umerin@flab.flab.Fujitsu.JUNET umerin%flab.flab.Fujitsu.JUNET@uunet.uu.NET