Path: utzoo!attcan!uunet!kddlab!titcca!fgw!flab!umerin
From: umerin@flab.flab.fujitsu.JUNET (Masanobu UMEDA)
Newsgroups: comp.emacs,fj.editor.emacs
Subject: GNUS 3.11: A GNU Emacs newsreader (4 of 9)
Message-ID: <4802@flab.flab.fujitsu.JUNET>
Date: 23 Feb 89 07:20:14 GMT
Reply-To: umerin@flab.flab.fujitsu.JUNET (Masanobu UMEDA)
Followup-To: comp.emacs
Organization: Fujitsu Laboratories Ltd., Kawasaki, Japan.
Lines: 1420

---- Cut Here and unpack ----
#!/bin/sh
# this is part 4 of a multipart archive
# do not concatenate these parts, unpack them in order with /bin/sh
# file gnus.el continued
#
CurArch=4
if test ! -r s2_seq_.tmp
then echo "Please unpack part 1 first!"
     exit 1; fi
( read Scheck
  if test "$Scheck" != $CurArch
  then echo "Please unpack part $Scheck next!"
       exit 1;
  else exit 0; fi
) < s2_seq_.tmp || exit 1
sed 's/^X//' << 'SHAR_EOF' >> gnus.el
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-window-excursion
X    (save-excursion
X      (re-search-forward ">" nil t)	;Move point to end of "<....>".
X      (if (re-search-backward "\\(<[^<> \t\n]+>\\)" nil t)
X	  (let ((message-id
X		 (buffer-substring (match-beginning 1) (match-end 1))))
X	    (set-buffer gnus-Subject-buffer)
X	    (gnus-Subject-refer-article message-id))
X	(message "No references around point"))
X      )))
X
X(defun gnus-Article-pop-article ()
X  "Pop up article history."
X  (interactive)
X  (save-window-excursion
X    (set-buffer gnus-Subject-buffer)
X    (gnus-Subject-refer-article nil)))
X
X(defun gnus-Article-show-subjects ()
X  "Reconfigure windows 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(defun gnus-Article-describe-briefly ()
X  "Describe Article mode commands briefly."
X  (interactive)
X  (message
X   (concat
X    (substitute-command-keys "\\[gnus-Article-next-page]:Next page  ")
X    (substitute-command-keys "\\[gnus-Article-prev-page]:Prev page  ")
X    (substitute-command-keys "\\[gnus-Article-show-subjects]:Show headers  ")
X    (substitute-command-keys "\\[gnus-Info-find-node]:Run Info  ")
X    (substitute-command-keys "\\[gnus-Article-describe-briefly]:This help")
X    )))
X
X
X;;;
X;;; GNUS Kill file mode
X;;;
X
X(if gnus-Kill-file-mode-map
X    nil
X  (setq gnus-Kill-file-mode-map (copy-keymap emacs-lisp-mode-map))
X  (define-key gnus-Kill-file-mode-map "\C-c\C-s" 'save-buffer)
X  (define-key gnus-Kill-file-mode-map "\C-c\C-c" 'gnus-Kill-file-exit)
X  (define-key gnus-Kill-file-mode-map "\C-c\C-i" 'gnus-Info-find-node))
X
X(defun gnus-Kill-file-mode ()
X  "Major mode for editing KILL file.
X
XIn addition to Emacs-Lisp Mode, the following commands are available:
X
X\\[save-buffer]	Save current KILL file.
X\\[gnus-Kill-file-exit]	Exit editing KILL file.
X\\[gnus-Info-find-node]	Read Info about KILL file.
X
X  A KILL file contains lisp expressions to be applied to a selected
Xnewsgroup. The purpose is to mark articles as read on the basis of
Xsome set of regexps. A global KILL file is applied to every newsgroup,
Xand a local KILL file is applied to a specified newsgroup. Since a
Xglobal KILL file is applied to every newsgroup, for better performance
Xuse a local one.
X
X  A KILL file can contain any kind of Emacs lisp expressions expected
Xto be evaluated in the Subject buffer. Writing lisp programs for this
Xpurpose is not so easy because the internal working of GNUS must be
Xwell-known. For this reason, GNUS provides a general function which
Xdoes this easily for non-Lisp programmers.
X
X  The `gnus-kill' function executes commands available in Subject Mode
Xby their key sequences. `gnus-kill' should be called with FIELD,
XREGEXP and optional COMMAND. FIELD is a string representing the header
Xfield or an empty string. If FIELD is an empty string, the entire
Xarticle body is searched for. REGEXP is a string which is compared
Xwith FIELD value. COMMAND is a string representing a valid key
Xsequence in Subject Mode or Lisp expression. COMMAND is default to
X'(gnus-Subject-mark-as-read nil \"X\"). Make sure that COMMAND is
Xexecuted in the Subject buffer.
X
X  For example, if you want to mark articles of which subjects contain
Xthe string `AI' as read, a possible KILL file may look like:
X
X	(gnus-kill \"Subject\" \"AI\")
X
X  If you want to mark articles with `D' instead of `X', you can use
Xthe following expression:
X
X	(gnus-kill \"Subject\" \"AI\" \"d\")
X
XIn this example it is assumed that the command
X`gnus-Subject-mark-as-read-forward' is assigned to `d' in Subject Mode.
X
X  It is possible to delete unnecessary headers which are marked with
X`X' in a KILL file as follows:
X
X	(gnus-Subject-delete-marked-with \"X\")
X
X  If the Subject buffer is empty after applying KILL files, GNUS will
Xexit the selected newsgroup normally.  If headers which are marked
Xwith `D' are deleted in a KILL file, it is impossible to read articles
Xwhich are marked as read in the previous GNUS sessions.  Marks other
Xthan `D' should be used for articles which should really be deleted.
X
XEntry to this mode calls emacs-lisp-mode-hook and
Xgnus-Kill-file-mode-hook with no arguments, if that value is non-nil."
X  (interactive)
X  (kill-all-local-variables)
X  (use-local-map gnus-Kill-file-mode-map)
X  (set-syntax-table emacs-lisp-mode-syntax-table)
X  (setq major-mode 'gnus-Kill-file-mode)
X  (setq mode-name "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 (file)
X  "Edit a 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 a KILL file, then return to the previous buffer."
X  (interactive)
X  (let ((killbuf (current-buffer)))
X    (save-buffer)
X    (bury-buffer)
X    ;; Kill the KILL file buffer.
X    ;; Suggested by tale@pawl.rpi.edu.
X    (kill-buffer killbuf)))
X
X(defun gnus-Kill-file-name (&optional global)
X  "Return the name of a local KILL file.
XIf optional argument GLOBAL is non-nil, return a global KILL file instead."
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 the current newsgroup."
X  ;; Apply the global KILL file.
X  (load (gnus-Kill-file-name t) t nil t)
X  ;; And then apply the local KILL file.
X  (load (gnus-Kill-file-name nil) t nil t))
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 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    (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	  (delete-region from to)
X	  (insert str)))))
X
X;; Functions accessing headers.
X;; Functions are more convenient than macros in some case.
X
X(defun gnus-header-number (header)
X  "Return article number in HEADER."
X  (nntp-header-number header))
X
X(defun gnus-header-subject (header)
X  "Return subject string in HEADER."
X  (nntp-header-subject header))
X
X(defun gnus-header-from (header)
X  "Return author string in HEADER."
X  (nntp-header-from header))
X
X(defun gnus-header-xref (header)
X  "Return xref string in HEADER."
X  (nntp-header-xref header))
X
X(defun gnus-header-lines (header)
X  "Return lines in HEADER."
X  (nntp-header-lines header))
X
X(defun gnus-header-date (header)
X  "Return date in HEADER."
X  (nntp-header-date header))
X
X(defun gnus-header-id (header)
X  "Return date in HEADER."
X  (nntp-header-id header))
X
X
X;;;
X;;; Article savers.
X;;;
X
X(defun gnus-output-to-rmail (file-name)
X  "Append the current article to an Rmail file named FILE-NAME."
X  (require 'rmail)
X  ;; Most of these codes are borrowed from rmailout.el.
X  (setq file-name (expand-file-name file-name))
X  (setq rmail-last-rmail-file file-name)
X  (let ((artbuf (current-buffer))
X	(tmpbuf (get-buffer-create " *GNUS-output*")))
X    (save-excursion
X      (or (get-file-buffer file-name)
X	  (file-exists-p file-name)
X	  (if (yes-or-no-p
X	       (concat "\"" file-name "\" does not exist, create it? "))
X	      (let ((file-buffer (create-file-buffer file-name)))
X		(save-excursion
X		  (set-buffer file-buffer)
X		  (rmail-insert-rmail-file-header)
X		  (let ((require-final-newline nil))
X		    (write-region (point-min) (point-max) file-name t 1)))
X		(kill-buffer file-buffer))
X	    (error "Output file does not exist")))
X      (set-buffer tmpbuf)
X      (buffer-flush-undo (current-buffer))
X      (erase-buffer)
X      (insert-buffer-substring artbuf)
X      (gnus-convert-article-to-rmail)
X      ;; Decide whether to append to a file or to an Emacs buffer.
X      (let ((outbuf (get-file-buffer file-name)))
X	(if (not outbuf)
X	    (append-to-file (point-min) (point-max) file-name)
X	  ;; File has been visited, in buffer OUTBUF.
X	  (set-buffer outbuf)
X	  (let ((buffer-read-only nil)
X		(msg (and (boundp 'rmail-current-message)
X			  rmail-current-message)))
X	    ;; If MSG is non-nil, buffer is in RMAIL mode.
X	    (if msg
X		(progn (widen)
X		       (narrow-to-region (point-max) (point-max))))
X	    (insert-buffer-substring tmpbuf)
X	    (if msg
X		(progn
X		  (goto-char (point-min))
X		  (widen)
X		  (search-backward "\^_")
X		  (narrow-to-region (point) (point-max))
X		  (goto-char (1+ (point-min)))
X		  (rmail-count-new-messages t)
X		  (rmail-show-message msg))))))
X      )
X    (kill-buffer tmpbuf)
X    ))
X
X(defun gnus-output-to-file (file-name)
X  "Append the current article to a file named FILE-NAME."
X  (setq file-name (expand-file-name file-name))
X  (let ((artbuf (current-buffer))
X	(tmpbuf (get-buffer-create " *GNUS-output*")))
X    (save-excursion
X      (set-buffer tmpbuf)
X      (buffer-flush-undo (current-buffer))
X      (erase-buffer)
X      (insert-buffer-substring artbuf)
X      ;; Append newline at end of the buffer as separator, and then
X      ;; save it to file.
X      (goto-char (point-max))
X      (insert "\n")
X      (append-to-file (point-min) (point-max) file-name))
X    (kill-buffer tmpbuf)
X    ))
X
X(defun gnus-convert-article-to-rmail ()
X  "Convert article in current buffer to Rmail message format."
X  (let ((buffer-read-only nil))
X    ;; Insert special header of Unix mail.
X    (goto-char (point-min))
X    (insert "From "
X	    (or (mail-strip-quoted-names (mail-fetch-field "from"))
X		"unknown")
X	    " " (current-time-string) "\n")
X    ;; ``Quote'' "\nFrom " as "\n>From "
X    ;;  (note that this isn't really quoting, as there is no requirement
X    ;;   that "\n[>]+From " be quoted in the same transparent way.)
X    (while (search-forward "\nFrom " nil t)
X      (forward-char -5)
X      (insert ?>))
X    ;; Convert article to babyl format.
X    (rmail-convert-to-babyl-format)
X    ))
X
X
X;;;
X;;; 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    ;; Note: 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	;; 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 (default %d): " 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 (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 (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-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 internal variables.
X  (setq gnus-newsrc-options nil)
X  (setq gnus-newsrc-options-n-yes nil)
X  (setq gnus-newsrc-options-n-no nil)
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 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  (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  (cond ((and (boundp 'mhspool-version)
X	      (boundp 'nnspool-version))
X	 (message "%s; %s; %s; %s."
X		  gnus-version nntp-version nnspool-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  (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-rebind-functions ()
X  "Replace functions defined in rnews.el and rnewspost.el."
X  ;; Override news-inews function in rnewspost.el.
X  (fset 'news-inews (symbol-function 'gnus-inews))
X  ;; Override caesar-region function in rnews.el.
X  (fset 'caesar-region (symbol-function '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 (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:
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 force)
X  "Setup news information.
XIf optional argument FORCE is non-nil, initialize completely."
X  (let ((init (not (and gnus-newsrc-assoc
X			gnus-active-hashtb
X			gnus-unread-hashtb
X			(not force)))))
X    (if init
X	(gnus-read-newsrc-file))
X    (gnus-read-active-file)
X    (if init
X	(gnus-add-new-newsgroups))
X    (gnus-expire-marked-articles)
X    (gnus-get-unread-articles)
X    ))
X
X(defun gnus-make-newsrc-file (file)
X  "Make server dependent file name by catenating FILE and server host name."
X  (let* ((file (expand-file-name file nil))
X	 (real-file (concat file "-" gnus-nntp-server)))
X    (if (file-exists-p real-file)
X	real-file file)
X    ))
X
X(defun gnus-get-unread-articles ()
X  "Compute diffs between active and read articles."
X  (let ((read gnus-newsrc-assoc)
X	(group-info nil)
X	(group-name nil)
X	(active nil)
X	(range nil))
X    (message "Checking new news...")
X    (or gnus-unread-hashtb
X	(setq gnus-unread-hashtb (gnus-make-hashtable)))
X    (while read
X      (setq group-info (car read))	;About one newsgroup
X      (setq group-name (car group-info))
X      (setq active (nth 2 (gnus-gethash group-name gnus-active-hashtb)))
X      (if (and gnus-octive-hashtb
X	       ;; Is nothing changed?
X	       (equal active
X		      (nth 2 (gnus-gethash group-name gnus-octive-hashtb)))
X	       ;; Is this newsgroup in the unread hash table?
X	       (gnus-gethash group-name gnus-unread-hashtb)
X	       )
X	  nil				;Nothing to do.
X	(setq range (gnus-difference-of-range active (nthcdr 2 group-info)))
X	(gnus-sethash group-name
X		      (cons group-name	;Group name
X			    (cons (gnus-number-of-articles range)
X				  range)) ;Range of unread articles
X		      gnus-unread-hashtb)
X	)
X      (setq read (cdr read))
X      )
X    (message "Checking new news... done")
X    ))
X
X(defun gnus-expire-marked-articles ()
X  "Check expired article which is marked as unread."
X  (let ((marked-assoc gnus-marked-assoc)
X	(updated-assoc nil)
X	(marked nil)			;Current marked info.
X	(articles nil)			;List of marked articles.
X	(updated nil)			;List of real marked.
X	(begin nil))
X    (while marked-assoc
X      (setq marked (car marked-assoc))
X      (setq articles (cdr marked))
X      (setq updated nil)
X      (setq begin
X	    (car (nth 2 (gnus-gethash (car marked) gnus-active-hashtb))))
X      (while (and begin articles)
X	(if (>= (car articles) begin)
X	    ;; This article is still active.
X	    (setq updated (cons (car articles) updated)))
X	(setq articles (cdr articles)))
X      (if updated
X	  (setq updated-assoc
X		(cons (cons (car marked) updated) updated-assoc)))
X      (setq marked-assoc (cdr marked-assoc)))
X    (setq gnus-marked-assoc updated-assoc)
X    ))
X
X(defun gnus-mark-as-read-by-xref (group headers unreads)
X  "Mark as read using cross reference info. of GROUP with HEADERS and UNREADS.
XReturn list of updated newsgroup."
X  (let ((xref-list nil)
X	(header nil)
X	(xrefs nil))			;One Xref: field info.
X    (while headers
X      (setq header (car headers))
X      (if (memq (nntp-header-number header) unreads)
X	  ;; This article is not yet marked as read.
X	  nil
X	(setq xrefs (gnus-parse-xref-field (nntp-header-xref header)))
X	;; For each cross reference info. on one Xref: field.
X	(while xrefs
X	  (let ((xref (car xrefs)))
X	    (or (string-equal group (car xref))	;Ignore this group.
X		(let ((group-xref (assoc (car xref) xref-list)))
X		  (if group-xref
X		      (if (memq (cdr xref) (cdr group-xref))
X			  nil		;Alread marked.
X			(setcdr group-xref (cons (cdr xref) (cdr group-xref))))
X		    ;; Create new assoc entry for GROUP.
X		    (setq xref-list
X			  (cons (list (car xref) (cdr xref)) xref-list)))
X		  )))
X	  (setq xrefs (cdr xrefs))
X	  ))
X      (setq headers (cdr headers)))
X    ;; Mark cross referenced articles as read.
X    (gnus-mark-xrefed-as-read xref-list)
X    ;;(message "%s %s" (prin1-to-string unreads) (prin1-to-string xref-list))
X    ;; Return list of updated group name.
X    (mapcar (function car) xref-list)
X    ))
X
X(defun gnus-parse-xref-field (xref-value)
X  "Parse Xref: field value, and return list of `(group . article-id)'."
X  (let ((xref-list nil)
X	(xref-value (or xref-value "")))
X    ;; Remove server host name.
X    (if (string-match "^[ \t]*[^ \t,]+[ \t,]+\\(.*\\)$" xref-value)
X	(setq xref-value (substring xref-value (match-beginning 1)))
X      (setq xref-value nil))
X    ;; Process each xref info.
X    (while xref-value
X      (if (string-match
X	   "^[ \t,]*\\([^ \t,]+\\):\\([0-9]+\\)[^0-9]*" xref-value)
X	  (progn
X	    (setq xref-list
X		  (cons
X		   (cons
X		    ;; Group name
X		    (substring xref-value (match-beginning 1) (match-end 1))
X		    ;; Article-ID
X		    (string-to-int
X		     (substring xref-value (match-beginning 2) (match-end 2))))
X		   xref-list))
X	    (setq xref-value (substring xref-value (match-end 2))))
X	(setq xref-value nil)))
X    ;; Return alist.
X    xref-list
X    ))
X
X(defun gnus-mark-xrefed-as-read (xrefs)
X  "Update unread article information using XREFS alist."
X  (let ((group nil)
X	(idlist nil)
X	(unread nil))
X    (while xrefs
X      (setq group (car (car xrefs)))
X      (setq idlist (cdr (car xrefs)))
X      (setq unread (gnus-uncompress-sequence
X		    (nthcdr 2 (gnus-gethash group gnus-unread-hashtb))))
X      (while idlist
X	(setq unread (delq (car idlist) unread))
X	(setq idlist (cdr idlist)))
X      (gnus-update-unread-articles group unread 'ignore)
X      (setq xrefs (cdr xrefs))
X      )))
X
X(defun gnus-update-unread-articles (group unread-list marked-list)
X  "Update unread articles of GROUP using UNREAD-LIST and MARKED-LIST."
X  (let ((active (nth 2 (gnus-gethash group gnus-active-hashtb)))
X	(unread (gnus-gethash group gnus-unread-hashtb)))
X    (if (or (null active) (null unread))
X	;; Ignore unknown newsgroup.
X	nil
X      ;; Update gnus-unread-hashtb.
X      (if unread-list
X	  (setcdr (cdr unread)
X		  (gnus-compress-sequence unread-list))
X	;; All of the articles are read.
X	(setcdr (cdr unread) '((0 . 0))))
X      ;; Number of unread articles.
X      (setcar (cdr unread)
X	      (gnus-number-of-articles (nthcdr 2 unread)))
X      ;; Update gnus-newsrc-assoc.
X      (if (> (car active) 0)
X	  ;; Articles from 1 to N are not active.
X	  (setq active (cons 1 (cdr active))))
X      (setcdr (cdr (assoc group gnus-newsrc-assoc))
X	      (gnus-difference-of-range active (nthcdr 2 unread)))
X      ;; Update .newsrc buffer.
X      (gnus-update-newsrc-buffer group)
X      ;; Update gnus-marked-assoc.
X      (if (listp marked-list)		;Includes NIL.
X	  (let ((marked (assoc group gnus-marked-assoc)))
X	    (cond (marked
X		   (setcdr marked marked-list))
X		  (marked-list		;Non-NIL.
X		   (setq gnus-marked-assoc
X			 (cons (cons group marked-list)
X			       gnus-marked-assoc)))
X		  )))
X      )))
X
X(defun gnus-compress-sequence (numbers)
X  "Convert list of sorted numbers to ranges."
X  (let* ((numbers (sort (copy-sequence numbers) (function <)))
X	 (first (car numbers))
X	 (last (car numbers))
X	 (result nil))
X    (while numbers
X      (cond ((= last (car numbers)) nil) ;Omit duplicated number
X	    ((= (1+ last) (car numbers)) ;Still in sequence
X	     (setq last (car numbers)))
X	    (t				;End of one sequence
X	     (setq result (cons (cons first last) result))
X	     (setq first (car numbers))
X	     (setq last  (car numbers)))
X	    )
X      (setq numbers (cdr numbers))
X      )
X    (nreverse (cons (cons first last) result))
X    ))
X
X(defun gnus-uncompress-sequence (ranges)
X  "Expand compressed format of sequence."
X  (let ((first nil)
X	(last  nil)
X	(result nil))
X    (while ranges
X      (setq first (car (car ranges)))
X      (setq last  (cdr (car ranges)))
X      (while (< first last)
X	(setq result (cons first result))
X	(setq first (1+ first)))
X      (setq result (cons first result))
X      (setq ranges (cdr ranges))
X      )
X    (nreverse result)
X    ))
X
X(defun gnus-number-of-articles (range)
X  "Compute number of articles from RANGE `((beg1 . end1) (beg2 . end2) ...)'."
X  (let ((count 0))
X    (while range
X      (if (/= (cdr (car range)) 0)
X	  ;; If end1 is 0, it must be skipped. Usually no articles in
X	  ;;  this group.
X	  (setq count (+ count 1 (- (cdr (car range)) (car (car range))))))
X      (setq range (cdr range))
X      )
X    count				;Result
X    ))
X
X(defun gnus-difference-of-range (src obj)
X  "Compute (SRC - OBJ) on range.
XRange of SRC is expressed as `(beg . end)'.
XRange of OBJ is expressed as `((beg1 . end1) (beg2 . end2) ...)."
X  (let ((beg (car src))
X	(end (cdr src))
X	(range nil))			;This is result.
X    ;; Src may be nil.
X    (while (and src obj)
X      (let ((beg1 (car (car obj)))
X	    (end1 (cdr (car obj))))
X	(cond ((> beg end)
X	       (setq obj nil))		;Terminate loop
X	      ((< beg beg1)
X	       (setq range (cons (cons beg (min (1- beg1) end)) range))
X	       (setq beg (1+ end1)))
X	      ((>= beg beg1)
X	       (setq beg (max beg (1+ end1))))
X	      )
X	(setq obj (cdr obj))		;Next OBJ
X	))
X    ;; Src may be nil.
X    (if (and src (<= beg end))
X	(setq range (cons (cons beg end) range)))
X    ;; Result
X    (if range
X	(nreverse range)
X      (list (cons 0 0)))
X    ))
X
X(defun gnus-add-new-newsgroup (newsgroup)
X  "Add one new NEWSGROUP."
X  (if (and (null (assoc group gnus-newsrc-assoc)) ;Really new?
X	   (gnus-gethash newsgroup gnus-active-hashtb))	;Really exist?
X      (let ((range (gnus-difference-of-range
X		    (nth 2 (gnus-gethash newsgroup gnus-active-hashtb)) nil)))
X	;; Add to gnus-newsrc-assoc.
X	(setq gnus-newsrc-assoc
X	      (cons (list newsgroup t) gnus-newsrc-assoc))
X	;; Add to .newsrc.
X	(gnus-update-newsrc-buffer newsgroup)
X	;; Add to gnus-unread-hashtb.
X	(gnus-sethash newsgroup
X		      (cons newsgroup	;Newsgroup name.
X			    (cons (gnus-number-of-articles range) range))
X		      gnus-unread-hashtb)
X	)))
X
X(defun gnus-add-new-newsgroups ()
X  "Add new newsgroups to gnus-newsrc-assoc.
X`-n' option of options line in .newsrc file is recognized."
X  (let ((group nil))
X    (mapatoms
X     (function
X      (lambda (sym)
X	(setq group (symbol-name sym))
X	;; Taking account of `-n' option.
X	(if (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-newsrc-assoc)))
X	    ;; Find new newsgroup.
X	    (progn
X	      (setq gnus-newsrc-assoc
X		    (cons (list group t) gnus-newsrc-assoc))
X	      (gnus-update-newsrc-buffer group)
X	      (message "New newsgroup: %s is subscribed" group)
X	      ))))
X     gnus-active-hashtb)
X    ))
X
X(defun gnus-delete-bogus-newsgroups (&optional confirm)
X  "Delete bogus newsgroups.
XIf optional argument CONFIRM is non-nil, confirm deletion of newsgroups."
X  (let ((group nil)
X	(oldrc gnus-newsrc-assoc)
X	(bogus nil)			;List of bogus newsgroups.
X	(newsrc nil)
X	(marked gnus-marked-assoc)
X	(newmarked nil))
X    (message "Checking bogus newsgroups...")
X    ;; Update gnus-newsrc-assoc.
X    (while oldrc
X      (setq group (car (car oldrc)))
X      (if (or (gnus-gethash group gnus-active-hashtb)
X	      (and confirm
X		   (not (y-or-n-p
X			 (format "Delete bogus newsgroup: %s " group)))))
X	  ;; Active newsgroup.
X	  (setq newsrc (cons (car oldrc) newsrc))
X	;; Found a bogus newsgroup.
X	(setq bogus (cons group bogus)))
X      (setq oldrc (cdr oldrc))
X      )
X    (setq gnus-newsrc-assoc (nreverse newsrc))
X    ;; Remove from .newsrc file.
X    (while bogus
X      (gnus-update-newsrc-buffer (car bogus) 'delete)
X      (setq bogus (cdr bogus)))
X    ;; Update gnus-marked-assoc.
X    (while marked
X      (setq group (car (car marked)))
X      (if (and (cdr (car marked))	;Non-empty?
X	       (assoc group gnus-newsrc-assoc))	;Not bogus?
X	  (setq newmarked (cons (car marked) newmarked)))
X      (setq marked (cdr marked)))
X    (setq gnus-marked-assoc newmarked)
X    (message "Checking bogus newsgroups... done")
X    ))
X
X(defun gnus-read-active-file ()
X  "Get active file from NNTP server."
X  (message "Reading active file...")
X  (if (nntp-request-list)		;Get active file from server
X      (save-excursion
X	(set-buffer nntp-server-buffer)
X	;; Save OLD active info.
X	(setq gnus-octive-hashtb gnus-active-hashtb)
X	(setq gnus-active-hashtb (gnus-make-hashtable))
X	(gnus-active-to-gnus-format)
X	(message "Reading active file... done"))
X    (error "Cannot read active file from NNTP server.")))
X
X(defun gnus-active-to-gnus-format ()
X  "Convert active file format to internal format."
X  ;; Delete unnecessary lines.
X  (goto-char (point-min))
X  (delete-matching-lines "^to\\..*$")
X  ;; Store active file in hashtable.
X  (goto-char (point-min))
X  (while
X      (re-search-forward
X       "^\\([^ \t]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([ymn]\\).*$"
X       nil t)
X    (gnus-sethash
X     (buffer-substring (match-beginning 1) (match-end 1))
X     (list (buffer-substring (match-beginning 1) (match-end 1))
X	   (string-equal
X	    "y" (buffer-substring (match-beginning 4) (match-end 4)))
X	   (cons (string-to-int
X		  (buffer-substring (match-beginning 3) (match-end 3)))
X		 (string-to-int
X		  (buffer-substring (match-beginning 2) (match-end 2)))))
X     gnus-active-hashtb)
X    ))
X
X(defun gnus-read-newsrc-file (&optional rawfile)
X  "Read in the startup FILE.
XIf optional argument RAWFILE is non-nil, the raw startup file is read."
X  (setq gnus-current-startup-file (gnus-make-newsrc-file gnus-startup-file))
X  ;; Reset variables.
X  (setq gnus-newsrc-options nil)
X  (setq gnus-newsrc-options-n-yes nil)
X  (setq gnus-newsrc-options-n-no nil)
X  (setq gnus-newsrc-assoc nil)
X  (setq gnus-marked-assoc nil)
X  (let* ((newsrc-file gnus-current-startup-file)
X	 (quick-file (concat newsrc-file ".el"))
X	 (quick-loaded nil)
X	 (newsrc-mod (nth 5 (file-attributes newsrc-file)))
X	 (quick-mod (nth 5 (file-attributes quick-file))))
X    (save-excursion
X      ;; Prepare .newsrc buffer.
X      (set-buffer (find-file-noselect newsrc-file))
X      ;; It is not so good idea turning off undo.
X      ;;(buffer-flush-undo (current-buffer))
X      ;; Load quick .newsrc to restore gnus-marked-assoc even if
X      ;; gnus-newsrc-assoc is out of date.
X      (condition-case nil
X	  (setq quick-loaded (load quick-file t t t))
X	(error nil))
X      (cond ((and (not rawfile)		;Not forced to read the raw file.
X		  (or (and (fboundp 'file-newer-than-file-p)
X			   (file-newer-than-file-p quick-file newsrc-file))
X		      (and newsrc-mod quick-mod
X			   ;; .newsrc.el is newer than .newsrc.
X			   ;; Some older version does not support function
X			   ;; `file-newer-than-file-p'.
X			   (or (< (car newsrc-mod) (car quick-mod))
X			       (and (= (car newsrc-mod) (car quick-mod))
X				    (<= (nth 1 newsrc-mod) (nth 1 quick-mod))))
X			   ))
X		  quick-loaded
X		  gnus-newsrc-assoc	;Really loaded?
X		  )
X	     ;; We don't have to read the raw startup file.
X	     )
X	    (t
X	     ;; Since .newsrc file is newer than quick file, read it.
SHAR_EOF
echo "End of part 4, continue with part 5"
echo "5" > s2_seq_.tmp
exit 0