Xref: utzoo gnu.emacs.gnus:252 comp.emacs:6340
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 (04 of 10)
Message-ID: <BOB.89Jun26091838@tut.cis.ohio-state.edu>
Date: 26 Jun 89 13:18:38 GMT
Sender: bob@tut.cis.ohio-state.edu
Reply-To: Bob Sutterfield <bob@cis.ohio-state.edu>
Followup-To: gnu.emacs.gnus
Organization: The Ohio State University Dept of Computer & Information Science
Lines: 1372

#!/bin/sh
# this is part 4 of a multipart archive
# do not concatenate these parts, unpack them in order with /bin/sh
# file gnus.el continued
#
CurArch=4
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
XIf prefix argument YANK is non-nil, original article is yanked automatically."
X  (interactive "P")
X  (gnus-Subject-select-article)
X  (switch-to-buffer gnus-Article-buffer)
X  (set-marker overlay-arrow-position nil)
X  (widen)
X  (delete-other-windows)
X  (bury-buffer gnus-Article-buffer)
X  (news-mail-reply)
X  (gnus-replace-functions)
X  (if yank
X      (let ((last (point)))
X	(goto-char (point-max))
X	(mail-yank-original nil)
X	(goto-char last)
X	)))
X
X(defun gnus-Subject-mail-reply-with-original ()
X  "Reply mail to news author with original article."
X  (interactive)
X  (gnus-Subject-mail-reply t))
X
X(defun gnus-Subject-mail-other-window ()
X  "Reply mail to news author in other window."
X  (interactive)
X  (gnus-Subject-select-article)
X  (switch-to-buffer gnus-Article-buffer)
X  (set-marker overlay-arrow-position nil)
X  (widen)
X  (delete-other-windows)
X  (bury-buffer gnus-Article-buffer)
X  (news-mail-other-window)
X  (gnus-replace-functions))
X
X(defun gnus-Subject-save-article ()
X  "Save this article using default saver function.
XVariable `gnus-default-article-saver' specifies the saver function."
X  (interactive)
X  (gnus-Subject-select-article
X   (not (null gnus-save-all-headers)) gnus-save-all-headers)
X  (if gnus-default-article-saver
X      (call-interactively gnus-default-article-saver)
X    (error "No default saver is defined.")))
X
X(defun gnus-Subject-save-in-rmail (&optional filename)
X  "Append this article to Rmail file.
XOptional argument FILENAME specifies file name.
XDirectory to save to is default to `gnus-article-save-directory' which
Xis initialized from the SAVEDIR environment variable."
X  (interactive)
X  (gnus-Subject-select-article
X   (not (null gnus-save-all-headers)) gnus-save-all-headers)
X  (gnus-eval-in-buffer-window gnus-Article-buffer
X    (save-excursion
X      (save-restriction
X	(widen)
X	(let* ((overlay-arrow-position nil)
X	       (default-name
X		 (funcall gnus-rmail-save-name
X			  gnus-newsgroup-name
X			  gnus-current-headers
X			  gnus-newsgroup-last-rmail
X			  )))
X	  (or filename
X	      (setq filename
X		    (read-file-name
X		     (concat "Save article in Rmail file: (default "
X			     (file-name-nondirectory default-name)
X			     ") ")
X		     (file-name-directory default-name)
X		     default-name)))
X	  (gnus-make-directory (file-name-directory filename))
X	  (gnus-output-to-rmail filename)
X	  ;; Remember the directory name to save articles.
X	  (setq gnus-newsgroup-last-rmail filename)
X	  )))
X    ))
X
X(defun gnus-Subject-save-in-mail (&optional filename)
X  "Append this article to Unix mail file.
XOptional argument FILENAME specifies file name.
XDirectory to save to is default to `gnus-article-save-directory' which
Xis initialized from the SAVEDIR environment variable."
X  (interactive)
X  (gnus-Subject-select-article
X   (not (null gnus-save-all-headers)) gnus-save-all-headers)
X  (gnus-eval-in-buffer-window gnus-Article-buffer
X    (save-excursion
X      (save-restriction
X	(widen)
X	(let* ((overlay-arrow-position nil)
X	       (default-name
X		 (funcall gnus-mail-save-name
X			  gnus-newsgroup-name
X			  gnus-current-headers
X			  gnus-newsgroup-last-mail
X			  )))
X	  (or filename
X	      (setq filename
X		    (read-file-name
X		     (concat "Save article in Unix mail file: (default "
X			     (file-name-nondirectory default-name)
X			     ") ")
X		     (file-name-directory default-name)
X		     default-name)))
X	  (gnus-make-directory (file-name-directory filename))
X	  (rmail-output filename)
X	  ;; Remember the directory name to save articles.
X	  (setq gnus-newsgroup-last-mail filename)
X	  )))
X    ))
X
X(defun gnus-Subject-save-in-file (&optional filename)
X  "Append this article to file.
XOptional argument FILENAME specifies file name.
XDirectory to save to is default to `gnus-article-save-directory' which
Xis initialized from the SAVEDIR environment variable."
X  (interactive)
X  (gnus-Subject-select-article
X   (not (null gnus-save-all-headers)) gnus-save-all-headers)
X  (gnus-eval-in-buffer-window gnus-Article-buffer
X    (save-excursion
X      (save-restriction
X	(widen)
X	(let* ((overlay-arrow-position nil)
X	       (default-name
X		 (funcall gnus-file-save-name
X			  gnus-newsgroup-name
X			  gnus-current-headers
X			  gnus-newsgroup-last-file
X			  )))
X	  (or filename
X	      (setq filename
X		    (read-file-name
X		     (concat "Save article in file: (default "
X			     (file-name-nondirectory default-name)
X			     ") ")
X		     (file-name-directory default-name)
X		     default-name)))
X	  (gnus-make-directory (file-name-directory filename))
X	  (gnus-output-to-file filename)
X	  ;; Remember the directory name to save articles.
X	  (setq gnus-newsgroup-last-file filename)
X	  )))
X    ))
X
X(defun gnus-Subject-save-in-folder (&optional folder)
X  "Save this article to MH folder (using `rcvstore' in MH library).
XOptional argument FOLDER specifies folder name."
X  (interactive)
X  (gnus-Subject-select-article
X   (not (null gnus-save-all-headers)) gnus-save-all-headers)
X  (gnus-eval-in-buffer-window gnus-Article-buffer
X    (save-restriction
X      (widen)
X      ;; Thanks to yuki@flab.Fujitsu.JUNET and ohm@kaba.junet.
X      (mh-find-path)
X      (let ((overlay-arrow-position nil)
X	    (folder
X	     (or folder
X		 (mh-prompt-for-folder "Save article in"
X				       (funcall gnus-folder-save-name
X						gnus-newsgroup-name
X						gnus-current-headers
X						gnus-newsgroup-last-folder
X						)
X				       t
X				       )))
X	    (errbuf (get-buffer-create " *GNUS rcvstore*")))
X	(unwind-protect
X	    (call-process-region (point-min) (point-max)
X				 (expand-file-name "rcvstore" mh-lib)
X				 nil errbuf nil folder)
X	  (set-buffer errbuf)
X	  (if (zerop (buffer-size))
X	      (message "Article saved in folder: %s" folder)
X	    (message "%s" (buffer-string)))
X	  (kill-buffer errbuf)
X	  (setq gnus-newsgroup-last-folder folder))
X	))
X    ))
X
X(defun gnus-Subject-pipe-output ()
X  "Pipe this article to subprocess."
X  (interactive)
X  ;; Ignore `gnus-save-all-headers' since this is not save command.
X  (gnus-Subject-select-article)
X  (gnus-eval-in-buffer-window gnus-Article-buffer
X    (save-restriction
X      (widen)
X      (let ((overlay-arrow-position nil)
X	    (command (read-string "Shell command on article: "
X				  gnus-last-shell-command)))
X	(if (string-equal command "")
X	    (setq command gnus-last-shell-command))
X	(shell-command-on-region (point-min) (point-max) command nil)
X	(setq gnus-last-shell-command command)
X	))
X    ))
X
X(defun gnus-Subject-catch-up (all &optional quietly)
X  "Mark all articles not marked as unread in this newsgroup as read.
XIf prefix argument ALL is non-nil, all articles are marked as read."
X  (interactive "P")
X  (if (or quietly
X	  (y-or-n-p
X	   (if all
X	       "Do you really want to mark everything as read? "
X	     "Delete all articles not marked as unread? ")))
X      (let ((unmarked
X	     (gnus-set-difference gnus-newsgroup-unreads
X				  (if (not all) gnus-newsgroup-marked))))
X        (message "")			;Erase "Yes or No" question.
X	(while unmarked
X          (gnus-Subject-mark-as-read (car unmarked) "C")
X	  (setq unmarked (cdr unmarked))
X	  ))
X    ))
X
X(defun gnus-Subject-catch-up-all (&optional quietly)
X  "Mark all articles in this newsgroup as read."
X  (interactive)
X  (gnus-Subject-catch-up t quietly))
X
X(defun gnus-Subject-catch-up-and-exit (all &optional quietly)
X  "Mark all articles not marked as unread in this newsgroup as read, then exit.
XIf prefix argument ALL is non-nil, all articles are marked as read."
X  (interactive "P")
X  (if (or quietly
X	  (y-or-n-p
X	   (if all
X	       "Do you really want to mark everything as read? "
X	     "Delete all articles not marked as unread? ")))
X      (let ((unmarked
X             (gnus-set-difference gnus-newsgroup-unreads
X                                  (if (not all) gnus-newsgroup-marked))))
X        (message "")			;Erase "Yes or No" question.
X	(while unmarked
X          (gnus-mark-article-as-read (car unmarked))
X	  (setq unmarked (cdr unmarked)))
X	(gnus-Subject-exit))
X    ))
X
X(defun gnus-Subject-catch-up-all-and-exit (&optional quietly)
X  "Mark all articles in this newsgroup as read, and then exit."
X  (interactive)
X  (gnus-Subject-catch-up-and-exit t quietly))
X
X(defun gnus-Subject-edit-global-kill ()
X  "Edit a global KILL file."
X  (interactive)
X  (setq gnus-current-kill-article (gnus-Subject-article-number))
X  (gnus-Kill-file-edit-file nil)	;Nil stands for global KILL file.
X  (message
X   (substitute-command-keys
X    "Editing a global KILL file (Type \\[gnus-Kill-file-exit] to exit)")))
X
X(defun gnus-Subject-edit-local-kill ()
X  "Edit a local KILL file applied to the current newsgroup."
X  (interactive)
X  (setq gnus-current-kill-article (gnus-Subject-article-number))
X  (gnus-Kill-file-edit-file gnus-newsgroup-name)
X  (message
X   (substitute-command-keys
X    "Editing a local KILL file (Type \\[gnus-Kill-file-exit] to exit)")))
X
X(defun gnus-Subject-exit (&optional temporary)
X  "Exit reading current newsgroup, and then return to group selection mode.
Xgnus-Exit-group-hook is called with no arguments if that value is non-nil."
X  (interactive)
X  (run-hooks 'gnus-Exit-group-hook)
X  (let ((updated nil))
X    (gnus-update-unread-articles gnus-newsgroup-name
X				 (append gnus-newsgroup-unselected
X					 gnus-newsgroup-unreads)
X				 gnus-newsgroup-marked)
X    (setq updated
X	  (gnus-mark-as-read-by-xref gnus-newsgroup-name
X				     gnus-newsgroup-headers
X				     gnus-newsgroup-unreads))
X    (if temporary
X	;; Do not switch windows but change the buffer to work.
X	(set-buffer gnus-Group-buffer)
X      ;; Return to Group selection mode.
X      (if (get-buffer gnus-Subject-buffer)
X	  (bury-buffer gnus-Subject-buffer))
X      (if (get-buffer gnus-Article-buffer)
X	  (bury-buffer gnus-Article-buffer))
X      (gnus-configure-windows 'ExitNewsgroup)
X      (pop-to-buffer gnus-Group-buffer))
X    ;; Update cross referenced group info.
X    (while updated
X      (gnus-Group-update-group (car updated) t) ;Ignore invisible group.
X      (setq updated (cdr updated)))
X    (gnus-Group-update-group gnus-newsgroup-name)
X    (gnus-Group-jump-to-group gnus-newsgroup-name) ;Make sure where I was.
X    (gnus-Group-next-unread-group 1)
X    ))
X
X(defun gnus-Subject-quit ()
X  "Quit reading current newsgroup without updating read article info."
X  (interactive)
X  (if (y-or-n-p "Do you really wanna quit reading this group? ")
X      (progn
X	(message "")			;Erase "Yes or No" question.
X	;; Return to Group selection mode.
X	(if (get-buffer gnus-Subject-buffer)
X	    (bury-buffer gnus-Subject-buffer))
X	(if (get-buffer gnus-Article-buffer)
X	    (bury-buffer gnus-Article-buffer))
X	(gnus-configure-windows 'ExitNewsgroup)
X	(pop-to-buffer gnus-Group-buffer)
X	(gnus-Group-jump-to-group gnus-newsgroup-name) ;Make sure where I was.
X	(gnus-Group-next-group 1)	;(gnus-Group-next-unread-group 1)
X	)))
X
X(defun gnus-Subject-describe-briefly ()
X  "Describe Subject mode commands briefly."
X  (interactive)
X  (message
X   (concat
X    (substitute-command-keys "\\[gnus-Subject-next-page]:Select  ")
X    (substitute-command-keys "\\[gnus-Subject-next-unread-article]:Forward  ")
X    (substitute-command-keys "\\[gnus-Subject-prev-unread-article]:Backward  ")
X    (substitute-command-keys "\\[gnus-Subject-exit]:Exit  ")
X    (substitute-command-keys "\\[gnus-Info-find-node]:Run Info  ")
X    (substitute-command-keys "\\[gnus-Subject-describe-briefly]:This help")
X    )))
X
X
X;;;
X;;; GNUS Article Mode
X;;;
X
X(if gnus-Article-mode-map
X    nil
X  (setq gnus-Article-mode-map (make-keymap))
X  (suppress-keymap gnus-Article-mode-map)
X  (define-key gnus-Article-mode-map " " 'gnus-Article-next-page)
X  (define-key gnus-Article-mode-map "\177" 'gnus-Article-prev-page)
X  (define-key gnus-Article-mode-map "r" 'gnus-Article-refer-article)
X  (define-key gnus-Article-mode-map "o" 'gnus-Article-pop-article)
X  (define-key gnus-Article-mode-map "h" 'gnus-Article-show-subjects)
X  (define-key gnus-Article-mode-map "s" 'gnus-Article-show-subjects)
X  (define-key gnus-Article-mode-map "?" 'gnus-Article-describe-briefly)
X  (define-key gnus-Article-mode-map "\C-c\C-i" 'gnus-Info-find-node))
X
X(defun gnus-Article-mode ()
X  "Major mode for browsing through an article.
XAll normal editing commands are turned off.
XInstead, these commands are available:
X\\{gnus-Article-mode-map}
X
XVarious hooks for customization:
X gnus-Article-mode-hook
X    Entry to this mode calls the value with no arguments, if that
X    value is non-nil.
X
X gnus-Article-prepare-hook
X    Called with no arguments after an article is prepared for reading,
X    if that value is non-nil."
X  (interactive)
X  (kill-all-local-variables)
X  ;; 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-Article-mode)
X  (setq mode-name "GNUS Article")
X  (gnus-Article-set-mode-line)
X  (use-local-map gnus-Article-mode-map)
X  (make-local-variable 'page-delimiter)
X  (setq page-delimiter gnus-page-delimiter)
X  (make-local-variable 'mail-header-separator)
X  (setq mail-header-separator "")	;For caesar function.
X  ;; Overlay arrow does not work if it's buffer local.
X  (setq overlay-arrow-string gnus-more-message)
X  (setq overlay-arrow-position (make-marker))
X  (buffer-flush-undo (current-buffer))
X  (setq buffer-read-only t)		;Disable modification
X  (run-hooks 'gnus-Article-mode-hook))
X
X(defun gnus-Article-setup-buffer ()
X  "Initialize Article mode buffer."
X  (or (get-buffer gnus-Article-buffer)
X      (save-excursion
X	(set-buffer (get-buffer-create gnus-Article-buffer))
X	(gnus-Article-mode))
X      ))
X
X(defun gnus-Article-prepare (article &optional all-headers)
X  "Prepare ARTICLE in Article mode buffer.
XIf optional argument ALL-HEADERS is non-nil, all headers are inserted."
X  (save-excursion
X    (set-buffer gnus-Article-buffer)
X    (let ((buffer-read-only nil))
X      ;; Marker may slow down editing command of Emacs.
X      (set-marker overlay-arrow-position nil)
X      (erase-buffer)
X      (if (gnus-request-article article)
X	  (progn
X	    ;; Prepare article buffer
X	    (insert-buffer-substring nntp-server-buffer)
X	    (setq gnus-have-all-headers (or all-headers gnus-show-all-headers))
X	    (if (and (numberp article)
X		     (not (eq article gnus-current-article)))
X		;; Seems me that a new article is selected.
X		(progn
X		  ;; gnus-current-article must be an article number.
X		  (setq gnus-last-article gnus-current-article)
X		  (setq gnus-current-article article)
X		  (setq gnus-current-headers
X			(gnus-find-header-by-number gnus-newsgroup-headers
X						    gnus-current-article))
X		  ;; Clear articles history only when articles are
X		  ;; retrieved by article numbers.
X		  (setq gnus-current-history nil)
X		  (run-hooks 'gnus-Mark-article-hook)
X		  ))
X	    ;; Hooks for modifying contents of the article. This hook
X	    ;; must be called before being narrowed.
X	    (run-hooks 'gnus-Article-prepare-hook)
X	    ;; Delete unnecessary headers.
X	    (or gnus-have-all-headers
X		(gnus-Article-delete-headers))
X	    ;; Do page break.
X	    (goto-char (point-min))
X	    (if gnus-break-pages
X		(gnus-narrow-to-page))
X	    ;; Next function must be called after setting
X	    ;;  `gnus-current-article' variable and narrowed to page.
X	    (gnus-Article-set-mode-line)
X	    )
X	(if (numberp article)
X	    (gnus-Subject-mark-as-read article))
X	(ding) (message "No such article (may be canceled)"))
X      )))
X
X(defun gnus-Article-show-all-headers ()
X  "Show all article headers in Article mode buffer."
X  (or gnus-have-all-headers
X      (gnus-Article-prepare gnus-current-article t)))
X
X;;(defun gnus-Article-set-mode-line ()
X;;  "Set Article mode line string."
X;;  (setq mode-line-buffer-identification
X;;	(list 17
X;;	      (format "GNUS: %s {%d-%d} %d"
X;;		      gnus-newsgroup-name
X;;		      gnus-newsgroup-begin
X;;		      gnus-newsgroup-end
X;;		      gnus-current-article
X;;                    )))
X;;  (set-buffer-modified-p t))
X
X(defun gnus-Article-set-mode-line ()
X  "Set Article mode line string."
X  (let ((unmarked
X	 (- (length gnus-newsgroup-unreads) (length gnus-newsgroup-marked))))
X    (setq mode-line-buffer-identification
X	  (list 17
X		(format "GNUS: %s{%d} %s"
X			gnus-newsgroup-name
X			gnus-current-article
X			;; This is proposed by tale@pawl.rpi.edu.
X                        (if (zerop unmarked)
X			    "      "
X			  (format "%d more" unmarked))
X			))))
X  (set-buffer-modified-p t))
X
X(defun gnus-Article-delete-headers ()
X  "Delete unnecessary headers."
X  (save-excursion
X    (save-restriction
X      (goto-char (point-min))
X      (narrow-to-region (point-min)
X			(progn (search-forward "\n\n" nil 'move) (point)))
X      (goto-char (point-min))
X      (and (stringp gnus-ignored-headers)
X	   (while (re-search-forward gnus-ignored-headers nil t)
X	     (beginning-of-line)
X	     (delete-region (point)
X			    (progn (re-search-forward "\n[^ \t]")
X				   (forward-char -1)
X				   (point)))))
X      )))
X
X;; Working on article's buffer
X
X(defun gnus-Article-next-page (lines)
X  "Show next page of current article.
XIf end of article, return non-nil. Otherwise return nil.
XArgument LINES specifies lines to be scrolled up."
X  (interactive "P")
X  (move-to-window-line -1)
X  (if (eobp)
X      (if (or (not gnus-break-pages)
X	      (save-restriction (widen) (eobp))) ;Real end-of-buffer?
X	  t
X	(gnus-narrow-to-page 1)		;Go to next page.
X	nil
X	)
X    (scroll-up lines)
X    nil
X    ))
X
X(defun gnus-Article-prev-page (lines)
X  "Show previous page of current article.
XArgument LINES specifies lines to be scrolled down."
X  (interactive "P")
X  (move-to-window-line 0)
X  (if (and gnus-break-pages
X	   (bobp)
X	   (not (save-restriction (widen) (bobp)))) ;Real beginning-of-buffer?
X      (progn
X	(gnus-narrow-to-page -1) ;Go to previous page.
X	(goto-char (point-max))
X	(recenter -1))
X    (scroll-down lines)))
X
X(defun gnus-Article-next-digest (nth)
X  "Move to head of NTH next digested message.
XSet mark at end of digested message."
X  ;; Stop page breaking in digest mode.
X  (set-marker overlay-arrow-position nil)
X  (widen)
X  (end-of-line)
X  ;; Skip NTH - 1 digest.
X  ;; Suggested by Khalid Sattar <admin@cs.exeter.ac.uk>.
X  ;; Digest separator is customizable.
X  ;; Suggested by Skip Montanaro <montanaro@sprite.crd.ge.com>.
X  (while (and (> nth 1)
X	      (re-search-forward gnus-digest-separator nil 'move))
X    (setq nth (1- nth)))
X  (if (re-search-forward gnus-digest-separator nil t)
X      (let ((begin (point)))
X	;; Search for end of this message.
X	(end-of-line)
X	(if (re-search-forward gnus-digest-separator nil t)
X	    (progn
X	      (search-backward "\n\n")	;This may be incorrect.
X	      (forward-line 1))
X	  (goto-char (point-max)))
X	(push-mark)			;Set mark at end of digested message.
X	(goto-char begin)
X	(beginning-of-line)
X	;; Show From: and Subject: fields.
X	(recenter 1))
X    (message "End of message")
X    ))
X
X(defun gnus-Article-prev-digest (nth)
X  "Move to head of NTH previous digested message."
X  ;; Stop page breaking in digest mode.
X  (set-marker overlay-arrow-position nil)
X  (widen)
X  (beginning-of-line)
X  ;; Skip NTH - 1 digest.
X  ;; Suggested by Khalid Sattar <admin@cs.exeter.ac.uk>.
X  ;; Digest separator is customizable.
X  ;; Suggested by Skip Montanaro <montanaro@sprite.crd.ge.com>.
X  (while (and (> nth 1)
X	      (re-search-backward gnus-digest-separator nil 'move))
X    (setq nth (1- nth)))
X  (if (re-search-backward gnus-digest-separator nil t)
X      (let ((begin (point)))
X	;; Search for end of this message.
X	(end-of-line)
X	(if (re-search-forward gnus-digest-separator nil t)
X	    (progn
X	      (search-backward "\n\n")	;This may be incorrect.
X	      (forward-line 1))
X	  (goto-char (point-max)))
X	(push-mark)			;Set mark at end of digested message.
X	(goto-char begin)
X	;; Show From: and Subject: fields.
X	(recenter 1))
X    (goto-char (point-min))
X    (message "Top of message")
X    ))
X
X(defun gnus-Article-refer-article ()
X  "Read article specified by message-id around point."
X  (interactive)
X  (save-window-excursion
X    (save-excursion
X      (re-search-forward ">" nil t)	;Move point to end of "<....>".
X      (if (re-search-backward "\\(<[^<> \t\n]+>\\)" nil t)
X	  (let ((message-id
X		 (buffer-substring (match-beginning 1) (match-end 1))))
X	    (set-buffer gnus-Subject-buffer)
X	    (gnus-Subject-refer-article message-id))
X	(error "No references around point"))
X      )))
X
X(defun gnus-Article-pop-article ()
X  "Pop up article history."
X  (interactive)
X  (save-window-excursion
X    (set-buffer gnus-Subject-buffer)
X    (gnus-Subject-refer-article nil)))
X
X(defun gnus-Article-show-subjects ()
X  "Reconfigure windows to show headers."
X  (interactive)
X  (gnus-configure-windows 'SelectArticle)
X  (pop-to-buffer gnus-Subject-buffer)
X  (gnus-Subject-goto-subject gnus-current-article))
X
X(defun gnus-Article-describe-briefly ()
X  "Describe Article mode commands briefly."
X  (interactive)
X  (message
X   (concat
X    (substitute-command-keys "\\[gnus-Article-next-page]:Next page  ")
X    (substitute-command-keys "\\[gnus-Article-prev-page]:Prev page  ")
X    (substitute-command-keys "\\[gnus-Article-show-subjects]:Show headers  ")
X    (substitute-command-keys "\\[gnus-Info-find-node]:Run Info  ")
X    (substitute-command-keys "\\[gnus-Article-describe-briefly]:This help")
X    )))
X
X
X;;;
X;;; GNUS KILL-File Mode
X;;;
X
X(if gnus-Kill-file-mode-map
X    nil
X  (setq gnus-Kill-file-mode-map (copy-keymap emacs-lisp-mode-map))
X  (define-key gnus-Kill-file-mode-map "\C-c\C-k\C-s" 'gnus-Kill-file-kill-by-subject)
X  (define-key gnus-Kill-file-mode-map "\C-c\C-k\C-a" 'gnus-Kill-file-kill-by-author)
X  (define-key gnus-Kill-file-mode-map "\C-c\C-c" 'gnus-Kill-file-exit)
X  (define-key gnus-Kill-file-mode-map "\C-c\C-i" 'gnus-Info-find-node))
X
X(defun gnus-Kill-file-mode ()
X  "Major mode for editing KILL file.
X
XIn addition to Emacs-Lisp Mode, the following commands are available:
X
X\\[gnus-Kill-file-kill-by-subject]	Insert KILL command for current subject.
X\\[gnus-Kill-file-kill-by-author]	Insert KILL command for current author.
X\\[gnus-Kill-file-exit]	Save file and exit editing KILL file.
X\\[gnus-Info-find-node]	Read Info about KILL file.
X
X  A KILL file contains lisp expressions to be applied to a selected
Xnewsgroup. The purpose is to mark articles as read on the basis of
Xsome set of regexps. A global KILL file is applied to every newsgroup,
Xand a local KILL file is applied to a specified newsgroup. Since a
Xglobal KILL file is applied to every newsgroup, for better performance
Xuse a local one.
X
X  A KILL file can contain any kind of Emacs lisp expressions expected
Xto be evaluated in the Subject buffer. Writing lisp programs for this
Xpurpose is not so easy because the internal working of GNUS must be
Xwell-known. For this reason, GNUS provides a general function which
Xdoes this easily for non-Lisp programmers.
X
X  The `gnus-kill' function executes commands available in Subject Mode
Xby their key sequences. `gnus-kill' should be called with FIELD,
XREGEXP and optional COMMAND and ALL. FIELD is a string representing
Xthe header field or an empty string. If FIELD is an empty string, the
Xentire article body is searched for. REGEXP is a string which is
Xcompared with FIELD value. COMMAND is a string representing a valid
Xkey sequence in Subject Mode or Lisp expression. COMMAND is default to
X'(gnus-Subject-mark-as-read nil \"X\"). Make sure that COMMAND is
Xexecuted in the Subject buffer.  If the second optional argument ALL
Xis non-nil, the COMMAND is applied to articles which are already
Xmarked as read or unread.  Articles which are marked are skipped over
Xby default.
X
X  For example, if you want to mark articles of which subjects contain
Xthe string `AI' as read, a possible KILL file may look like:
X
X	(gnus-kill \"Subject\" \"AI\")
X
X  If you want to mark articles with `D' instead of `X', you can use
Xthe following expression:
X
X	(gnus-kill \"Subject\" \"AI\" \"d\")
X
XIn this example it is assumed that the command
X`gnus-Subject-mark-as-read-forward' is assigned to `d' in Subject Mode.
X
X  It is possible to delete unnecessary headers which are marked with
X`X' in a KILL file as follows:
X
X	(gnus-expunge \"X\")
X
X  If the Subject buffer is empty after applying KILL files, GNUS will
Xexit the selected newsgroup normally.  If headers which are marked
Xwith `D' are deleted in a KILL file, it is impossible to read articles
Xwhich are marked as read in the previous GNUS sessions.  Marks other
Xthan `D' should be used for articles which should really be deleted.
X
XEntry to this mode calls emacs-lisp-mode-hook and
Xgnus-Kill-file-mode-hook with no arguments, if that value is non-nil."
X  (interactive)
X  (kill-all-local-variables)
X  (use-local-map gnus-Kill-file-mode-map)
X  (set-syntax-table emacs-lisp-mode-syntax-table)
X  (setq major-mode 'gnus-Kill-file-mode)
X  (setq mode-name "KILL-File")
X  (lisp-mode-variables nil)
X  (run-hooks 'emacs-lisp-mode-hook 'gnus-Kill-file-mode-hook))
X
X(defun gnus-Kill-file-edit-file (newsgroup)
X  "Begin editing a KILL file of NEWSGROUP.
XIf NEWSGROUP is nil, the global KILL file is selected."
X  (interactive "sNewsgroup: ")
X  (let ((file (gnus-newsgroup-kill-file newsgroup)))
X    (gnus-make-directory (file-name-directory file))
X    (let ((buffer (find-file-noselect file)))
X      (if (or (one-window-p t)
X	      (get-buffer-window buffer))
X	  (find-file-other-window file)
X	;; Select the larget window for editing FILE.
X	(set-window-buffer (get-largest-window) buffer)
X	(pop-to-buffer buffer)))
X    (gnus-Kill-file-mode)
X    ))
X
X(defun gnus-Kill-file-kill-by-subject ()
X  "Insert KILL command for current subject."
X  (interactive)
X  (insert
X   (format "(gnus-kill \"Subject\" \"%s\")\n"
X	   (if gnus-current-kill-article
X	       (nntp-header-subject
X		(gnus-find-header-by-number gnus-newsgroup-headers
X					    gnus-current-kill-article))
X	     ""
X	     ))))
X
X(defun gnus-Kill-file-kill-by-author ()
X  "Insert KILL command for current author."
X  (interactive)
X  (insert
X   (format "(gnus-kill \"From\" \"%s\")\n"
X	   (if gnus-current-kill-article
X	       (nntp-header-from
X		(gnus-find-header-by-number gnus-newsgroup-headers
X					    gnus-current-kill-article))
X	     ""
X	     ))))
X
X(defun gnus-Kill-file-exit ()
X  "Save a KILL file, then return to the previous buffer."
X  (interactive)
X  (let ((killbuf (current-buffer)))
X    (save-buffer)
X    (bury-buffer)
X    ;; Kill the KILL file buffer.
X    ;; Suggested by tale@pawl.rpi.edu.
X    (kill-buffer killbuf)))
X
X
X;;;
X;;; Utility functions
X;;;
X
X(defun gnus-Numeric-save-name (newsgroup headers &optional last-file)
X  "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
XIf variable `gnus-use-long-file-name' is nil, it is ~/News/News.group/num.
XOtherwise, it is like ~/News/news/group/num."
X  (let ((default
X	  (expand-file-name
X	   (concat (if gnus-use-long-file-name
X		       (capitalize newsgroup)
X		     (gnus-newsgroup-directory-form newsgroup))
X		   "/" (int-to-string (nntp-header-number headers)))
X	   (or gnus-article-save-directory "~/News"))))
X    (if (and last-file
X	     (string-equal (file-name-directory default)
X			   (file-name-directory last-file))
X	     (string-match "^[0-9]+$" (file-name-nondirectory last-file)))
X	default
X      (or last-file default))))
X
X(defun gnus-numeric-save-name (newsgroup headers &optional last-file)
X  "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
XIf variable `gnus-use-long-file-name' is nil, it is ~/News/news.group/num.
XOtherwise, it is like ~/News/news/group/num."
X  (let ((default
X	  (expand-file-name
X	   (concat (if gnus-use-long-file-name
X		       newsgroup
X		     (gnus-newsgroup-directory-form newsgroup))
X		   "/" (int-to-string (nntp-header-number headers)))
X	   (or gnus-article-save-directory "~/News"))))
X    (if (and last-file
X	     (string-equal (file-name-directory default)
X			   (file-name-directory last-file))
X	     (string-match "^[0-9]+$" (file-name-nondirectory last-file)))
X	default
X      (or last-file default))))
X
X(defun gnus-Plain-save-name (newsgroup headers &optional last-file)
X  "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
XIf variable `gnus-use-long-file-name' is nil, it is ~/News/News.group.
XOtherwise, it is like ~/News/news/group/news."
X  (or last-file
X      (expand-file-name
X       (if gnus-use-long-file-name
X	   (capitalize newsgroup)
X	 (concat (gnus-newsgroup-directory-form newsgroup) "/news"))
X       (or gnus-article-save-directory "~/News"))))
X
X(defun gnus-plain-save-name (newsgroup headers &optional last-file)
X  "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
XIf variable `gnus-use-long-file-name' is nil, it is ~/News/news.group.
XOtherwise, it is like ~/News/news/group/news."
X  (or last-file
X      (expand-file-name
X       (if gnus-use-long-file-name
X	   newsgroup
X	 (concat (gnus-newsgroup-directory-form newsgroup) "/news"))
X       (or gnus-article-save-directory "~/News"))))
X
X(defun gnus-Folder-save-name (newsgroup headers &optional last-folder)
X  "Generate folder name from NEWSGROUP, HEADERS, and optional LAST-FOLDER.
XIf variable `gnus-use-long-file-name' is nil, it is +News.group.
XOtherwise, it is like +news/group."
X  (or last-folder
X      (concat "+"
X	      (if gnus-use-long-file-name
X		  (capitalize newsgroup)
X		(gnus-newsgroup-directory-form newsgroup)))))
X
X(defun gnus-folder-save-name (newsgroup headers &optional last-folder)
X  "Generate folder name from NEWSGROUP, HEADERS, and optional LAST-FOLDER.
XIf variable `gnus-use-long-file-name' is nil, it is +news.group.
XOtherwise, it is like +news/group."
X  (or last-folder
X      (concat "+"
X	      (if gnus-use-long-file-name
X		  newsgroup
X		(gnus-newsgroup-directory-form newsgroup)))))
X
X(defun gnus-apply-kill-file ()
X  "Apply KILL file to the current newsgroup."
X  ;; Apply the global KILL file.
X  (load (gnus-newsgroup-kill-file nil) t nil t)
X  ;; And then apply the local KILL file.
X  (load (gnus-newsgroup-kill-file gnus-newsgroup-name) t nil t))
X
X(defun gnus-Newsgroup-kill-file (newsgroup)
X  "Return the name of a KILL file of NEWSGROUP.
XIf NEWSGROUP is nil, return the global KILL file instead."
X  (cond ((or (null newsgroup)
X	     (string-equal newsgroup ""))
X	 ;; The global KILL file is placed at top of the directory.
X	 (expand-file-name gnus-kill-file-name
X			   (or gnus-article-save-directory "~/News")))
X	(gnus-use-long-file-name
X	 ;; Append ".KILL" to capitalized newsgroup name.
X	 (expand-file-name (concat (capitalize newsgroup)
X				   "." gnus-kill-file-name)
X			   (or gnus-article-save-directory "~/News")))
X	(t
X	 ;; Place "KILL" under the hierarchical directory.
X	 (expand-file-name (concat (gnus-newsgroup-directory-form newsgroup)
X				   "/" gnus-kill-file-name)
X			   (or gnus-article-save-directory "~/News")))
X	))
X
X(defun gnus-newsgroup-kill-file (newsgroup)
X  "Return the name of a KILL file of NEWSGROUP.
XIf NEWSGROUP is nil, return the global KILL file instead."
X  (cond ((or (null newsgroup)
X	     (string-equal newsgroup ""))
X	 ;; The global KILL file is placed at top of the directory.
X	 (expand-file-name gnus-kill-file-name
X			   (or gnus-article-save-directory "~/News")))
X	(gnus-use-long-file-name
X	 ;; Append ".KILL" to newsgroup name.
X	 (expand-file-name (concat newsgroup "." gnus-kill-file-name)
X			   (or gnus-article-save-directory "~/News")))
X	(t
X	 ;; Place "KILL" under the hierarchical directory.
X	 (expand-file-name (concat (gnus-newsgroup-directory-form newsgroup)
X				   "/" gnus-kill-file-name)
X			   (or gnus-article-save-directory "~/News")))
X	))
X
X(defun gnus-newsgroup-directory-form (newsgroup)
X  "Make hierarchical directory name from NEWSGROUP name."
X  (let ((newsgroup (substring newsgroup 0)) ;Copy string.
X	(len (length newsgroup))
X	(idx 0))
X    ;; Replace all occurence of `.' with `/'.
X    (while (< idx len)
X      (if (= (aref newsgroup idx) ?.)
X	  (aset newsgroup idx ?/))
X      (setq idx (1+ idx)))
X    newsgroup
X    ))
X
X(defun gnus-make-directory (directory)
X  "Make DIRECTORY recursively."
X  (let ((directory (expand-file-name directory default-directory)))
X    (or (file-exists-p directory)
X	(gnus-make-directory-1 "" directory))
X    ))
X
X(defun gnus-make-directory-1 (head tail)
X  (cond ((string-match "^/\\([^/]+\\)" tail)
X	 (setq head
X	       (concat (file-name-as-directory head)
X		       (substring tail (match-beginning 1) (match-end 1))))
X	 (or (file-exists-p head)
X	     (call-process "mkdir" nil nil nil head))
X	 (gnus-make-directory-1 head (substring tail (match-end 1))))
X	((string-equal tail "") t)
X	))
X
X(defun gnus-simplify-subject (subject &optional re-only)
X  "Remove `Re:' and words in parentheses.
XIf optional argument RE-ONLY is non-nil, strip `Re:' only."
X  (let ((case-fold-search t))		;Ignore case.
X    ;; Remove `Re:'
X    (if (string-match "\\`\\(re:[ \t]+\\)*" subject)
X	(setq subject (substring subject (match-end 0))))
X    ;; Remove words in parentheses from end.
X    (or re-only
X	(while (string-match "[ \t\n]*([^()]*)[ \t\n]*\\'" subject)
X	  (setq subject (substring subject 0 (match-beginning 0)))))
X    ;; Return subject string.
X    subject
X    ))
X
X(defun gnus-optional-lines-and-from (header)
X  "Return a string like `NNN:AUTHOR' from HEADER."
X  (let ((name-length (length "umerin@photon")))
X    (substring (format "%3d:%s"
X		       ;; Lines of the article.
X		       ;; Suggested by dana@bellcore.com.
X		       (nntp-header-lines header)
X		       ;; Its author.
X		       (concat (mail-strip-quoted-names
X				(nntp-header-from header))
X			       (make-string name-length ? )))
X	       ;; 4 stands for length of `NNN:'.
X	       0 (+ 4 name-length))))
X
X(defun gnus-optional-lines (header)
X  "Return a string like `NNN' from HEADER."
X  (format "%4d" (nntp-header-lines header)))
X
X(defun gnus-sort-headers (predicate &optional reverse)
X  "Sort current group headers by PREDICATE safely.
X*Safely* means C-g quitting is disabled during sorting.
XOptional argument REVERSE means reverse order."
X  (let ((inhibit-quit t))
X    (setq gnus-newsgroup-headers
X	  (if reverse
X	      (nreverse (sort (nreverse gnus-newsgroup-headers) predicate))
X	    (sort gnus-newsgroup-headers predicate)))
X    ))
X
X(defun gnus-string-lessp (a b)
X  "Return T if first arg string is less than second in lexicographic order.
XIf case-fold-search is non-nil, case of letters is ignored."
X  (if case-fold-search
X      (string-lessp (downcase a) (downcase b)) (string-lessp a b)))
X
X(defun gnus-date-lessp (date1 date2)
X  "Return T if DATE1 is earlyer than DATE2."
X  (string-lessp (gnus-comparable-date date1)
X		(gnus-comparable-date date2)))
X
X(defun gnus-comparable-date (date)
X  "Make comparable string by string-lessp from DATE."
X  (let ((month '(("JAN" . " 1")("FEB" . " 2")("MAR" . " 3")
X		 ("APR" . " 4")("MAY" . " 5")("JUN" . " 6")
X		 ("JUL" . " 7")("AUG" . " 8")("SEP" . " 9")
X		 ("OCT" . "10")("NOV" . "11")("DEC" . "12")))
X	(date (or date "")))
X    ;; Can understand the following styles:
X    ;; (1) 14 Apr 89 03:20:12 GMT
X    ;; (2) Fri, 17 Mar 89 4:01:33 GMT
X    (if (string-match
X	 "\\([0-9]+\\) \\([^ ,]+\\) \\([0-9]+\\) \\([0-9:]+\\)" date)
X	(concat
X	 ;; Year
X	 (substring date (match-beginning 3) (match-end 3))
X	 ;; Month
X	 (cdr
X	  (assoc
X	   (upcase (substring date (match-beginning 2) (match-end 2))) month))
X	 ;; Day
X	 (format "%2d" (string-to-int
X			(substring date
X				   (match-beginning 1) (match-end 1))))
X	 ;; Time
X	 (substring date (match-beginning 4) (match-end 4)))
X      ;; Cannot understand DATE string.
X      date
X      )
X    ))
X
X(defun gnus-fetch-field (field)
X  "Return the value of the header FIELD of current article."
X  (save-excursion
X    (save-restriction
X      (widen)
X      (goto-char (point-min))
X      (narrow-to-region (point-min)
X			(progn (search-forward "\n\n" nil 'move) (point)))
X      (mail-fetch-field field))))
X
X(fset 'gnus-expunge 'gnus-Subject-delete-marked-with)
X
X(defun gnus-kill (field regexp &optional command all)
X  "If FIELD of an article matches REGEXP, execute COMMAND.
XOptional 1st argument COMMAND is default to
X	(gnus-Subject-mark-as-read nil \"X\").
XIf optional 2nd argument ALL is non-nil, articles marked are also applied to.
XIf FIELD is an empty string (or nil), entire article body is searched for.
XCOMMAND must be a lisp expression or a string representing a key sequence."
X  ;; We don't want to change current point nor window configuration.
X  (save-excursion
X    (save-window-excursion
X      ;; Selected window must be Subject mode buffer to execute
X      ;; keyboard macros correctly. See command_loop_1.
X      (switch-to-buffer gnus-Subject-buffer)
X      (goto-char (point-min))		;From the beginning.
X      (if (null command)
X	  (setq command '(gnus-Subject-mark-as-read nil "X")))
X      (gnus-execute field regexp command nil (not all))
X      )))
X
X(defun gnus-execute (field regexp form &optional backward ignore-marked)
X  "If FIELD of article header matches REGEXP, execute lisp FORM (or a string).
XIf FIELD is an empty string (or nil), entire article body is searched for.
XIf optional 1st argument BACKWARD is non-nil, do backward instead.
XIf optional 2nd argument IGNORE-MARKED is non-nil, articles which are
Xmarked as read or unread are ignored."
X  (let ((function nil)
X	(header nil)
X	(article nil))
X    (if (string-equal field "")
X	(setq field nil))
X    (if (null field)
X	nil
X      (or (stringp field)
X	  (setq field (symbol-name field)))
X      ;; Get access function of header filed.
X      (setq function (intern-soft (concat "gnus-header-" (downcase field))))
X      (if (and function (fboundp function))
X	  (setq function (symbol-function function))
X	(error "Unknown header field: \"%s\"" field)))
X    ;; Make FORM funcallable.
X    (if (and (listp form) (not (eq (car form) 'lambda)))
X	(setq form (list 'lambda nil form)))
X    ;; Starting from the current article.
X    (or (and ignore-marked
X	     ;; Articles marked as read and unread should be ignored.
X	     (setq article (gnus-Subject-article-number))
X	     (or (not (memq article gnus-newsgroup-unreads)) ;Marked as read.
X		 (memq article gnus-newsgroup-marked) ;Marked as unread.
X		 ))
X	(gnus-execute-1 function regexp form))
X    (while (gnus-Subject-search-subject backward ignore-marked nil)
X      (gnus-execute-1 function regexp form))
X    ))
X
X(defun gnus-execute-1 (function regexp form)
X  (save-excursion
X    ;; The point of Subject mode buffer must be saved during execution.
X    (let ((article (gnus-Subject-article-number)))
X      (if (null article)
X	  nil				;Nothing to do.
X	(if function
X	    ;; Compare with header field.
X	    (let ((header (gnus-find-header-by-number
X			   gnus-newsgroup-headers article))
X		  (value nil))
X	      (and header
X		   (progn
X		     (setq value (funcall function header))
X		     ;; Number (Lines:) or symbol must be converted to string.
X		     (or (stringp value)
X			 (setq value (prin1-to-string value)))
X		     (string-match regexp value))
X		   (if (stringp form)	;Keyboard macro.
X		       (execute-kbd-macro form)
X		     (funcall form))))
X	  ;; Search article body.
X	  (let ((gnus-current-article nil) ;Save article pointer.
X		(gnus-last-article nil)
X		(gnus-break-pages nil)	;No need to break pages.
X		(gnus-Mark-article-hook nil)) ;Inhibit marking as read.
X	    (message "Searching for article: %d..." article)
X	    (gnus-Article-setup-buffer)
X	    (gnus-Article-prepare article t)
X	    (if (save-excursion
X		  (set-buffer gnus-Article-buffer)
X		  (goto-char (point-min))
X		  (re-search-forward regexp nil t))
X		(if (stringp form)	;Keyboard macro.
X		    (execute-kbd-macro form)
X		  (funcall form))))
X	  ))
X      )))
X
X;;; caesar-region written by phr@prep.ai.mit.edu  Nov 86
X;;; modified by tower@prep Nov 86
X;;; Modified by umerin@flab.flab.Fujitsu.JUNET for ROT47.
X
X(defun gnus-caesar-region (&optional n)
X  "Caesar rotation of region by N, default 13, for decrypting netnews.
XROT47 will be performed for Japanese text in any case."
X  (interactive (if current-prefix-arg	; Was there a prefix arg?
X		   (list (prefix-numeric-value current-prefix-arg))
X		 (list nil)))
X  (cond ((not (numberp n)) (setq n 13))
X	((< n 0) (setq n (- 26 (% (- n) 26))))
X	(t (setq n (% n 26))))		;canonicalize N
X  (if (not (zerop n))		; no action needed for a rot of 0
X      (progn
X	(if (or (not (boundp 'caesar-translate-table))
X		(/= (aref caesar-translate-table ?a) (+ ?a n)))
X	    (let ((i 0) (lower "abcdefghijklmnopqrstuvwxyz") upper)
X	      (message "Building caesar-translate-table...")
X	      (setq caesar-translate-table (make-vector 256 0))
X	      (while (< i 256)
X		(aset caesar-translate-table i i)
X		(setq i (1+ i)))
X	      (setq lower (concat lower lower) upper (upcase lower) i 0)
X	      (while (< i 26)
X		(aset caesar-translate-table (+ ?a i) (aref lower (+ i n)))
X		(aset caesar-translate-table (+ ?A i) (aref upper (+ i n)))
X		(setq i (1+ i)))
X	      ;; ROT47 for Japanese text.
X	      ;; Thanks to ichikawa@flab.fujitsu.junet.
X	      (setq i 161)
X	      (let ((t1 (logior ?O 128))
X		    (t2 (logior ?! 128))
X		    (t3 (logior ?~ 128)))
X		(while (< i 256)
X		  (aset caesar-translate-table i
X			(let ((v (aref caesar-translate-table i)))
X			  (if (<= v t1) (if (< v t2) v (+ v 47))
X			    (if (<= v t3) (- v 47) v))))
X		  (setq i (1+ i))))
X	      (message "Building caesar-translate-table... done")))
X	(let ((from (region-beginning))
X	      (to (region-end))
X	      (i 0) str len)
X	  (setq str (buffer-substring from to))
X	  (setq len (length str))
X	  (while (< i len)
X	    (aset str i (aref caesar-translate-table (aref str i)))
X	    (setq i (1+ i)))
X	  (goto-char from)
X	  (delete-region from to)
X	  (insert str)))))
X
X;; Functions accessing headers.
X;; Functions are more convenient than macros in some case.
X
X(defun gnus-header-number (header)
X  "Return article number in HEADER."
X  (nntp-header-number header))
X
X(defun gnus-header-subject (header)
X  "Return subject string in HEADER."
X  (nntp-header-subject header))
X
X(defun gnus-header-from (header)
X  "Return author string in HEADER."
X  (nntp-header-from header))
X
X(defun gnus-header-xref (header)
X  "Return xref string in HEADER."
X  (nntp-header-xref header))
X
X(defun gnus-header-lines (header)
X  "Return lines in HEADER."
X  (nntp-header-lines header))
X
X(defun gnus-header-date (header)
X  "Return date in HEADER."
X  (nntp-header-date header))
X
X(defun gnus-header-id (header)
X  "Return date in HEADER."
X  (nntp-header-id header))
X
X
X;;;
X;;; Article savers.
X;;;
X
X(defun gnus-output-to-rmail (file-name)
X  "Append the current article to an Rmail file named FILE-NAME."
X  (require 'rmail)
X  ;; Most of these codes are borrowed from rmailout.el.
X  (setq file-name (expand-file-name file-name))
X  (setq rmail-last-rmail-file file-name)
X  (let ((artbuf (current-buffer))
X	(tmpbuf (get-buffer-create " *GNUS-output*")))
X    (save-excursion
X      (or (get-file-buffer file-name)
X	  (file-exists-p file-name)
X	  (if (yes-or-no-p
X	       (concat "\"" file-name "\" does not exist, create it? "))
X	      (let ((file-buffer (create-file-buffer file-name)))
X		(save-excursion
X		  (set-buffer file-buffer)
X		  (rmail-insert-rmail-file-header)
X		  (let ((require-final-newline nil))
X		    (write-region (point-min) (point-max) file-name t 1)))
X		(kill-buffer file-buffer))
X	    (error "Output file does not exist")))
X      (set-buffer tmpbuf)
X      (buffer-flush-undo (current-buffer))
X      (erase-buffer)
X      (insert-buffer-substring artbuf)
X      (gnus-convert-article-to-rmail)
X      ;; Decide whether to append to a file or to an Emacs buffer.
X      (let ((outbuf (get-file-buffer file-name)))
X	(if (not outbuf)
X	    (append-to-file (point-min) (point-max) file-name)
X	  ;; File has been visited, in buffer OUTBUF.
X	  (set-buffer outbuf)
X	  (let ((buffer-read-only nil)
X		(msg (and (boundp 'rmail-current-message)
X			  rmail-current-message)))
X	    ;; If MSG is non-nil, buffer is in RMAIL mode.
X	    (if msg
X		(progn (widen)
X		       (narrow-to-region (point-max) (point-max))))
X	    (insert-buffer-substring tmpbuf)
X	    (if msg
X		(progn
X		  (goto-char (point-min))
X		  (widen)
X		  (search-backward "\^_")
X		  (narrow-to-region (point) (point-max))
X		  (goto-char (1+ (point-min)))
X		  (rmail-count-new-messages t)
X		  (rmail-show-message msg))))))
X      )
X    (kill-buffer tmpbuf)
X    ))
X
X(defun gnus-output-to-file (file-name)
X  "Append the current article to a file named FILE-NAME."
X  (setq file-name (expand-file-name file-name))
X  (let ((artbuf (current-buffer))
X	(tmpbuf (get-buffer-create " *GNUS-output*")))
X    (save-excursion
X      (set-buffer tmpbuf)
X      (buffer-flush-undo (current-buffer))
X      (erase-buffer)
X      (insert-buffer-substring artbuf)
X      ;; Append newline at end of the buffer as separator, and then
X      ;; save it to file.
X      (goto-char (point-max))
X      (insert "\n")
X      (append-to-file (point-min) (point-max) file-name))
X    (kill-buffer tmpbuf)
X    ))
X
X(defun gnus-convert-article-to-rmail ()
X  "Convert article in current buffer to Rmail message format."
X  (let ((buffer-read-only nil))
X    ;; Insert special header of Unix mail.
X    (goto-char (point-min))
X    (insert "From "
X	    (or (mail-strip-quoted-names (mail-fetch-field "from"))
X		"unknown")
X	    " " (current-time-string) "\n")
X    ;; ``Quote'' "\nFrom " as "\n>From "
X    ;;  (note that this isn't really quoting, as there is no requirement
X    ;;   that "\n[>]+From " be quoted in the same transparent way.)
X    (while (search-forward "\nFrom " nil t)
X      (forward-char -5)
X      (insert ?>))
X    ;; Convert article to babyl format.
X    (rmail-convert-to-babyl-format)
X    ))
X
X
X;;;
X;;; Internal functions.
X;;;
X
X(defun gnus-start-news-server (&optional confirm)
X  "Open network stream to remote NNTP server.
XIf optional argument CONFIRM is non-nil, ask you host that NNTP server
Xis running even if it is defined."
X  (if (gnus-server-opened)
X      ;; Stream is already opened.
X      nil
X    ;; Open NNTP server.
X    (if (or confirm
X	    (null gnus-nntp-server))
X	(if (and (boundp 'gnus-secondary-servers) gnus-secondary-servers)
X	    ;; Read server name with completion.
X	    (setq gnus-nntp-server
X		  (completing-read "NNTP server: "
X				   (cons (list gnus-nntp-server)
X					 gnus-secondary-servers)
X				   nil nil gnus-nntp-server))
X	  (setq gnus-nntp-server
X		(read-string "NNTP server: " gnus-nntp-server))))
X    ;; If no server name is given, local host is assumed.
X    (if (string-equal gnus-nntp-server "")
X	(setq gnus-nntp-server (system-name)))
X    (cond ((string-match ":" gnus-nntp-server)
X	   ;; :DIRECTORY
X	   (require 'mhspool)
X	   (gnus-define-access-method 'mhspool)
X	   (message "Looking up private directory..."))
X	  ((and (null gnus-nntp-service)
X	        (string-equal gnus-nntp-server (system-name)))
X	   (require 'nnspool)
X	   (gnus-define-access-method 'nnspool)
X	   (message "Looking up local news spool..."))
X	  (t
X	   (gnus-define-access-method 'nntp)
X	   (message "Connecting to NNTP server on %s..." gnus-nntp-server)))
X    (cond ((gnus-open-server gnus-nntp-server gnus-nntp-service))
X	  ((and (stringp (gnus-status-message))
X		(> (length (gnus-status-message)) 0))
X	   ;; Show valuable message if available.
X	   (error (gnus-status-message)))
X	  (t (error "Cannot open NNTP server on %s" gnus-nntp-server)))
X    ))
X
X;; Dummy functions used only once. Should return nil.
X(defun gnus-server-opened () nil)
X(defun gnus-close-server () nil)
X
X(defun gnus-define-access-method (method)
X  "Define access functions for the access METHOD (nntp, nnspool, or mhspool)."
X  (let ((bindings (cdr (assoc method gnus-access-methods))))
X    (if (null bindings)
X	(error "Unknown access method: %s" method)
X      (while bindings
X	(fset (car (car bindings)) (symbol-function (cdr (car bindings))))
X	(setq bindings (cdr bindings)))
X      )))
X
X(defun gnus-select-newsgroup (group &optional show-all)
SHAR_EOF
echo "End of part 4, continue with part 5"
echo "5" > s2_seq_.tmp
exit 0