#!/bin/sh
# this is part 5 of a multipart archive
# do not concatenate these parts, unpack them in order with /bin/sh
# file gnus.el continued
#
CurArch=5
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	     (pop-to-buffer buffer))
X	    ((eq major-mode 'gnus-Group-mode)
X	     (gnus-configure-windows '(1 0 0)) ;Take all windows.
X	     (pop-to-buffer gnus-Group-buffer)
X	     (let ((gnus-Subject-buffer buffer))
X	       (gnus-configure-windows '(1 1 0)) ;Split into two.
X	       (pop-to-buffer buffer)))
X	    ((eq major-mode 'gnus-Subject-mode)
X	     (gnus-configure-windows 'SelectArticle)
X	     (pop-to-buffer gnus-Article-buffer)
X	     (bury-buffer gnus-Article-buffer)
X	     (switch-to-buffer buffer))
X	    (t				;No good rules.
X	     (find-file-other-window file))
X	    ))
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	   (prin1-to-string
X	    (if gnus-current-kill-article
X		(regexp-quote
X		 (nntp-header-subject
X		  (gnus-find-header-by-number gnus-newsgroup-headers
X					      gnus-current-kill-article)))
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	   (prin1-to-string
X	    (if gnus-current-kill-article
X		(regexp-quote
X		 (nntp-header-from
X		  (gnus-find-header-by-number gnus-newsgroup-headers
X					      gnus-current-kill-article)))
X	      "")))))
X
X(defun gnus-Kill-file-apply-buffer ()
X  "Apply current buffer to current newsgroup."
X  (interactive)
X  (if (and gnus-current-kill-article
X	   (get-buffer gnus-Subject-buffer))
X      ;; Assume newsgroup is selected.
X      (let ((string (concat "(progn \n" (buffer-string) "\n)" )))
X	(save-excursion
X	  (save-window-excursion
X	    (pop-to-buffer gnus-Subject-buffer)
X	    (eval (car (read-from-string string))))))
X    (ding) (message "No newsgroup is selected.")))
X
X(defun gnus-Kill-file-apply-last-sexp ()
X  "Apply sexp before point in current buffer to current newsgroup."
X  (interactive)
X  (if (and gnus-current-kill-article
X	   (get-buffer gnus-Subject-buffer))
X      ;; Assume newsgroup is selected.
X      (let ((string
X	     (buffer-substring
X	      (save-excursion (forward-sexp -1) (point)) (point))))
X	(save-excursion
X	  (save-window-excursion
X	    (pop-to-buffer gnus-Subject-buffer)
X	    (eval (car (read-from-string string))))))
X    (ding) (message "No newsgroup is selected.")))
X
X(defun gnus-Kill-file-exit ()
X  "Save a KILL file, then return to the previous buffer."
X  (interactive)
X  (save-buffer)
X  (let ((killbuf (current-buffer)))
X    ;; We don't want to return to Article buffer.
X    (and (get-buffer gnus-Article-buffer)
X	 (bury-buffer (get-buffer gnus-Article-buffer)))
X    ;; Delete the KILL file windows.
X    (delete-windows-on killbuf)
X    ;; Restore last window configuration if available.
X    (and gnus-winconf-kill-file
X	 (set-window-configuration gnus-winconf-kill-file))
X    (setq gnus-winconf-kill-file nil)
X    ;; Kill the KILL file buffer.  Suggested by tale@pawl.rpi.edu.
X    (kill-buffer killbuf)))
X
X
X;;;
X;;; Utility functions
X;;;
X
X;; Basic ideas by emv@math.lsa.umich.edu (Edward Vielmetti)
X
X(defun gnus-batch-kill ()
X  "Run batched KILL.
XUsage: emacs -batch -l gnus -f gnus-batch-kill NEWSGROUP ..."
X  (if (not noninteractive)
X      (error "gnus-batch-kill is to be used only with -batch"))
X  (let* ((group nil)
X	 (subscribed nil)
X	 (newsrc nil)
X	 (yes-and-no
X	  (gnus-parse-n-options
X	   (apply (function concat)
X		  (mapcar (function (lambda (g) (concat g " ")))
X			  command-line-args-left))))
X	 (yes (car yes-and-no))
X	 (no  (cdr yes-and-no))
X	 ;; Disable verbose message.
X	 (gnus-novice-user nil)
X	 (gnus-large-newsgroup nil)
X	 (nntp-large-newsgroup nil))
X    ;; Eat all arguments.
X    (setq command-line-args-left nil)
X    ;; Startup GNUS.
X    (gnus)
X    ;; Apply kills to specified newsgroups in command line arguments.
X    (setq newsrc (copy-sequence gnus-newsrc-assoc))
X    (while newsrc
X      (setq group (car (car newsrc)))
X      (setq subscribed (nth 1 (car newsrc)))
X      (setq newsrc (cdr newsrc))
X      (if (and subscribed
X	       (not (zerop (nth 1 (gnus-gethash group gnus-unread-hashtb))))
X	       (if yes
X		   (string-match yes group) t)
X	       (or (null no)
X		   (not (string-match no group))))
X	  (progn
X	    (gnus-Subject-read-group group nil t)
X	    (if (eq (current-buffer) (get-buffer gnus-Subject-buffer))
X		(gnus-Subject-exit t))
X	    ))
X      )
X    ;; Finally, exit Emacs.
X    (set-buffer gnus-Group-buffer)
X    (gnus-Group-exit)
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:' and `Re^N:'.
X    (if (string-match "\\`\\(re\\(\\^[0-9]+\\)?:[ \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 'norecord)
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 Id in HEADER."
X  (nntp-header-id header))
X
X(defun gnus-header-references (header)
X  "Return references in HEADER."
X  (nntp-header-references 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    ;; Convert article directly into Babyl format.
X    ;; Suggested by Rob Austein <sra@lcs.mit.edu>
X    (goto-char (point-min))
X    (insert "\^L\n0, unseen,,\n*** EOOH ***\n")
X    (while (search-forward "\n\^_" nil t) ;single char
X      (replace-match "\n^_"))		;2 chars: "^" and "_"
X    (goto-char (point-max))
X    (insert "\^_")))
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;;    ;; Stop quoting `From' since this seems unnecessary in most cases.
X;;    ;; ``Quote'' "\nFrom " as "\n>From "
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.
XRun gnus-Open-server-hook just before opening news server."
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    (run-hooks 'gnus-Open-server-hook)
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 &optional access-methods)
X  "Define access functions for the access METHOD.
XMethods defintion is taken from optional argument ACCESS-METHODS or
Xthe variable gnus-access-methods."
X  (let ((bindings
X	 (cdr (assoc method (or access-methods gnus-access-methods)))))
X    (if (null bindings)
X	(error "Unknown access method: %s" method)
X      ;; Should not use symbol-function here since overload does not work.
X      (while bindings
X	(fset (car (car bindings)) (cdr (car bindings)))
X	(setq bindings (cdr bindings)))
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 (gnus-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	;; Require confirmation if selecting large newsgroup.
X	(setq gnus-newsgroup-unselected nil)
X	(if (not (numberp gnus-large-newsgroup))
X	    nil
X	  (let ((selected nil)
X		(number (length articles)))
X	    (if (> number gnus-large-newsgroup)
X		(progn
X		  (condition-case ()
X		      (let ((input
X			     (read-string
X			      (format
X			       "How many articles from %s (default %d): "
X			       gnus-newsgroup-name number))))
X			(setq selected
X			      (if (string-equal input "")
X				  number (string-to-int input))))
X		    (quit
X		     (setq selected 0)))
X		  (cond ((and (> selected 0)
X			      (< selected number))
X			 ;; Select last N articles.
X			 (setq articles (nthcdr (- number selected) articles)))
X			((and (< selected 0)
X			      (< (- 0 selected) number))
X			 ;; Select first N articles.
X			 (setq selected (- 0 selected))
X			 (setq articles (copy-sequence articles))
X			 (setcdr (nthcdr (1- selected) articles) nil))
X			((zerop selected)
X			 (setq articles nil))
X			;; Otherwise select all.
X			)
X		  ;; Get unselected unread articles.
X		  (setq gnus-newsgroup-unselected
X			(gnus-set-difference gnus-newsgroup-unreads articles))
X		  ))
X	    ))
X	;; Get headers list.
X	(setq gnus-newsgroup-headers (gnus-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 (append gnus-newsgroup-unselected
X					 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-rmail nil)
X	(setq gnus-newsgroup-last-mail nil)
X	(setq gnus-newsgroup-last-folder nil)
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-more-header-backward ()
X  "Find new header backward."
X  (let ((first
X	 (car (nth 2 (gnus-gethash gnus-newsgroup-name gnus-active-hashtb))))
X	(artnum gnus-newsgroup-begin)
X	(header nil))
X    (while (and (not header)
X		(> artnum first))
X      (setq artnum (1- artnum))
X      (setq header (car (gnus-retrieve-headers (list artnum)))))
X    header
X    ))
X
X(defun gnus-more-header-forward ()
X  "Find new header forward."
X  (let ((last
X	 (cdr (nth 2 (gnus-gethash gnus-newsgroup-name gnus-active-hashtb))))
X	(artnum gnus-newsgroup-end)
X	(header nil))
X    (while (and (not header)
X		(< artnum last))
X      (setq artnum (1+ artnum))
X      (setq header (car (gnus-retrieve-headers (list artnum)))))
X    header
X    ))
X
X(defun gnus-extend-newsgroup (header &optional backward)
X  "Extend newsgroup selection with HEADER.
XOptional argument BACKWARD means extend toward backward."
X  (if header
X      (let ((artnum (nntp-header-number header)))
X	(setq gnus-newsgroup-headers
X	      (if backward
X		  (cons header gnus-newsgroup-headers)
X		(append gnus-newsgroup-headers (list header))))
X	;; We have to update unreads and unselected, but don't have to
X	;; care about gnus-newsgroup-marked.
X	(if (memq artnum gnus-newsgroup-unselected)
X	    (setq gnus-newsgroup-unreads
X		  (cons artnum gnus-newsgroup-unreads)))
X	(setq gnus-newsgroup-unselected
X	      (delq artnum gnus-newsgroup-unselected))
X	(setq gnus-newsgroup-begin (min gnus-newsgroup-begin artnum))
X	(setq gnus-newsgroup-end (max gnus-newsgroup-end artnum))
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 GNUS variables.
X  (let ((variables gnus-variable-list))
X    (while variables
X      (set (car variables) nil)
X      (setq variables (cdr variables))))
X  ;; Clear other internal variables.
X  (setq gnus-active-hashtb nil)
X  (setq gnus-unread-hashtb nil)
X  ;; Kill the startup file.
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 GNUS buffers.
X  (let ((buffers gnus-buffer-list))
X    (while buffers
X      (if (get-buffer (car buffers))
X	  (kill-buffer (car buffers)))
X      (setq buffers (cdr buffers))
X      )))
X
X(defun gnus-configure-windows (action)
X  "Configure GNUS windows according to the next ACTION.
XThe ACTION is either a symbol, such as `SelectNewsgroup', or a
Xconfiguration list such as `(1 1 2)'.  If ACTION is not a list,
Xconfiguration list is got from the variable gnus-window-configuration."
X  (let* ((windows
X	  (if (listp action)
X	      action (car (cdr (assq action gnus-window-configuration)))))
X	 (grpwin (get-buffer-window gnus-Group-buffer))
X	 (subwin (get-buffer-window gnus-Subject-buffer))
X	 (artwin (get-buffer-window gnus-Article-buffer))
X	 (winsum nil)
X	 (height nil)
X	 (grpheight 0)
X	 (subheight 0)
X	 (artheight 0))
X    (if (or (null windows)		;No configuration is specified.
X	    (and (eq (null grpwin)
X		     (zerop (nth 0 windows)))
X		 (eq (null subwin)
X		     (zerop (nth 1 windows)))
X		 (eq (null artwin)
X		     (zerop (nth 2 windows)))))
X	;; No need to change window configuration.
X	nil
X      (select-window (or grpwin subwin artwin (selected-window)))
X      ;; First of all, compute the height of each window.
X      (cond (gnus-use-full-window
X	     ;; Take up the entire screen.
X	     (delete-other-windows)
X	     (setq height (window-height (selected-window))))
X	    (t
X	     (setq height (+ (if grpwin (window-height grpwin) 0)
X			     (if subwin (window-height subwin) 0)
X			     (if artwin (window-height artwin) 0)))))
X      ;; The Newsgroup buffer exits always. So, use it to extend the
X      ;; Group window so as to get enough window space.
X      (switch-to-buffer gnus-Group-buffer 'norecord)
X      (and (get-buffer gnus-Subject-buffer)
X	   (delete-windows-on gnus-Subject-buffer))
X      (and (get-buffer gnus-Article-buffer)
X	   (delete-windows-on gnus-Article-buffer))
X      ;; Compute expected window height.
X      (setq winsum (apply (function +) windows))
X      (if (not (zerop (nth 0 windows)))
X	  (setq grpheight (max window-min-height
X			       (/ (* height (nth 0 windows)) winsum))))
X      (if (not (zerop (nth 1 windows)))
X	  (setq subheight (max window-min-height
X			       (/ (* height (nth 1 windows)) winsum))))
X      (if (not (zerop (nth 2 windows)))
X	  (setq artheight (max window-min-height
X			       (/ (* height (nth 2 windows)) winsum))))
X      (setq height (+ grpheight subheight artheight))
X      (enlarge-window (max 0 (- height (window-height (selected-window)))))
X      ;; Then split the window.
X      (and (not (zerop artheight))
X	   (or (not (zerop grpheight))
X	       (not (zerop subheight)))
X	   (split-window-vertically (+ grpheight subheight)))
X      (and (not (zerop grpheight))
X	   (not (zerop subheight))
X	   (split-window-vertically grpheight))
X      ;; Then select buffers in each window.
X      (and (not (zerop grpheight))
X	   (progn
X	     (switch-to-buffer gnus-Group-buffer 'norecord)
X	     (other-window 1)))
X      (and (not (zerop subheight))
X	   (progn
X	     (switch-to-buffer gnus-Subject-buffer 'norecord)
X	     (other-window 1)))
X      (and (not (zerop artheight))
X	   (progn
X	     ;; If Article buffer does not exist, it will be created
X	     ;; and initialized.
X	     (gnus-Article-setup-buffer)
X	     (switch-to-buffer gnus-Article-buffer 'norecord)))
X      )
X    ))
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-find-header-by-id (headers id)
X  "Return a header which is a element of HEADERS and has Message-ID."
X  (let ((found nil))
X    (while (and headers (not found))
X      (if (string-equal id (nntp-header-id (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  (cond ((and (boundp 'mhspool-version) (boundp 'nnspool-version))
X	 (message "%s; %s; %s; %s"
X		  gnus-version nntp-version nnspool-version mhspool-version))
X	((boundp 'mhspool-version)
X	 (message "%s; %s; %s"
X		  gnus-version nntp-version mhspool-version))
X	((boundp 'nnspool-version)
X	 (message "%s; %s; %s"
X		  gnus-version nntp-version nnspool-version))
X	(t
X	 (message "%s; %s" gnus-version nntp-version))))
X
X(defun gnus-Info-find-node ()
X  "Find Info documentation of GNUS."
X  (interactive)
X  (require 'info)
X  ;; Enlarge info window if needed.
X  (cond ((eq major-mode 'gnus-Group-mode)
X	 (gnus-configure-windows '(1 0 0)) ;Take all windows.
X	 (pop-to-buffer gnus-Group-buffer))
X	((eq major-mode 'gnus-Subject-mode)
X	 (gnus-configure-windows '(0 1 0)) ;Take all windows.
X	 (pop-to-buffer gnus-Subject-buffer)))
X  (let ((Info-directory (expand-file-name gnus-Info-directory nil)))
X    (Info-goto-node (cdr (assq major-mode gnus-Info-nodes)))))
X
X(defun gnus-overload-functions (&optional overloads)
X  "Overload functions specified by optional argument OVERLOADS.
XIf nothing is specified, use the variable gnus-overload-functions."
X  (let ((defs nil)
X	(overloads (or overloads gnus-overload-functions)))
X    (while overloads
X      (setq defs (car overloads))
X      (setq overloads (cdr overloads))
X      ;; Load file before overloading function if necessary.  Make
X      ;; sure we cannot use `requre' always.
X      (and (not (fboundp (car defs)))
X	   (car (cdr (cdr defs)))
X	   (load (car (cdr (cdr defs))) nil 'nomessage))
X      (fset (car defs) (car (cdr defs)))
X      )))
X
X(defun gnus-make-threads (newsgroup-headers)
X  "Make conversation threads tree from NEWSGROUP-HEADERS."
X  (let ((headers newsgroup-headers)
X	(h nil)
X	(d nil)
X	(roots nil)
X	(dependencies nil))
X    ;; Make message dependency alist.
X    (while headers
X      (setq h (car headers))
X      (setq headers (cdr headers))
X      ;; Ignore invalid headers.
X      (if (vectorp h)			;Depends on nntp.el.
X	  (progn
X	    ;; Ignore broken references, e.g "<123@a.b.c".
X	    (setq d (and (nntp-header-references h)
X			 (string-match "\\(<[^<>]+>\\)[^>]*$"
X				       (nntp-header-references h))
X			 (gnus-find-header-by-id
X			  newsgroup-headers
X			  (substring (nntp-header-references h)
X				     (match-beginning 1) (match-end 1)))))
X	    ;; Check subject equality.
X	    (or gnus-thread-ignore-subject
X		(null d)
X		(string-equal (gnus-simplify-subject
X			       (nntp-header-subject h) 're)
X			      (gnus-simplify-subject
X			       (nntp-header-subject d) 're))
X		;; H should be a thread root.
X		(setq d nil))
X	    ;; H depends on D.
X	    (setq dependencies
X		  (cons (cons h d) dependencies))
X	    ;; H is a thread root.
X	    (if (null d)
X		(setq roots (cons h roots)))
X	    ))
X      )
X    ;; Make complete threads from the roots.
X    ;; Note: dependencies are in reverse order, but
X    ;; gnus-make-threads-1 processes it in reverse order again.  So,
X    ;; we don't have to worry about it.
X    (mapcar
X     (function
X      (lambda (root)
X	(gnus-make-threads-1 root dependencies))) (nreverse roots))
X    ))
X
X(defun gnus-make-threads-1 (parent dependencies)
X  (let ((children nil)
X	(d nil)
X	(depends dependencies))
X    ;; Find children.
X    (while depends
X      (setq d (car depends))
X      (setq depends (cdr depends))
X      (and (cdr d)
X	   (eq (nntp-header-id parent) (nntp-header-id (cdr d)))
X	   (setq children (cons (car d) children))))
X    ;; Go down.
X    (cons parent
X	  (mapcar
X	   (function
X	    (lambda (child)
X	      (gnus-make-threads-1 child dependencies))) children))
X    ))
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    (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    ))
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 (copy-sequence 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;;;
X;;; Get information about active articles, already read articles, and
X;;;  still unread articles.
X;;;
X
X;; GNUS internal format of gnus-newsrc-assoc and gnus-killed-assoc:
X;; (("general" t (1 . 1))
X;;  ("misc"    t (1 . 10) (12 . 15))
X;;  ("test"  nil (1 . 99)) ...)
X;; GNUS internal format of gnus-marked-assoc:
X;; (("general" 1 2 3)
X;;  ("misc" 2) ...)
X;; GNUS internal format of gnus-active-hashtb:
X;; (("general" t (1 . 1))
X;;  ("misc"    t (1 . 10))
X;;  ("test"  nil (1 . 99)) ...)
X;; GNUS internal format of gnus-unread-hashtb:
X;; (("general" 1 (1 . 1))
X;;  ("misc"   14 (1 . 10) (12 . 15))
X;;  ("test"   99 (1 . 99)) ...)
X
X(defun gnus-setup-news-info (&optional rawfile)
X  "Setup news information.
XIf optional argument RAWFILE is non-nil, force to read raw startup file."
X  (let ((init (not (and gnus-newsrc-assoc
X			gnus-active-hashtb
X			gnus-unread-hashtb
X			(not rawfile)
X			))))
X    ;; We have to clear some variables to re-initialize news info.
X    (if init
X	(setq gnus-newsrc-assoc nil
X	      gnus-active-hashtb nil
X	      gnus-unread-hashtb nil))
X    (if init
X	(gnus-read-newsrc-file rawfile))
X    (gnus-read-active-file)
X    (gnus-expire-marked-articles)
X    (gnus-get-unread-articles)
X    ;; Check new newsgroups and subscribe them.
X    (if init
X	(let ((new-newsgroups (gnus-find-new-newsgroups)))
X	  (while new-newsgroups
X	    (funcall gnus-subscribe-newsgroup-method (car new-newsgroups))
X	    (setq new-newsgroups (cdr new-newsgroups))
X	    )))
X    ))
X
X(defun gnus-subscribe-newsgroup (newsgroup &optional next)
X  "Subscribe new NEWSGROUP.
XIf optional argument NEXT is non-nil, it is inserted before NEXT."
X  (gnus-insert-newsgroup (list newsgroup t) next)
X  (message "Newsgroup %s is subscribed" newsgroup))
X
X(defun gnus-add-newsgroup (newsgroup)
X  "Subscribe new NEWSGROUP safely and put it at top."
X  (and (null (assoc newsgroup gnus-newsrc-assoc)) ;Really new?
X       (gnus-gethash newsgroup gnus-active-hashtb) ;Really exist?
X       (gnus-insert-newsgroup (or (assoc newsgroup gnus-killed-assoc)
X				  (list newsgroup t))
X			      (car (car gnus-newsrc-assoc)))))
X
X(defun gnus-find-new-newsgroups ()
X  "Looking for new newsgroups and return names.
X`-n' option of options line in .newsrc file is recognized."
X  (let ((group nil)
X	(new-newsgroups nil))
X    (mapatoms
X     (function
X      (lambda (sym)
X	(setq group (symbol-name sym))
X	;; Taking account of `-n' option.
X	(and (or (null gnus-newsrc-options-n-no)
X		 (not (string-match gnus-newsrc-options-n-no group))
X		 (and gnus-newsrc-options-n-yes
X		      (string-match gnus-newsrc-options-n-yes group)))
X	     (null (assoc group gnus-killed-assoc)) ;Ignore killed.
X	     (null (assoc group gnus-newsrc-assoc)) ;Really new.
X	     ;; Find new newsgroup.
X	     (setq new-newsgroups
X		   (cons group new-newsgroups)))
X	))
X     gnus-active-hashtb)
X    ;; Return new newsgroups.
X    new-newsgroups
X    ))
X
X(defun gnus-kill-newsgroup (group)
X  "Kill GROUP from gnus-newsrc-assoc, .newsrc and gnus-unread-hashtb."
X  (let ((info (assoc group gnus-newsrc-assoc)))
X    (if (null info)
X	nil
X      ;; Delete from gnus-newsrc-assoc
X      (setq gnus-newsrc-assoc (delq info gnus-newsrc-assoc))
X      ;; Add to gnus-killed-assoc.
X      (setq gnus-killed-assoc
X	    (cons info
X		  (delq (assoc group gnus-killed-assoc) gnus-killed-assoc)))
X      ;; Clear unread hashtable.
X      ;; Thanks cwitty@csli.Stanford.EDU (Carl Witty).
X      (gnus-sethash group nil gnus-unread-hashtb)
X      ;; Then delete from .newsrc
X      (gnus-update-newsrc-buffer group 'delete)
X      ;; Return the deleted newsrc entry.
X      info
X      )))
X
X(defun gnus-insert-newsgroup (info &optional next)
X  "Insert newsrc INFO entry before NEXT.
XIf optional argument NEXT is nil, appended to the last."
X  (if (null info)
X      (error "Invalid argument: %s" info))
X  (let* ((group (car info))		;Newsgroup name.
X	 (range
X	  (gnus-difference-of-range
X	   (nth 2 (gnus-gethash group gnus-active-hashtb)) (nthcdr 2 info))))
X    ;; Check duplication.
X    (if (assoc group gnus-newsrc-assoc)
X	(error "Duplicated: %s" group))
X    ;; Insert to gnus-newsrc-assoc.
X    (if (string-equal next (car (car gnus-newsrc-assoc)))
X	(setq gnus-newsrc-assoc
X	      (cons info gnus-newsrc-assoc))
X      (let ((found nil)
X	    (rest gnus-newsrc-assoc)
X	    (tail (cons nil gnus-newsrc-assoc)))
X	;; Seach insertion point.
X	(while (and (not found) rest)
X	  (if (string-equal next (car (car rest)))
X	      (setq found t)
X	    (setq rest (cdr rest))
X	    (setq tail (cdr tail))
X	    ))
X	;; Find it.
X	(setcdr tail nil)
X	(setq gnus-newsrc-assoc
X	      (append gnus-newsrc-assoc (cons info rest)))
X	))
X    ;; Delete from gnus-killed-assoc.
X    (setq gnus-killed-assoc
X	  (delq (assoc group gnus-killed-assoc) gnus-killed-assoc))
X    ;; Then insert to .newsrc.
X    (gnus-update-newsrc-buffer group nil next)
X    ;; Add to gnus-unread-hashtb.
X    (gnus-sethash group
X		  (cons group		;Newsgroup name.
X			(cons (gnus-number-of-articles range) range))
X		  gnus-unread-hashtb)
X    ))
X
X(defun gnus-check-killed-newsgroups ()
X  "Check consistency between gnus-newsrc-assoc and gnus-killed-assoc."
X  (let ((group nil)
X	(new-killed nil)
X	(old-killed gnus-killed-assoc))
X    (while old-killed
X      (setq group (car (car old-killed)))
X      (and (or (null gnus-newsrc-options-n-no)
SHAR_EOF
echo "End of part 5, continue with part 6"
echo "6" > s2_seq_.tmp
exit 0
--
Masanobu UMEDA
umerin@tc.Nagasaki.GO.JP
