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 (3 of 5)
Message-ID: <4377@flab.flab.fujitsu.JUNET>
Date: 11 Nov 88 06:19:47 GMT
Reply-To: umerin@flab.flab.fujitsu.JUNET (Masanobu UMEDA)
Organization: Fujitsu Laboratories Ltd., Kawasaki, Japan
Lines: 1433

---- Cut Here and unpack ----
#!/bin/sh
# this is part 3 of a multipart archive
# do not concatenate these parts, unpack them in order with /bin/sh
# file gnus.el continued
#
CurArch=3
if test ! -r s2_seq_.tmp
then echo "Please unpack part 1 first!"
     exit 1; fi
( read Scheck
  if test "$Scheck" != $CurArch
  then echo "Please unpack part $Scheck next!"
       exit 1;
  else exit 0; fi
) < s2_seq_.tmp || exit 1
sed 's/^X//' << 'SHAR_EOF' >> gnus.el
X	  (gnus-Subject-goto-subject current-subject))
X      ;; What's happening now?
X      (setq gnus-newsgroup-unreads current-unreads)
X      (setq gnus-newsgroup-marked  current-marked))
X    ))
X
X(defun gnus-Subject-caesar-message (rotnum)
X  "Caesar rotates all letters of current message by 13/47 places.
XWith prefix arg, specifies the number of places to rotate each letter forward.
XCaesar rotates Japanese letters by 47 places in any case."
X  (interactive "P")
X  (gnus-Subject-select-article)
X  (eval-in-buffer-window gnus-Article-buffer
X    (require 'rnews)
X    (gnus-rebind-functions)
X    (save-restriction
X      (widen)
X      ;; We don't want to jump to the beginning of the message.
X      ;; `save-excursion' does not do its job.
X      (move-to-window-line 0)
X      (let ((last (point)))
X	(news-caesar-buffer-body rotnum)
X	(goto-char last)
X	(recenter 0)
X	))
X    ))
X
X(defun gnus-Subject-rmail-digest ()
X  "Run RMAIL on current digest article.
Xgnus-Select-digest-hook will be called with no arguments, if that
Xvalue is non-nil. It is possible to modify the article so that Rmail
Xcan work with it.
Xgnus-Rmail-digest-hook will be called with no arguments, if that value
Xis non-nil. The hook is intended to customize Rmail mode."
X  (interactive)
X  (gnus-Subject-select-article)
X  (require 'rmail)
X  (let ((artbuf gnus-Article-buffer)
X	(tmpbuf (get-buffer-create gnus-Digest-buffer))
X	(mail-header-separator ""))
X    (set-buffer tmpbuf)
X    (buffer-flush-undo (current-buffer))
X    (setq buffer-read-only nil)
X    (erase-buffer)
X    (insert-buffer-substring artbuf)
X    (run-hooks 'gnus-Select-digest-hook)
X    (gnus-convert-article-to-rmail)
X    (goto-char (point-min))
X    ;; Rmail initializations.
X    (rmail-insert-rmail-file-header)
X    (rmail-mode)
X    (rmail-set-message-counters)
X    (rmail-show-message)
X    (condition-case ()
X	(progn
X	  (undigestify-rmail-message)
X	  (rmail-expunge)		;Delete original message.
X	  ;; File name is meaningless but `save-buffer' requires it.
X	  (setq buffer-file-name "GNUS Digest")
X	  (setq mode-line-buffer-identification
X		(concat "Digest: "
X			(nntp-header-subject gnus-current-headers)))
X	  ;; There is no need to write this buffer to a file.
X	  (make-local-variable 'write-file-hooks)
X	  (setq write-file-hooks
X		(list (function
X		       (lambda ()
X			 (set-buffer-modified-p nil)
X			 (message "(No changes need to be saved)")
X			 'no-need-to-write-this-buffer))))
X	  ;; Default file name saving digest messages.
X	  (setq rmail-last-rmail-file
X		(funcall gnus-article-save-name
X			 gnus-newsgroup-name
X			 gnus-current-headers))
X	  (setq rmail-last-file rmail-last-rmail-file)
X	  ;; Prevent generating new buffer named ***<N> each time.
X	  (setq rmail-summary-buffer
X		(get-buffer-create gnus-Digest-summary-buffer))
X	  (run-hooks 'gnus-Rmail-digest-hook)
X	  (if gnus-digest-show-summary
X	      (progn
X		(pop-to-buffer (current-buffer))
X		(rmail-summary)
X		(message (substitute-command-keys
X			  "Type \\[rmail-summary-quit] to return to GNUS"))
X		)
X	    (switch-to-buffer (current-buffer))
X	    (delete-other-windows)
X	    (message (substitute-command-keys
X		      "Type \\[rmail-quit] to return to GNUS"))
X	    ))
X      (error (set-buffer-modified-p nil)
X	     (kill-buffer (current-buffer))
X	     (ding) (message "Article is not a digest")))
X    ))
X
X(defun gnus-Subject-post-news ()
X  "Post an article."
X  (interactive)
X  (gnus-Subject-select-article)
X  (switch-to-buffer gnus-Article-buffer)
X  (set-marker overlay-arrow-position nil)
X  (widen)
X  (delete-other-windows)
X  (bury-buffer gnus-Article-buffer)
X  (gnus-post-news))
X
X(defun gnus-Subject-post-reply ()
X  "Post a reply article."
X  (interactive)
X  (gnus-Subject-select-article)
X  (switch-to-buffer gnus-Article-buffer)
X  (set-marker overlay-arrow-position nil)
X  (widen)
X  (delete-other-windows)
X  (bury-buffer gnus-Article-buffer)
X  (gnus-news-reply))
X
X(defun gnus-Subject-cancel ()
X  "Cancel an article you posted."
X  (interactive)
X  (gnus-Subject-select-article)
X  (eval-in-buffer-window gnus-Article-buffer
X    (if (yes-or-no-p "Do you really want to cancel this article? ")
X	(gnus-inews-cancel))
X    ))
X
X(defun gnus-Subject-mail-reply ()
X  "Reply mail to news author."
X  (interactive)
X  (gnus-Subject-select-article)
X  (switch-to-buffer gnus-Article-buffer)
X  (set-marker overlay-arrow-position nil)
X  (widen)
X  (delete-other-windows)
X  (bury-buffer gnus-Article-buffer)
X  (news-mail-reply)
X  (gnus-rebind-functions))
X
X(defun gnus-Subject-mail-other-window ()
X  "Reply mail to news author in other window."
X  (interactive)
X  (gnus-Subject-select-article)
X  (switch-to-buffer gnus-Article-buffer)
X  (set-marker overlay-arrow-position nil)
X  (widen)
X  (delete-other-windows)
X  (bury-buffer gnus-Article-buffer)
X  (news-mail-other-window)
X  (gnus-rebind-functions))
X
X(defun gnus-Subject-save-article ()
X  "Save this article using default saver function.
XVariable `gnus-article-default-saver' specifies the saver function."
X  (interactive)
X  (gnus-Subject-select-article
X   (not (null gnus-save-all-headers)) gnus-save-all-headers)
X  (if (and gnus-article-default-saver
X	   (fboundp gnus-article-default-saver))
X      (call-interactively gnus-article-default-saver)
X    (error "No default saver function is defined.")))
X
X(defun gnus-Subject-save-in-rmail ()
X  "Append this article to Rmail file.
XDirectory to save to is default to `gnus-article-save-directory' which
Xis initialized from the SAVEDIR environment variable."
X  (interactive)
X  (gnus-Subject-select-article
X   (not (null gnus-save-all-headers)) gnus-save-all-headers)
X  (eval-in-buffer-window gnus-Article-buffer
X    (save-excursion
X      (save-restriction
X	(widen)
X	(let* ((overlay-arrow-position nil)
X	       (default-name
X		 (funcall gnus-article-save-name
X			  gnus-newsgroup-name
X			  gnus-current-headers))
X	       (file (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 file))
X	  (gnus-output-to-rmail file)
X	  ;; Remember the directory name to save articles.
X	  (setq gnus-newsgroup-last-file file)
X	  )))
X    ))
X
X(defun gnus-Subject-save-in-mail ()
X  "Append this article to Unix mail file.
XDirectory to save to is default to `gnus-article-save-directory' which
Xis initialized from the SAVEDIR environment variable."
X  (interactive)
X  (gnus-Subject-select-article
X   (not (null gnus-save-all-headers)) gnus-save-all-headers)
X  (eval-in-buffer-window gnus-Article-buffer
X    (save-excursion
X      (save-restriction
X	(widen)
X	(let* ((overlay-arrow-position nil)
X	       (default-name
X		 (funcall gnus-article-save-name
X			  gnus-newsgroup-name
X			  gnus-current-headers))
X	       (file (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 file))
X	  (rmail-output file)
X	  ;; Remember the directory name to save articles.
X	  (setq gnus-newsgroup-last-file file)
X	  )))
X    ))
X
X(defun gnus-Subject-save-in-file ()
X  "Append this article to file.
XDirectory to save to is default to `gnus-article-save-directory' which
Xis initialized from the SAVEDIR environment variable."
X  (interactive)
X  (gnus-Subject-select-article
X   (not (null gnus-save-all-headers)) gnus-save-all-headers)
X  (eval-in-buffer-window gnus-Article-buffer
X    (save-excursion
X      (save-restriction
X	(widen)
X	(let* ((overlay-arrow-position nil)
X	       (default-name
X		 (funcall gnus-article-save-name
X			  gnus-newsgroup-name
X			  gnus-current-headers))
X	       (file (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 file))
X	  (gnus-output-to-file file)
X	  ;; Remember the directory name to save articles.
X	  (setq gnus-newsgroup-last-file file)
X	  )))
X    ))
X
X(defun gnus-Subject-save-in-folder ()
X  "Save this article to MH folder (using `rcvstore' in MH library).
XFolder to save in is default to `gnus-article-mh-folder'."
X  (interactive)
X  (gnus-Subject-select-article
X   (not (null gnus-save-all-headers)) gnus-save-all-headers)
X  (eval-in-buffer-window gnus-Article-buffer
X    (save-restriction
X      (widen)
X      (let ((overlay-arrow-position nil))
X	;; Thanks to yuki@flab.Fujitsu.JUNET and ohm@kaba.junet.
X	(mh-find-path)
X	(shell-command-on-region
X	 (point-min) (point-max)
X	 (concat (expand-file-name "rcvstore" mh-lib) " "
X		 (mh-prompt-for-folder "Save article in"
X				       gnus-article-mh-folder t))
X	 nil)
X	))
X    ))
X
X(defun gnus-Subject-pipe-output ()
X  "Pipe this article to subprocess."
X  (interactive)
X  ;; Ignore `gnus-save-all-headers' since this is not save command.
X  (gnus-Subject-select-article)
X  (eval-in-buffer-window gnus-Article-buffer
X    (save-restriction
X      (widen)
X      (let ((overlay-arrow-position nil))
X	(shell-command-on-region
X	 (point-min) (point-max)
X	 (read-string "Shell command on article: ") nil)
X	))
X    ))
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				 gnus-newsgroup-unreads
X				 gnus-newsgroup-marked)
X    (setq updated
X	  (gnus-mark-as-read-by-xref gnus-newsgroup-name
X				     gnus-newsgroup-headers
X				     gnus-newsgroup-unreads))
X    (if temporary
X	;; Do not switch windows but change the buffer to work.
X	(set-buffer gnus-Group-buffer)
X      ;; Return to Group selection mode.
X      (if (get-buffer gnus-Subject-buffer)
X	  (bury-buffer gnus-Subject-buffer))
X      (if (get-buffer gnus-Article-buffer)
X	  (bury-buffer gnus-Article-buffer))
X      (switch-to-buffer gnus-Group-buffer)
X      (delete-other-windows))
X    ;; Update cross referenced group info.
X    (while updated
X      (gnus-Group-update-group (car updated) t) ;Ignore invisible group.
X      (setq updated (cdr updated)))
X    (gnus-Group-update-group gnus-newsgroup-name)
X    (gnus-Group-next-unread-group 1)
X    ))
X
X(defun gnus-Subject-quit ()
X  "Quit reading current newsgroup without updating read article info."
X  (interactive)
X  (if (y-or-n-p "Do you really wanna quit reading this group? ")
X      (progn
X	;; Return to Group selection mode.
X	(if (get-buffer gnus-Subject-buffer)
X	    (bury-buffer gnus-Subject-buffer))
X	(if (get-buffer gnus-Article-buffer)
X	    (bury-buffer gnus-Article-buffer))
X	(switch-to-buffer gnus-Group-buffer)
X	(delete-other-windows)
X	(gnus-Group-next-unread-group 1)
X	)))
X
X
X;;;
X;;; GNUS Article 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 "?" 'describe-mode)
X  ;; gnus-Exit-group-hook should be evaluated in Subject mode buffer.
X  ;;(define-key gnus-Article-mode-map "q" 'gnus-Subject-exit)
X  ;;(define-key gnus-Article-mode-map "Q" 'gnus-Subject-quit)
X  )
X
X(defun gnus-Article-mode ()
X  "Major mode for reading news articles.
XAll normal editing commands are turned off.
XInstead, these commands are available:
X\\{gnus-Article-mode-map}
X
XVarious hooks for customization:
X gnus-Article-mode-hook
X    Entry to this mode calls the value with no arguments, if that
X    value is non-nil.
X
X gnus-Article-prepare-hook
X    Called with no arguments after an article is prepared for reading,
X    if that value is non-nil."
X  (interactive)
X  (kill-all-local-variables)
X  (if (boundp 'mode-line-modified)
X      (setq mode-line-modified "--- ")
X    (setq mode-line-format
X    	  (cons "--- " (cdr (default-value 'mode-line-format)))))
X  (make-local-variable 'global-mode-string)
X  (setq global-mode-string nil)
X  (setq major-mode 'gnus-Article-mode)
X  (setq mode-name "GNUS Article")
X  (gnus-Article-set-mode-line)
X  (use-local-map gnus-Article-mode-map)
X  (make-local-variable 'page-delimiter)
X  (setq page-delimiter gnus-page-delimiter)
X  (make-local-variable 'mail-header-separator)
X  (setq mail-header-separator "")	;For caesar function.
X  ;; Overlay arrow does not work if it's buffer local.
X  (setq overlay-arrow-string gnus-more-message)
X  (setq overlay-arrow-position (make-marker))
X  (buffer-flush-undo (current-buffer))
X  (setq buffer-read-only t)		;Disable modification
X  (run-hooks 'gnus-Article-mode-hook))
X
X(defun gnus-Article-setup-buffer ()
X  "Initialize Article mode buffer."
X  (or (get-buffer gnus-Article-buffer)
X      (save-excursion
X	(set-buffer (get-buffer-create gnus-Article-buffer))
X	(gnus-Article-mode))
X      ))
X
X(defun gnus-Article-prepare (article &optional all-headers)
X  "Prepare ARTICLE in Article mode buffer.
XIf optional argument ALL-HEADERS is non-nil, all headers are inserted."
X  (save-excursion
X    (set-buffer gnus-Article-buffer)
X    (let ((buffer-read-only nil))
X      ;; Marker may slow down editing command of Emacs.
X      (set-marker overlay-arrow-position nil)
X      (erase-buffer)
X      (if (nntp-request-article article)
X	  (progn
X	    ;; Prepare article buffer
X	    (insert-buffer-substring nntp-server-buffer)
X	    (setq gnus-have-all-headers (or all-headers gnus-show-all-headers))
X	    (if (and (numberp article)
X		     (not (eq article gnus-current-article)))
X		(progn
X		  ;; gnus-current-article must be an article number.
X		  (setq gnus-last-article gnus-current-article)
X		  (setq gnus-current-article article)
X		  (setq gnus-current-headers
X			(gnus-find-header-by-number gnus-newsgroup-headers
X						    gnus-current-article))
X		  ;; Clear articles history only when articles are
X		  ;; retrieved by article numbers.
X		  (setq gnus-current-history nil)
X		  (run-hooks 'gnus-Mark-article-hook)
X		  ))
X	    ;; Hooks for modifying contents of the article. This hook
X	    ;; must be called before being narrowed.
X	    (run-hooks 'gnus-Article-prepare-hook)
X	    ;; Delete unnecessary headers.
X	    (or gnus-have-all-headers
X		(gnus-Article-delete-headers))
X	    ;; Do page break.
X	    (goto-char (point-min))
X	    (if gnus-break-pages
X		(gnus-narrow-to-page))
X	    ;; Next function must be called after setting
X	    ;;  `gnus-current-article' variable and narrowed to page.
X	    (gnus-Article-set-mode-line)
X	    )
X	(if (numberp article)
X	    (gnus-Subject-mark-as-read article))
X	(ding) (message "No such article (may be canceled)"))
X      )))
X
X(defun gnus-Article-show-all-headers ()
X  "Show all article headers in Article mode buffer."
X  (gnus-Article-setup-buffer)
X  (gnus-Article-prepare gnus-current-article t))
X
X(defun gnus-Article-set-mode-line ()
X  "Set Article mode line string."
X  (setq mode-line-buffer-identification
X	(list 17
X	      (format "GNUS: %s {%d-%d} %d"
X		      gnus-newsgroup-name
X		      gnus-newsgroup-begin
X		      gnus-newsgroup-end
X		      gnus-current-article)))
X  (set-buffer-modified-p t))
X
X;;(defun gnus-Article-set-mode-line ()
X;;  "Set Article mode line string."
X;;  (let ((string (format "%s {%d-%d} %d"
X;;			gnus-newsgroup-name
X;;			gnus-newsgroup-begin
X;;			gnus-newsgroup-end
X;;			gnus-current-article)))
X;;    (setq mode-line-buffer-identification
X;;	  (concat "GNUS: "
X;;		  string
X;;		  ;; Enough spaces to pad group name to 17 positions.
X;;		  (substring "                 "
X;;			     0 (max 0 (- 17 (length string))))))
X;;    (set-buffer-modified-p t)
X;;    ))
X
X(defun gnus-Article-delete-headers ()
X  "Delete unnecessary headers."
X  (save-excursion
X    (save-restriction
X      (goto-char (point-min))
X      (narrow-to-region (point-min)
X			(condition-case ()
X			    (progn (search-forward "\n\n") (point))
X			  (error (point-max))))
X      (goto-char (point-min))
X      (and (stringp gnus-ignored-headers)
X	   (while (re-search-forward gnus-ignored-headers nil t)
X	     (beginning-of-line)
X	     (delete-region (point)
X			    (progn (re-search-forward "\n[^ \t]")
X				   (forward-char -1)
X				   (point)))))
X      )))
X
X;; Working on article's buffer
X
X(defun gnus-Article-next-page (lines)
X  "Show next page of current article.
XIf end of article, return non-nil. Otherwise return nil.
XArgument LINES specifies lines to be scrolled up."
X  (interactive "P")
X  (move-to-window-line -1)
X  (if (eobp)
X      (if (or (not gnus-break-pages)
X	      (save-restriction (widen) (eobp))) ;Real end-of-buffer?
X	  t
X	(gnus-narrow-to-page 1)		;Go to next page.
X	nil
X	)
X    (scroll-up lines)
X    nil
X    ))
X
X(defun gnus-Article-prev-page (lines)
X  "Show previous page of current article.
XArgument LINES specifies lines to be scrolled down."
X  (interactive "P")
X  (move-to-window-line 0)
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  ;; This feature is suggested by Khalid Sattar <admin@cs.exeter.ac.uk>.
X  (while (and (> nth 1)
X	      (re-search-forward "^Subject:[ \t]" nil 'move))
X    (setq nth (1- nth)))
X  (if (re-search-forward "^Subject:[ \t]" nil t)
X      (let ((begin (point)))
X	;; Search for end of this message.
X	(end-of-line)
X	(if (re-search-forward "^Subject:[ \t]" nil t)
X	    (progn
X	      (search-backward "\n\n")
X	      (forward-line 1))
X	  (goto-char (point-max)))
X	(push-mark)			;Set mark at end of digested message.
X	(goto-char begin)
X	(beginning-of-line)
X	;; Show From: and Subject: fields.
X	(recenter 1))
X    (message "End of message")
X    ))
X
X(defun gnus-Article-prev-digest (nth)
X  "Move to head of NTH previous digested message."
X  ;; Stop page breaking in digest mode.
X  (set-marker overlay-arrow-position nil)
X  (widen)
X  (beginning-of-line)
X  ;; Skip NTH - 1 digest.
X  ;; This feature is suggested by Khalid Sattar <admin@cs.exeter.ac.uk>.
X  (while (and (> nth 1)
X	      (re-search-backward "^Subject:[ \t]" nil 'move))
X    (setq nth (1- nth)))
X  (if (re-search-backward "^Subject:[ \t]" nil t)
X      (let ((begin (point)))
X	;; Search for end of this message.
X	(end-of-line)
X	(if (re-search-forward "^Subject:[ \t]" nil t)
X	    (progn
X	      (search-backward "\n\n")
X	      (forward-line 1))
X	  (goto-char (point-max)))
X	(push-mark)			;Set mark at end of digested message.
X	(goto-char begin)
X	;; Show From: and Subject: fields.
X	(recenter 1))
X    (goto-char (point-min))
X    (message "Top of message")
X    ))
X
X(defun gnus-Article-refer-article ()
X  "Read article specified by message-id around point."
X  (interactive)
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      (message "No references around point"))
X    ))
X
X(defun gnus-Article-pop-article ()
X  "Pop up article history."
X  (interactive)
X  (set-buffer gnus-Subject-buffer)
X  (gnus-Subject-refer-article nil))
X
X(defun gnus-Article-show-subjects ()
X  "Reconfigure windows in order to show subjects."
X  (interactive)
X  (delete-other-windows)		;Force re-configure windows.
X  (gnus-Subject-configure-window)
X  (gnus-Subject-goto-subject gnus-current-article))
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-s" 'save-buffer)
X  (define-key gnus-Kill-file-mode-map "\C-c\C-c" 'gnus-Kill-file-exit))
X
X(defun gnus-Kill-file-mode ()
X  "Major mode for editing KILL file.
X
X\\[save-buffer]	Save current KILL file.
X\\[gnus-Kill-file-exit]	Exit editing KILL file.
X
XKILL file is a file which contains lisp expressions to be applied to
Xselected newsgroup. The purpose of a KILL file is to mark articles as
Xread on the basis of some set of regexps.  Global KILL file is applied
Xto every newsgroup while local KILL file is applied to specified
Xnewsgroup. Since global KILL file is applied to every newsgroup, you'd
Xbetter not use global KILL file but local one for better performance.
X
XKILL file can contain any kind of Emacs lisp expressions which is
Xexpected to be evaluated in GNUS Subject mode buffer. Writing lisp
Xprograms for this purpose, however, is not so easy because internals
Xof GNUS must be well-known. For this reason, GNUS provides a general
Xfunction doing this easily for non-Lisp programmers.
X
XFunction `gnus-kill' is a function to execute commands available in
XGNUS Subject mode by their key sequences. `gnus-kill' should be called
Xwith FIELD, REGEXP and optional COMMAND. FIELD must be a string
Xrepresenting header field or an empty string. If FIELD is an empty
Xstring, entire article body is searched for. REGEXP is a string which
Xis compared with FIELD value. COMMAND is a string representing valid
Xkey sequence in GNUS Subject mode, or Lisp expression. COMMAND is
Xdefault to '(gnus-Subject-mark-as-read nil \"X\"). Make sure that
XCOMMAND is executed in GNUS Subject mode buffer.
X
XFor example, if you'd like to mark articles of which subject contains
Xa string `AI' as read, KILL file looks like:
X
X	(gnus-kill \"Subject\" \"AI\" \"d\")
X
XIn this example it is assumed that `gnus-Subject-mark-as-read-forward'
Xis assigned to `d' in GNUS Subject mode.
X
XIf you want to put a special marks like a `@' instead of `D' or `K',
Xyou can use the following expression:
X
X	(gnus-kill \"Subject\" \"AI\" '(gnus-Subject-mark-as-read nil \"@\"))
X
XIt is possible to delete unnecessary lines which is marked with `@' in
XKILL file as follows:
X
X	(gnus-Subject-delete-marked \"@\")
X
XIf the buffer is empty, GNUS will exit selected newsgroup normally.
XIf you delete lines which is marked `D', it is impossible to read
Xarticles which is marked as read in previous GNUS sessions. You'd
Xbetter set different marks other than `D' to articles which should be
Xdeleted.
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 "Edit 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-global ()
X  "Edit global KILL file.
XGlobal KILL file is applied to every newsgroup. Since KILL file makes
XGNUS slower, you'd better not use global KILL file but local one."
X  (interactive)
X  (gnus-Kill-file-edit (gnus-Kill-file-pathname t))
X  (message
X   (substitute-command-keys
X    "Editing global KILL file (Type \\[gnus-Kill-file-exit] to exit)")))
X
X(defun gnus-Kill-file-edit-local ()
X  "Edit local KILL file.
XLocal KILL file is applied to current newsgroup only."
X  (interactive)
X  (gnus-Kill-file-edit (gnus-Kill-file-pathname nil))
X  (message
X   (substitute-command-keys
X    "Editing local KILL file (Type \\[gnus-Kill-file-exit] to exit)")))
X
X(defun gnus-Kill-file-edit (file)
X  "Edit kill FILE."
X  (interactive "f")
X  (gnus-make-directory (file-name-directory file))
X  (find-file-other-window file)
X  (gnus-Kill-file-mode))
X
X(defun gnus-Kill-file-exit ()
X  "Save KILL file, then return to previous buffer."
X  (interactive)
X  (save-buffer)
X  (bury-buffer))
X
X(defun gnus-Kill-file-pathname (global)
X  (cond (global
X	 ;; Put global kill file 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 gnus-newsgroup-name
X				   "." gnus-kill-file-name)
X			   (gnus-save-directory)))
X	(t
X	 ;; Put "KILL" under the hierarchical directory.
X	 (expand-file-name gnus-kill-file-name (gnus-save-directory)))
X	))
X
X(defun gnus-Kill-file-apply ()
X  "Apply KILL file to current newsgroup."
X  ;; Apply global kill file.
X  (let ((global (gnus-Kill-file-pathname t)))
X    (if (file-exists-p global)
X	(load global t t t)))
X  ;; And then apply local kill file.
X  (let ((local (gnus-Kill-file-pathname nil)))
X    (if (file-exists-p local)
X	(load local t t t))))
X
X;;(defun gnus-Kill-file-execute (file)
X;;  "Apply kill FILE.
X;;Expression in the kill file is evaluated in current buffer."
X;;  (let ((buffer (find-file-noselect file)))
X;;    (save-excursion
X;;      (set-buffer buffer)
X;;      (goto-char (point-min)))
X;;    (while (save-excursion
X;;	     (set-buffer buffer)
X;;	     (while (progn (skip-chars-forward " \t\n\^l")
X;;			   (looking-at ";"))
X;;	       (forward-line 1))
X;;	     (not (eobp)))
X;;      ;; Make Subject mode buffer modifiable.
X;;      (let ((buffer-read-only nil))
X;;	(eval (read buffer)))
X;;      )))
X
X
X;;;
X;;; Utility functions
X;;;
X
X(defun gnus-article-save-name (newsgroup headers)
X  "Generate file name from NEWSGROUP and HEADERS.
XIf variable `gnus-use-long-file-name' is nil, it is ~/News/NEWSGROUP.
XOtherwise, it is like ~/News/NEWS/GROUP/NUMBER."
X  (let ((default
X	  (expand-file-name (if gnus-use-long-file-name
X				newsgroup
X			      (int-to-string (nntp-header-number headers)))
X			    (gnus-save-directory)))
X	(last-file gnus-newsgroup-last-file))
X    (if (and (not gnus-use-long-file-name)
X	     last-file
X	     (string-match "^[0-9]+$" (file-name-nondirectory last-file)))
X	;; We assume the standard name GNUS inserted was used last.
X	default
X      (or last-file default))
X    ))
X
X(defun gnus-save-directory ()
X  "Return directory name saving article in current newsgroup."
X  (let ((group (if gnus-use-long-file-name "" gnus-newsgroup-name)))
X    (file-name-as-directory
X     (concat (file-name-as-directory (or gnus-article-save-directory "~/News"))
X	     (gnus-group-directory-form group)))
X    ))
X
X(defun gnus-group-directory-form (group)
X  "Make hierarchical directory name from newsgroup GROUP name."
X  (let ((group (substring group 0))	;Copy string.
X	(len (length group))
X	(idx 0))
X    ;; Replace all occurence of `.' with `/'.
X    (while (< idx len)
X      (if (= (aref group idx) ?.)
X	  (aset group idx ?/))
X      (setq idx (1+ idx)))
X    group
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]*([^()]*)[ \t]*$" 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 will be 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-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    (if (string-match "^\\([^ ]+\\) \\([^ ]+\\) \\([^ ]+\\) \\([^ ]+\\) " date)
X	(concat
X	 ;; Year
X	 (substring date (match-beginning 3) (match-end 3))
X	 ;; Month
X	 (cdr (assoc (substring date (match-beginning 2) (match-end 2)) month))
X	 ;; Day
X	 (format "%2d" (string-to-int
X			(substring date
X				   (match-beginning 1) (match-end 1))))
X	 ;; Time
X	 (substring date (match-beginning 4) (match-end 4)))
X      ;; 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(defun gnus-kill (field regexp &optional command)
X  "If FIELD of an article matches REGEXP, execute COMMAND.
XOptional argument COMMAND is default to (gnus-Subject-mark-as-read nil \"X\").
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))))
X
X(defun gnus-execute (field regexp form &optional backward)
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 argument BACKWARD is non-nil, do backward instead."
X  (let ((function nil)
X	(header 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 current article.
X    (gnus-execute-1 function regexp form)
X    (while (gnus-Subject-search-subject backward nil nil)
X      (gnus-execute-1 function regexp form))
X    ))
X
X(defun gnus-execute-1 (function regexp form)
X  (save-excursion
X    ;; 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	  (kill-region from to)
X	  (insert str)))))
X
X
X;;;
X;;; General functions.
X;;;
X
X(defun gnus-start-news-server (&optional confirm)
X  "Open network stream to remote NNTP server.
XIf optional argument CONFIRM is non-nil, ask you host that NNTP server
Xis running even if it is defined."
X  (if (nntp-server-opened)
X      ;; Stream is already opened.
X      nil
X    ;; Open NNTP server.
X    (if (or confirm
X	    (null gnus-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    ;; BUGS: Compatibility with 3.8 version. This will be remove in
X    ;; 4.* version.
X    (setq gnus-server-host gnus-nntp-server)
X    (cond ((string-match ":" gnus-nntp-server)
X	   ;; :DIRECTORY
X	   (require '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	   (message "Looking up local news spool..."))
X	  (t
X	   (message "Connecting to NNTP server on %s..." gnus-nntp-server)))
X    (cond ((nntp-open-server gnus-nntp-server gnus-nntp-service))
X	  ((and (stringp (nntp-status-message))
X		(> (length (nntp-status-message)) 0))
X	   ;; Show valuable message if available.
X	   (error (nntp-status-message)))
X	  (t (error "Cannot open NNTP server on %s" gnus-nntp-server)))
X    ))
X
X(defun gnus-select-newsgroup (group &optional show-all)
X  "Select newsgroup GROUP.
XIf optional argument SHOW-ALL is non-nil, all of articles in the group
Xare selected."
X  (if (nntp-request-group group)
X      (let ((articles nil))
X	(setq gnus-newsgroup-name group)
X	(setq gnus-newsgroup-unreads
X	      (gnus-uncompress-sequence
X	       (nthcdr 2 (gnus-gethash group gnus-unread-hashtb))))
X	(cond (show-all
X	       ;; Select all active articles.
X	       (setq articles
X		     (gnus-uncompress-sequence
X		      (nthcdr 2 (gnus-gethash group gnus-active-hashtb)))))
X	      (t
X	       ;; Select unread articles only.
X	       (setq articles gnus-newsgroup-unreads)))
X	;; Get headers list.
X	(setq gnus-newsgroup-headers (nntp-retrieve-headers articles))
X	;; UNREADS may contain expired articles, so we have to remove
X	;;  them from the list.
X	(setq gnus-newsgroup-unreads
X	      (gnus-intersection gnus-newsgroup-unreads
X				 (mapcar
X				  (function
X				   (lambda (header)
X				     (nntp-header-number header)))
X				  gnus-newsgroup-headers)))
X	;; Marked article must be a subset of unread articles.
X	(setq gnus-newsgroup-marked
X	      (gnus-intersection gnus-newsgroup-unreads
X				 (cdr (assoc group gnus-marked-assoc))))
X	;; First and last article in this newsgroup.
X	(setq gnus-newsgroup-begin
X	      (if gnus-newsgroup-headers
X		  (nntp-header-number (car gnus-newsgroup-headers))
X		0
X		))
X	(setq gnus-newsgroup-end
X	      (if gnus-newsgroup-headers
X		  (nntp-header-number
X		   (gnus-last-element gnus-newsgroup-headers))
X		0
X		))
X	;; File name that an article was saved last.
X	(setq gnus-newsgroup-last-file nil)
X	;; Reset article pointer etc.
X	(setq gnus-current-article nil)
X	(setq gnus-current-headers nil)
X	(setq gnus-current-history nil)
X	(setq gnus-have-all-headers nil)
X	(setq gnus-last-article nil)
X	;; GROUP is successfully selected.
X	t
X	)
X    ))
X
X(defun gnus-mark-article-as-read (article)
X  "Remember that ARTICLE is marked as read."
X  ;; Remove from unread and marked list.
X  (setq gnus-newsgroup-unreads
X	(delq article gnus-newsgroup-unreads))
X  (setq gnus-newsgroup-marked
X	(delq article gnus-newsgroup-marked)))
X
X(defun gnus-mark-article-as-unread (article &optional clear-mark)
X  "Remember that ARTICLE is marked as unread.
XOptional argument CLEAR-MARK means ARTICLE should not be remembered
Xthat it was marked as read once."
X  ;; Add to unread list.
X  (or (memq article gnus-newsgroup-unreads)
X      (setq gnus-newsgroup-unreads
X	    (cons article gnus-newsgroup-unreads)))
X  ;; If CLEAR-MARK is non-nil, the article must be removed from marked
X  ;; list.  Otherwise, it must be added to the list.
X  (if clear-mark
X      (setq gnus-newsgroup-marked
X	    (delq article gnus-newsgroup-marked))
X    (or (memq article gnus-newsgroup-marked)
X	(setq gnus-newsgroup-marked
X	      (cons article gnus-newsgroup-marked)))))
X
X(defun gnus-clear-system ()
X  "Clear all variables and buffer."
X  ;; Clear variables.
X  (setq gnus-newsrc-assoc nil)
X  (setq gnus-marked-assoc nil)
X  (setq gnus-active-hashtb nil)
X  (setq gnus-unread-hashtb nil)
X  ;; Kill buffers
X  (and gnus-current-startup-file
X       (get-file-buffer gnus-current-startup-file)
X       (kill-buffer (get-file-buffer gnus-current-startup-file)))
X  (setq gnus-current-startup-file nil)
X  ;; Kill buffers.
X  (if (get-buffer gnus-Digest-buffer)
X      (kill-buffer gnus-Digest-buffer))
X  (if (get-buffer gnus-Digest-summary-buffer)
X      (kill-buffer gnus-Digest-summary-buffer))
X  (if (get-buffer gnus-Article-buffer)
X      (kill-buffer gnus-Article-buffer))
X  (if (get-buffer gnus-Subject-buffer)
X      (kill-buffer gnus-Subject-buffer))
X  (if (get-buffer gnus-Group-buffer)
X      (kill-buffer gnus-Group-buffer)))
X
X(defun gnus-find-header-by-number (headers number)
X  "Return a header which is a element of HEADERS and has NUMBER."
X  (let ((found nil))
X    (while (and headers (not found))
X      ;; We cannot use `=' to accept non-numeric NUMBER.
X      (if (eq number (nntp-header-number (car headers)))
X	  (setq found (car headers)))
X      (setq headers (cdr headers)))
X    found
X    ))
X
X(defun gnus-version ()
X  "Version numbers of this version of GNUS."
X  (interactive)
X  (if (boundp 'nnspool-version)
X      (message "You're running %s with %s and %s"
X	       gnus-version nntp-version nnspool-version)
X    (message "You're running %s with %s" gnus-version nntp-version)))
X
X(defun gnus-rebind-functions ()
X  "Replace functions defined in rnews.el and rnewspost.el."
X  ;; Override news-inews function in rnewspost.el.
X  (fset 'news-inews 'gnus-inews)
X  ;; Override caesar-region function in rnews.el.
X  (fset 'caesar-region 'gnus-caesar-region))
X
X(defun gnus-narrow-to-page (&optional arg)
X  "Make text outside current page invisible except for page delimiter.
XA numeric arg specifies to move forward or backward by that many pages,
Xthus showing a page other than the one point was originally in."
X  (interactive "P")
X  (setq arg (if arg (prefix-numeric-value arg) 0))
X  (save-excursion
X    (forward-page -1) ;Beginning of current page.
X    (widen)
X    (if (> arg 0)
X	(forward-page arg)
X      (if (< arg 0)
X	  (forward-page (1- arg))))
X    ;; Find the end of the page.
X    (forward-page)
X    ;; If we stopped due to end of buffer, stay there.
X    ;; If we stopped after a page delimiter, put end of restriction
X    ;; at the beginning of that line.
X    ;; These are commented out.
X    ;;    (if (save-excursion (beginning-of-line)
X    ;;			(looking-at page-delimiter))
X    ;;	(beginning-of-line))
X    (let ((end (point-max)))
X      (narrow-to-region (point)
X			(progn
X			  ;; Find the top of the page.
X			  (forward-page -1)
X			  ;; If we found beginning of buffer, stay there.
X			  ;; If extra text follows page delimiter on same line,
X			  ;; include it.
X			  ;; Otherwise, show text starting with following line.
X			  (if (and (eolp) (not (bobp)))
X			      (forward-line 1))
X			  (point)))
X      (if (and gnus-break-pages overlay-arrow-string)
X	  ;; Show MORE message at end of the page except for last page.
X	  (if (/= (point-max) end)
X	      (set-marker overlay-arrow-position
X			  (progn (goto-char (point-max))
X				 (beginning-of-line)
X				 (point)))
X	    (set-marker overlay-arrow-position nil)))
X      )))
X
X(defun gnus-last-element (list)
X  "Return last element of LIST."
X  (let ((last nil))
X    (while list
X      (if (null (cdr list))
X	  (setq last (car list)))
X      (setq list (cdr list)))
X    last
X    ))
X
X(defun gnus-set-difference (list1 list2)
X  "Return a list of elements of LIST1 that do not appear in LIST2."
X  (let ((list1 (if list2 (copy-sequence list1) list1)))
X    (while list2
X      (setq list1 (delq (car list2) list1))
X      (setq list2 (cdr list2)))
X    list1
X    ))
X
X(defun gnus-intersection (list1 list2)
X  "Return a list of elements that appear in both LIST1 and LIST2."
X  (let ((result nil))
X    (while list2
X      (if (memq (car list2) list1)
X	  (setq result (cons (car list2) result)))
X      (setq list2 (cdr list2)))
X    result
X    ))
X
X
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
SHAR_EOF
echo "End of part 3, continue with part 4"
echo "4" > s2_seq_.tmp
exit 0
-- 
Masanobu UMEDA
umerin@flab.flab.Fujitsu.JUNET
umerin%flab.flab.Fujitsu.JUNET@uunet.uu.NET