Path: utzoo!attcan!uunet!kddlab!ccut!ascgw!fgw!flab!umerin
From: umerin@flab.flab.fujitsu.JUNET (Masanobu UMEDA)
Newsgroups: comp.emacs,fj.editor.emacs
Subject: GNUS 3.10: an NNTP-based newsreader for GNU Emacs (4 of 5)
Message-ID: <4378@flab.flab.fujitsu.JUNET>
Date: 11 Nov 88 06:22:06 GMT
Reply-To: umerin@flab.flab.fujitsu.JUNET (Masanobu UMEDA)
Organization: Fujitsu Laboratories Ltd., Kawasaki, Japan
Lines: 1466

---- 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    ;;   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;;; 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-newsgroup))
X    (gnus-expire-marked-articles)
X    (gnus-get-unread-articles)
X    ))
X
X(defun gnus-make-newsrc-file (file)
X  "Make site 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	       (equal active
X		      (nth 2 (gnus-gethash group-name gnus-octive-hashtb))))
X	  nil				;Nothing changed.
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 (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 ()
X  "Add new newsgroup 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-newsgroup (&optional confirm)
X  "Delete bogus newsgroup.
XIf optional argument CONFIRM is non-nil, confirm deletion of newsgroups."
X  (let ((group nil)
X	(oldrc gnus-newsrc-assoc)
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 bogus newsgroup.
X	(gnus-update-newsrc-buffer group 'delete))
X      (setq oldrc (cdr oldrc))
X      )
X    (setq gnus-newsrc-assoc (nreverse newsrc))
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 ()
X  "Read in .newsrc FILE."
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 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		  quick-loaded
X		  gnus-newsrc-assoc
X		  )
X	     ;; We don't have to read raw startup file.
X	     )
X	    (t
X	     ;; Since .newsrc file is newer than quick file, read it.
X	     (message "Reading %s..." newsrc-file)
X	     (gnus-newsrc-to-gnus-format)
X	     (message "Reading %s... Done" newsrc-file)))
X      )))
X
X(defun gnus-newsrc-to-gnus-format ()
X  "Parse current buffer as .newsrc file."
X  (let ((newsgroup nil)
X	(subscribe nil)
X	(ranges nil)
X	(subrange nil)
X	(read-list nil))
X    ;; We have to re-initialize these variable (except for
X    ;; gnus-marked-assoc) because quick load .newsrc may contain bogus
X    ;; values.
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    ;; Save options line to variable.
X    (goto-char (point-min))
X    (if (re-search-forward "^[ \t]*options[ \t]*\\(.*[^ \t\n]\\)[ \t]*$" nil t)
X	(progn
X	  (setq gnus-newsrc-options
X		(buffer-substring (match-beginning 1) (match-end 1)))
X	  ;; Compile "-n" option.
X	  (if (string-match "\\(^\\|[ \t]\\)-n" gnus-newsrc-options)
X	      (let ((options (substring gnus-newsrc-options (match-end 0)))
X		    (yes nil) (no nil)
X		    (yes-or-no nil)
X		    (newsgroup nil))
X		(while
X		    (string-match
X		     "^[ \t]*\\(!?\\)\\([^--- \t][^ \t]*\\)" options)
X		  (setq yes-or-no
X			(substring options (match-beginning 1) (match-end 1)))
X		  (setq newsgroup
X			(regexp-quote
X			 (substring options
X				    (match-beginning 2) (match-end 2))))
X		  (setq options (substring options (match-end 2)))
X		  (cond ((and (string-equal yes-or-no "!")
X			      (string-equal newsgroup "all"))
X			 (setq no (cons ".*" no)))
X			((string-equal yes-or-no "!")
X			 (setq no (cons newsgroup no)))
X			((string-equal newsgroup "all")) ;Ignore `all'.
X			(t
X			 (setq yes (cons newsgroup yes)))
X			))
X		(if yes
X		    (setq gnus-newsrc-options-n-yes
X			  (concat "^\\("
X				  (apply (function concat)
X					 (mapcar
X					  (function
X					   (lambda (newsgroup)
X					     (concat newsgroup "\\|")))
X					  (cdr yes)))
X				  (car yes) "\\)")))
X		(if no
X		    (setq gnus-newsrc-options-n-no
X			  (concat "^\\("
X				  (apply (function concat)
X					 (mapcar
X					  (function
X					   (lambda (newsgroup)
X					     (concat newsgroup "\\|")))
X					  (cdr no)))
X				  (car no) "\\)")))
X		))
X	  ))
X    ;; Parse body of .newsrc file
X    (goto-char (point-min))
X    (while (re-search-forward
X	    "^[ \t]*\\([^!: \t]+\\)[ \t]*\\([!:]\\)[ \t]*\\(.*\\)$" nil t)
X      (setq newsgroup (buffer-substring (match-beginning 1) (match-end 1)))
X      (setq subscribe
X	    (string-equal
X	     ":" (buffer-substring (match-beginning 2) (match-end 2))))
X      (setq ranges (buffer-substring (match-beginning 3) (match-end 3)))
X      (setq read-list nil)
X      (while (string-match "^[, \t]*\\([0-9-]+\\)" ranges)
X	(setq subrange (substring ranges (match-beginning 1) (match-end 1)))
X	(setq ranges (substring ranges (match-end 1)))
X	(cond ((string-match "^\\([0-9]+\\)-\\([0-9]+\\)$" subrange)
X	       (setq read-list
X		     (cons
X		      (cons (string-to-int
X			     (substring subrange
X					(match-beginning 1) (match-end 1)))
X			    (string-to-int
X			     (substring subrange
X					(match-beginning 2) (match-end 2))))
X		      read-list)))
X	      ((string-match "^[0-9]+$" subrange)
X	       (setq read-list
X		     (cons
X		      (cons (string-to-int subrange) (string-to-int subrange))
X		      read-list)))
X	      (t
X	       (message "Ignoring bogus lines of %s" newsgroup)
X	       (sit-for 0))
X	      ))
X      (setq gnus-newsrc-assoc
X	    (cons (cons newsgroup (cons subscribe (nreverse read-list)))
X		  gnus-newsrc-assoc))
X      )
X    (setq gnus-newsrc-assoc
X	  (nreverse gnus-newsrc-assoc))
X    ))
X
X(defun gnus-save-newsrc-file ()
X  "Save to .newsrc FILE."
X  (if gnus-newsrc-assoc
X      (save-excursion
X	(set-buffer (get-file-buffer gnus-current-startup-file))
X	(if (not (buffer-modified-p))
X	    (message "(No changes need to be saved)")
X	  (message "Saving %s..." gnus-current-startup-file)
X	  (let ((make-backup-files t)
X		(version-control nil)
X		(require-final-newline t)) ;Don't ask even if requested.
X	    ;; Make backup file of master newsrc.
X	    ;; You can stop or change version control of backup file.
X	    ;; Suggested by jason@violet.berkeley.edu.
X	    (run-hooks 'gnus-Save-newsrc-hook)
X	    (save-buffer))
X	  ;; Quickly accessible .newsrc.
X	  (set-buffer (get-buffer-create " *GNUS-newsrc*"))
X	  (buffer-flush-undo (current-buffer))
X	  (erase-buffer)
X	  (gnus-gnus-to-quick-newsrc-format)
X	  (let ((make-backup-files nil)
X		(version-control nil)
X		(require-final-newline t)) ;Don't ask even if requested.
X	    (write-file (concat gnus-current-startup-file ".el")))
X	  (kill-buffer (current-buffer))
X	  (message "Saving %s... Done" gnus-current-startup-file)
X	  ))
X    ))
X
X(defun gnus-update-newsrc-buffer (group &optional delete)
X  "Incrementally update .newsrc buffer about GROUP.
XIf optional argument DELETE is non-nil, delete the group."
X  (save-excursion
X    (set-buffer (get-file-buffer gnus-current-startup-file))
X    ;; Delete old entry.
X    (goto-char (point-min))
X    (if (re-search-forward
X	 (concat "^[ \t]*" (regexp-quote group) "[ \t]*[:!]") nil t)
X	(progn
X	  (beginning-of-line)
X	  (kill-line 1)
X	  ))
X    (if (not delete)
X	(let ((newsrc (assoc group gnus-newsrc-assoc)))
X	  (if newsrc
X	      (progn
X		;; Insert after options line.
X		(if (looking-at "^options[ \t]")
X		    (forward-line 1))
X		(insert group		;Group name
X			(if (nth 1 newsrc) ;Subscribed?
X			    ": " "! "))
X		(gnus-ranges-to-newsrc-format (nthcdr 2 newsrc)) ;Read articles
X		(insert "\n")
X		))
X	  ))
X    ))
X
X(defun gnus-gnus-to-quick-newsrc-format ()
X  "Insert gnus-newsrc-assoc as evaluable format."
X  (insert ";; GNUS internal format of .newsrc file.\n")
X  (insert ";; Touch .newsrc file instead if you think remove this file.\n")
X  ;; Save options line.
X  (if gnus-newsrc-options
X      (insert "(setq gnus-newsrc-options "
X	      (prin1-to-string gnus-newsrc-options)
X	      ")\n"))
X  (if gnus-newsrc-options-n-yes
X      (insert "(setq gnus-newsrc-options-n-yes "
X	      (prin1-to-string gnus-newsrc-options-n-yes)
X	      ")\n"))
X  (if gnus-newsrc-options-n-no
X      (insert "(setq gnus-newsrc-options-n-no "
X	      (prin1-to-string gnus-newsrc-options-n-no)
X	      ")\n"))
X  ;; Save newsrc assoc list.
X  (insert "(setq gnus-newsrc-assoc '"
X	  (prin1-to-string gnus-newsrc-assoc)
X	  ")\n")
X  ;; Save marked assoc list.
X  (insert "(setq gnus-marked-assoc '"
X	  (prin1-to-string gnus-marked-assoc)
X	  ")\n")
X  )
X
X(defun gnus-ranges-to-newsrc-format (ranges)
X  "Insert ranges of read articles."
X  (let ((range nil))			;Range is a pair of BEGIN and END.
X    (while ranges
X      (setq range (car ranges))
X      (setq ranges (cdr ranges))
X      (cond ((= (car range) (cdr range))
X	     (if (= (car range) 0)
X		 (setq ranges nil)	;No unread articles.
X	       (insert (int-to-string (car range)))
X	       (if ranges (insert ","))
X	       ))
X	    (t
X	     (insert (int-to-string (car range))
X		     "-"
X		     (int-to-string (cdr range)))
X	     (if ranges (insert ","))
X	     ))
X      )))
X
X
X;;;
X;;; Post A News using NNTP
X;;;
X
X(defun gnus-news-reply ()
X  "Compose and post a reply (aka a followup) to the current article on USENET.
XWhile composing the followup, use \\[news-reply-yank-original] to yank the
Xoriginal message into it."
X  (interactive)
X  (if (y-or-n-p "Are you sure you want to followup to all of USENET? ")
X      (let (from cc subject date to followup-to newsgroups message-of
X		 references distribution message-id
X		 (buffer (current-buffer)))
X	(save-restriction
X	  (and (not (zerop (buffer-size)))
X	       ;;(equal major-mode 'news-mode)
X	       (equal major-mode 'gnus-Article-mode)
X	       (progn
X		 ;; (news-show-all-headers)
X		 (gnus-Article-show-all-headers)
X		 (narrow-to-region (point-min) (progn (goto-char (point-min))
X						      (search-forward "\n\n")
X						      (- (point) 2)))))
X	  (setq from (mail-fetch-field "from")
X		news-reply-yank-from from
X		subject (mail-fetch-field "subject")
X		date (mail-fetch-field "date")
X		followup-to (mail-fetch-field "followup-to")
X		newsgroups (or followup-to
X			       (mail-fetch-field "newsgroups"))
X		references (mail-fetch-field "references")
X		distribution (mail-fetch-field "distribution")
X		message-id (mail-fetch-field "message-id")
X		news-reply-yank-message-id message-id))
X	(pop-to-buffer "*post-news*")
X	(news-reply-mode)
X	(gnus-rebind-functions)
X	(if (and (buffer-modified-p)
X		 (not (y-or-n-p "Unsent article being composed; erase it? ")))
X	    ;; Continue composition.
X	    nil
X	  (erase-buffer)
X	  (and subject
X	       (setq subject
X		     (concat "Re: " (gnus-simplify-subject subject 're-only))))
X	  (and from
X	       (progn
X		 (let ((stop-pos
X			(string-match "  *at \\|  *@ \\| *(\\| *<" from)))
X		   (setq message-of
X			 (concat
X			  (if stop-pos (substring from 0 stop-pos) from)
X			  "'s message of "
X			  date)))))
X	  (news-setup nil subject message-of newsgroups buffer)
X	  (if followup-to
X	      (progn (news-reply-followup-to)
X		     (insert followup-to)))
X	  (mail-position-on-field "References")
X	  (if references
X	      (insert references))
X	  (if (and references message-id)
X	      (insert " "))
X	  (if message-id
X	      (insert message-id))
X	  ;; Make sure the article is posted by GNUS.
X	  ;;(mail-position-on-field "Posting-Software")
X	  ;;(insert "GNUS: NNTP-based News Reader for GNU Emacs")
X	  ;; Insert Distribution: field.
X	  ;; Suggested by ichikawa@flab.fujitsu.junet.
X	  (mail-position-on-field "Distribution")
X	  (insert (or distribution gnus-default-distribution ""))
X	  (goto-char (point-max))))
X    (message "")))
X
X(defun gnus-post-news ()
X  "Begin editing a new USENET news article to be posted.
X
XType \\[describe-mode] once editing the article to get a list of commands."
X  (interactive)
X  (if (y-or-n-p "Are you sure you want to post to all of USENET? ")
X      (let ((buffer (current-buffer))
X	    (subject nil)
X	    (newsgroups nil)
X	    (distribution nil))
X	(save-restriction
X	  (and (not (zerop (buffer-size)))
X	       ;;(equal major-mode 'news-mode)
X	       (equal major-mode 'gnus-Article-mode)
X	       (progn
X		 ;;(news-show-all-headers)
X		 (gnus-Article-show-all-headers)
X		 (narrow-to-region (point-min) (progn (goto-char (point-min))
X						      (search-forward "\n\n")
X						      (- (point) 2)))))
X	  (setq news-reply-yank-from (mail-fetch-field "from")
X		news-reply-yank-message-id (mail-fetch-field "message-id")))
X	(pop-to-buffer "*post-news*")
X	(news-reply-mode)
X	(gnus-rebind-functions)
X	(if (and (buffer-modified-p)
X		 (not (y-or-n-p "Unsent article being composed; erase it? ")))
X	    ;; Continue composition.
X	    nil
X	  ;; Ask newsgroups, subject and distribution if novice.
X	  ;; Suggested by yuki@flab.fujitsu.junet.
X	  (if gnus-novice-user
X	      (progn
X		;; Subscribed newsgroup names are required for
X		;; completing read of newsgroup.
X		(or gnus-newsrc-assoc
X		    (gnus-read-newsrc-file))
X		;; Which do you like? (UMERIN)
X		;; (setq newsgroups (read-string "Newsgroups: " "general"))
X		(setq newsgroups
X		      (completing-read "Newsgroup: " gnus-newsrc-assoc
X				       nil 'require-match))
X		(setq subject (read-string "Subject: "))
X		(setq distribution
X		      (substring newsgroups 0 (string-match "\\." newsgroups)))
X		(if (string-equal distribution newsgroups)
X		    ;; Newsgroup may be general or control. In this
X		    ;; case, use default distribution.
X		    (setq distribution gnus-default-distribution))
X		(setq distribution
X		      (read-string "Distribution: " distribution))
X		(if (string-equal distribution "")
X		    (setq distribution nil))
X		))
X	  (erase-buffer)
X	  (news-setup () subject () newsgroups buffer)
X	  ;; Make sure the article is posted by GNUS.
X	  ;;(mail-position-on-field "Posting-Software")
X	  ;;(insert "GNUS: NNTP-based News Reader for GNU Emacs")
X	  ;; Insert Distribution: field.
X	  ;; Suggested by ichikawa@flab.fujitsu.junet.
X	  (mail-position-on-field "Distribution")
X	  (insert (or distribution gnus-default-distribution ""))
X	  (goto-char (point-max))))
X    (message "")))
X
X(defun gnus-inews ()
X  "Send a news message using NNTP."
X  (interactive)
X  (let* (newsgroups
X	 subject
X	 (case-fold-search nil)
X	 (server-running (nntp-server-opened)))
X    (save-excursion
X      ;; It is possible to post a news without reading news using
X      ;;  `gnus' before.
X      ;; Suggested by yuki@flab.fujitsu.junet.
X      (gnus-start-news-server)		;Use default NNTP server.
X      ;; NNTP server must be opened before current buffer is modified.
X      (save-restriction
X	(goto-char (point-min))
X	(search-forward (concat "\n" mail-header-separator "\n"))
X	(narrow-to-region (point-min) (point))
X	(setq newsgroups (mail-fetch-field "newsgroups")
X	      subject (mail-fetch-field "subject")))
X      (widen)
X      (goto-char (point-min))
X      (run-hooks 'news-inews-hook)
X      (goto-char (point-min))
X      (search-forward (concat "\n" mail-header-separator "\n"))
X      (replace-match "\n\n")
X      (goto-char (point-max))
X      ;; require a newline at the end for inews to append .signature to
X      (or (= (preceding-char) ?\n)
X	  (insert ?\n))
X      (message "Posting to USENET...")
X      ;; Call inews.
X      ;;(call-process-region (point-min) (point-max) 
X      ;;		   news-inews-program nil 0 nil
X      ;;		   "-h")	; take all header lines!
X      ;;		   ;"-t" subject
X      ;;		   ;"-n" newsgroups
X      ;; Post to NNTP server. 
X      (if (gnus-inews-article)
X	  (message "Posting to USENET... done")
X	(ding) (message "Article's rejected: %s" (nntp-status-message)))
X      (goto-char (point-min))		;restore internal header separator
X      (search-forward "\n\n")
X      (replace-match (concat "\n" mail-header-separator "\n"))
X      (set-buffer-modified-p nil))
X    ;; If NNTP server is opened by gnus-inews, close it by myself.
X    (or server-running
X	(nntp-close-server))
X    (and (fboundp 'bury-buffer) (bury-buffer))))
X
X(defun gnus-inews-article ()
X  "NNTP inews interface."
X  (let ((signature (expand-file-name "~/.signature" nil))
X	(distribution nil)
X	(artbuf (current-buffer))
X	(tmpbuf (get-buffer-create " *GNUS-posting*")))
X    (save-excursion
X      (set-buffer tmpbuf)
X      (buffer-flush-undo (current-buffer))
X      (erase-buffer)
X      (insert-buffer-substring artbuf)
X      ;; Get distribution.
X      (save-restriction
X	(goto-char (point-min))
X	(search-forward "\n\n")
X	(narrow-to-region (point-min) (point))
X	(setq distribution (mail-fetch-field "distribution")))
X      (widen)
X      ;; Change signature file by distribution.
X      ;; Suggested by hyoko@flab.fujitsu.junet.
X      (if (file-exists-p (concat signature "-" distribution))
X	  (setq signature (concat signature "-" distribution)))
X      ;; Insert signature.
X      (if (file-exists-p signature)
X	  (progn
X	    (goto-char (point-max))
X	    (insert "--\n")
X	    (insert-file-contents signature)))
X      ;; Prepare article headers.
X      (save-restriction
X	(goto-char (point-min))
X	(search-forward "\n\n")
X	(narrow-to-region (point-min) (point))
X	(gnus-inews-insert-headers))
X      (widen)
X      ;; Save author copy of posted article. The article must be
X      ;;  copied before being posted because `nntp-request-post'
X      ;;  modifies the buffer.
X      (cond ((and (stringp gnus-author-copy-file)
X		  (string-match "^[ \t]*|[ \t]*\\(.*\\)[ \t]*$"
X				gnus-author-copy-file))
X	     (let ((program (substring gnus-author-copy-file
X				       (match-beginning 1)
X				       (match-end 1))))
X	       ;; Suggested by yuki@flab.fujitsu.junet.
X	       ;; Pipe out article to named program.
X	       (call-process-region (point-min) (point-max) shell-file-name
X				    nil nil nil "-c" program)
X	       ))
X	    ((stringp gnus-author-copy-file)
X	     ;; Suggested by hyoko@flab.fujitsu.junet.
X	     ;; Save article in Unix mail format.
X	     ;; This is much convenient for Emacs user.
X	     (rmail-output gnus-author-copy-file)))
X      ;; Run final hooks.
X      (run-hooks 'gnus-Inews-article-hook)
X      ;; Post an article to NNTP server.
X      ;; Return NIL if post failed.
X      (prog1
X	  (nntp-request-post)
X	(kill-buffer (current-buffer)))
X      )))
X
X(defun gnus-inews-cancel ()
X  "Cancel an article you posted."
X  (let ((from nil)
X	(newsgroups nil)
X	(message-id nil)
X	(distribution nil))
X    (save-excursion
X      ;; Get header info. from original article.
X      (save-restriction
X	(gnus-Article-show-all-headers)
X	(goto-char (point-min))
X	(search-forward "\n\n")
X	(narrow-to-region (point-min) (point))
X	(setq from (mail-fetch-field "from"))
X	(setq newsgroups (mail-fetch-field "newsgroups"))
X	(setq message-id (mail-fetch-field "message-id"))
X	(setq distribution (mail-fetch-field "distribution")))
X      ;; Verify the article is absolutely user's by comparing user id
X      ;;  with value of its From: field.
X      (if (not (string-equal (downcase (mail-strip-quoted-names from))
X			     (downcase (gnus-inews-user-name))))
X	  (progn
X	    (ding) (message "This article is not yours"))
X	;; Make control article.
X	(set-buffer (get-buffer-create " *GNUS-posting*"))
X	(buffer-flush-undo (current-buffer))
X	(erase-buffer)
X	(insert "Newsgroups: " newsgroups "\n"
X		"Subject: cancel " message-id "\n"
X		"Control: cancel " message-id "\n"
X		;; We should not use the value of
X		;;  `gnus-default-distribution' as default value,
X		;;  because distribution must be as same as original
X		;;  article.
X		"Distribution: " (or distribution "") "\n"
X		)
X	;; Prepare article headers.
X	(gnus-inews-insert-headers)
X	(goto-char (point-max))
X	;; Insert empty line.
X	(insert "\n")
X	;; Post control article to NNTP server.
X	(message "Canceling your article...")
X	(if (nntp-request-post)
X	    (message "Canceling your article... done")
X	  (ding) (message "Failed to cancel your article"))
X	(kill-buffer (current-buffer))
X	))
X    ))
X
X(defun gnus-inews-insert-headers ()
X  "Prepare article headers.
XPath:, From:, Subject:, Message-ID: and Distribution: are generated.
XOrganization: is optional."
X  (save-excursion
X    (let* ((domain-name (gnus-inews-domain-name))
X	   ;; Message-ID should not contain slash `/' and should be
X	   ;;  terminated by a number. I don't know the reason why it
X	   ;;  is so. (UMERIN@flab)
X	   (id (gnus-inews-message-id gnus-user-login-name))
X	   (organization (or (getenv "ORGANIZATION") gnus-your-organization)))
X      ;; Insert from top of headers.
X      (goto-char (point-min))
X      (insert "Path: " gnus-nntp-server "!" gnus-user-login-name "\n"
X	      "From: " (gnus-inews-user-name)
X	      (if (or (string-equal gnus-user-full-name "")
X		      (string-equal gnus-user-full-name "&"))
X		  "\n"
X		(concat " (" gnus-user-full-name ")\n"))
X	      )
X      ;; If there is no subject, make Subject: field.
X      (or (mail-fetch-field "subject")
X	  (insert "Subject: \n"))
X      ;; Insert random headers.
X      (insert "Message-ID: <" id "@" domain-name ">\n")
X      ;; Insert buggy date (time zone is ignored), but I don't worry
X      ;;  about it since inews will rewrite it.
X      (insert "Date: " (gnus-inews-date) "\n")
X      (if organization
X	  (insert "Organization: " organization "\n"))
X      (or (mail-fetch-field "distribution")
X	  (insert "Distribution: \n"))
X      )))
X
X(defun gnus-inews-user-name ()
X  "Return user's network address."
X  (concat gnus-user-login-name
X	  "@"
X	  (gnus-inews-domain-name gnus-use-generic-from)))
X
X(defun gnus-inews-domain-name (&optional genericfrom)
X  "Return user's domain name.
XIf optional argument GENERICFROM is non-nil, host name never be inserted."
X  ;; If system-name returns full internet name, domain name should be
X  ;; got from it.
X  (if (string-match "\\." (system-name))
X      (setq gnus-your-domain (substring (system-name) (match-end 0))))
X  (let ((domain (or (getenv "DOMAINNAME") gnus-your-domain)))
X    (if (null domain)
X	(progn
X	  (setq domain (read-string "Domain name (no host): "))
X	  (setq gnus-your-domain domain)))
X    (if (string-equal "." (substring domain 0 1))
X	(setq domain (substring domain 1)))
X    (if genericfrom
X	;; Support GENERICFROM as same as standard Bnews system.
X	;; Suggested by ohm@kaba.junet.
X	(if (string-match "^[^.]+\\.\\(.+\\)" (system-name))
X	    ;; Remove host name from full internet name.
X	    (substring (system-name) (match-beginning 1))
X	  domain
X	  )
X      (if (or (string-equal domain "")
X	      (string-match "\\." (system-name))) ;Full internet name.
X	  ;; Assume function `system-name' returns full internet name.
X	  ;; Suggested by Mike DeCorte <mrd@sun.soe.clarkson.edu>.
X	  (system-name)
X	(concat (system-name)
X		;; Host name and domain name must be separated by
X		;;  one period `.'.
X		"." domain
X		)
X	))
X    ))
X
X(defun gnus-inews-message-id (name)
X  "Generate unique message-ID for NAMEd user."
X  (let ((date (current-time-string)))
X    (if (string-match "^[^ ]+ \\([^ ]+\\)[ ]+\\([0-9]+\\) \\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\) [0-9][0-9]\\([0-9][0-9]\\)"
X		      date)
X	(concat (upcase name) "."
X		(substring date (match-beginning 6) (match-end 6)) ;Year
X		(substring date (match-beginning 1) (match-end 1)) ;Month
X		(substring date (match-beginning 2) (match-end 2)) ;Day
X		(substring date (match-beginning 3) (match-end 3)) ;Hour
X		(substring date (match-beginning 4) (match-end 4)) ;Minute
X		(substring date (match-beginning 5) (match-end 5)) ;Second
X		)
X      (error "Cannot understand current-time-string: %s." date))
X    ))
X
X(defun gnus-inews-date ()
X  "Bnews date format string of today. Time zone is ignored."
X  (let ((date (current-time-string)))
X    (if (string-match "^[^ ]+ \\([^ ]+\\)[ ]+\\([0-9]+\\) \\([0-9:]+\\) [0-9][0-9]\\([0-9][0-9]\\)"
X		      date)
X	(concat (substring date (match-beginning 2) (match-end 2)) ;Day
X		" "
X		(substring date (match-beginning 1) (match-end 1)) ;Month
X		" "
X		(substring date (match-beginning 4) (match-end 4)) ;Year
X		" "
X		(substring date (match-beginning 3) (match-end 3))) ;Time
X      (error "Cannot understand current-time-string: %s." date))
X    ))
X
X
X;;Local variables:
X;;eval: (put 'eval-in-buffer-window 'lisp-indent-hook 1)
X;;end:
SHAR_EOF
chmod 0644 gnus.el || echo "restore of gnus.el fails"
set `wc -c gnus.el`;Sum=$1
if test "$Sum" != "178299"
then echo original size 178299, current size $Sum;fi
sed 's/^X//' << 'SHAR_EOF' > mhspool.el &&
X;;; MH folder patches to NNTP package for GNU Emacs
X;; Copyright (C) 1988 Fujitsu Laboratoris LTD.
X;; Copyright (C) 1988 Masanobu UMEDA (umerin@flab.flab.Fujitsu.JUNET)
X;; $Header: mhspool.el,v 1.2 88/11/11 14:57:53 umerin Exp $
X
X;; This file is part of GNU Emacs.
X
X;; GNU Emacs is distributed in the hope that it will be useful,
X;; but WITHOUT ANY WARRANTY.  No author or distributor
X;; accepts responsibility to anyone for the consequences of using it
X;; or for whether it serves any particular purpose or works at all,
X;; unless he says so in writing.  Refer to the GNU Emacs General Public
X;; License for full details.
X
X;; Everyone is granted permission to copy, modify and redistribute
X;; GNU Emacs, but only under the conditions described in the
X;; GNU Emacs General Public License.   A copy of this license is
X;; supposed to have been given to you along with GNU Emacs so you
X;; can know your rights and responsibilities.  It should be in a
X;; file named COPYING.  Among other things, the copyright notice
X;; and this notice must be preserved on all copies.
X
X(provide 'mhspool)
X(require 'nntp)
X(require 'nnspool)
X
X;; This package is a patch to nnspool.el package of GNUS, a NNTP-based
X;; network news reader. This package enables you to read mails or
X;; articles in MH folder, or articles saved in article save directory
X;; by GNUS. In any case file names must consist of numbers only.
X
X;; Before using the package, you have to make a special .newsrc file
X;; according to the directory which you want to read. For example, if
X;; you want to read mails under the directory named ~/Mail, the file
X;; must be named as `.newsrc-:Mail'. (There is no way to specify
X;; hierarchical directory now.) In this case the name of NNTP server
X;; passed to GNUS must be `:Mail'.
X
X;; If you'd like to read news normally, you'd better exit Emacs once.
X;; I hope you enjoy GNUS.
X
X(defconst mhspool-version "MHSPOOL 1.2"
X  "Version numbers of this version of MHSPOOL.")
X
X;;;
X;;; Replacement of NNTP Raw Interface.
X;;;
X
X(defun nntp-open-server (host &optional service)
X  "Open news server on HOST.
XIf HOST is nil, use value of environment variable `NNTPSERVER'.
XIf optional argument SERVICE is non-nil, open by the service name."
X  (let ((host (or host (getenv "NNTPSERVER")))
X	(status nil))
X    ;; Get directory name from HOST name.
X    (if (string-match ":\\(.+\\)$" host)
X	(progn
X	  (setq nnspool-spool-directory
X		(file-name-as-directory
X		 (expand-file-name
X		  (substring host (match-beginning 1) (match-end 1))
X		  (expand-file-name "~/" nil))))
X	  (setq host (system-name)))
X      (setq nnspool-spool-directory nil))
X    (setq nntp-status-message-string "")
X    (cond ((and (stringp host)
X		(stringp nnspool-spool-directory)
X		(file-directory-p nnspool-spool-directory)
X		(string-equal host (system-name)))
X	   (setq status (nntp-open-server-internal host service)))
X	  ((string-equal host (system-name))
X	   (setq nntp-status-message-string
X		 (format "%s has no news spool.  Goodbye." host)))
X	  ((null host)
X	   (setq nntp-status-message-string "NNTP server is not specified."))
X	  (t
X	   (setq nntp-status-message-string
X		 (format
X		  "Load `nntp' again if you'd like to talk to %s." host)))
X	  )
X    status
X    ))
X
X(defun nntp-request-list ()
X  "List valid newsgoups."
X  (save-excursion
X    (let* ((newsgroup nil)
X	   (articles nil)
X	   (directory (file-name-as-directory
X		       (expand-file-name nnspool-spool-directory nil)))
X	   (folder-regexp (concat "^" (regexp-quote directory) "\\(.+\\):$"))
X	   (buffer (get-buffer-create " *GNUS MH list*")))
X      (set-buffer nntp-server-buffer)
X      (erase-buffer)
X      (set-buffer buffer)
X      (erase-buffer)
X      (call-process "ls" nil t nil "-R" directory)
X      (goto-char (point-min))
X      (while (re-search-forward folder-regexp nil t)
X	(setq newsgroup
X	      (mhspool-reverse-article-pathname
X	       (buffer-substring (match-beginning 1) (match-end 1))))
X	(setq articles nil)
X	(forward-line 1)		;(beginning-of-line)
X	(while (looking-at "^[0-9]+$")
X	  (setq articles
X		(cons (string-to-int
X		       (buffer-substring (match-beginning 0) (match-end 0)))
X		      articles))
X	  (forward-line 1))
X	(if articles
X	    (princ (format "%s %d %d n\n" newsgroup
X			   (apply (function max) articles)
X			   (apply (function min) articles))
X		   nntp-server-buffer))
X	)
X      (kill-buffer buffer)
X      (set-buffer nntp-server-buffer)
X      (buffer-size)
X      )))
X
X(defun nntp-request-post ()
X  "Post a new news in current buffer."
X  (setq nntp-status-message-string "MHSPOOL: What do you mean post?")
X  nil
X  )
X
X
X;;;
X;;; Replacement of Low-Level Interface to NNTP Server.
X;;; 
X
X(defun nnspool-find-article-by-message-id (id)
X  "Return full pathname of an artilce identified by message-ID."
X  nil
X  )
X
X(defun nnspool-find-file (file)
X  "Insert FILE in server buffer safely."
X  (set-buffer nntp-server-buffer)
X  (erase-buffer)
X  (condition-case ()
X      (progn
X	(insert-file-contents file)
X	(goto-char (point-min))
X	;; If there is no body, `^L' appears at end of file. Special
X	;; hack for MH folder.
X	(and (search-forward "\n\n" nil t)
X	     (string-equal (buffer-substring (point) (point-max)) "\^L")
X	     (delete-char 1))
X	t
X	)
X    (file-error nil)
X    ))
X
X(defun mhspool-reverse-article-pathname (pathname)
X  "Make group name from PATHNAME."
X  (let ((pathname (substring pathname 0)) ;Copy string.
X	(len (length pathname))
X	(idx 0))
X    ;; Replace all occurence of `/' with `.'.
X    (while (< idx len)
X      (if (= (aref pathname idx) ?/)
X	  (aset pathname idx ?.))
X      (setq idx (1+ idx)))
X    pathname
X    ))
SHAR_EOF
chmod 0644 mhspool.el || echo "restore of mhspool.el fails"
set `wc -c mhspool.el`;Sum=$1
if test "$Sum" != "5566"
then echo original size 5566, current size $Sum;fi
sed 's/^X//' << 'SHAR_EOF' > nnspool.el &&
X;;; Spool patches to NNTP package for GNU Emacs
X;; Copyright (C) 1988 Fujitsu Laboratoris LTD.
X;; Copyright (C) 1988 Masanobu UMEDA (umerin@flab.flab.Fujitsu.JUNET)
X;; $Header: nnspool.el,v 1.7 88/11/11 14:57:43 umerin Exp $
X
X;; This file is part of GNU Emacs.
X
X;; GNU Emacs is distributed in the hope that it will be useful,
X;; but WITHOUT ANY WARRANTY.  No author or distributor
X;; accepts responsibility to anyone for the consequences of using it
X;; or for whether it serves any particular purpose or works at all,
X;; unless he says so in writing.  Refer to the GNU Emacs General Public
X;; License for full details.
X
X;; Everyone is granted permission to copy, modify and redistribute
X;; GNU Emacs, but only under the conditions described in the
X;; GNU Emacs General Public License.   A copy of this license is
X;; supposed to have been given to you along with GNU Emacs so you
X;; can know your rights and responsibilities.  It should be in a
X;; file named COPYING.  Among other things, the copyright notice
X;; and this notice must be preserved on all copies.
X
X(provide 'nnspool)
X(require 'nntp)
X
X(defconst nnspool-version "NNSPOOL 1.7"
X  "Version numbers of this version of NNSPOOL.")
X
X(defvar nnspool-inews-program news-inews-program
X  "Program to post news.")
X
X(defvar nnspool-spool-directory news-path
X  "Local news spool directory.")
X
X(defvar nnspool-active-file "/usr/lib/news/active"
X  "Local news active file.")
X
X(defvar nnspool-history-file "/usr/lib/news/history"
X  "Local news history file.")
X
X(defvar nnspool-current-directory nil
X  "Current news group directory.")
X
X;;;
X;;; Replacement of Extended Command for retrieving many headers.
X;;;
X
X(defun nntp-retrieve-headers (sequence)
X  "Return list of article headers specified by SEQUENCE of article id.
XThe format of list is `([NUMBER SUBJECT FROM XREF LINES DATE MESSAGE-ID] ...)'.
XReader macros for the vector are defined as `nntp-header-FIELD'.
XWriter macros for the vector are defined as `nntp-set-header-FIELD'.
XNews group must be selected before calling me."
X  (save-excursion
X    (set-buffer nntp-server-buffer)
X    ;;(erase-buffer)
X    (let ((file nil)
X	  (number (length sequence))
X	  (count 0)
X	  (headers nil)			;Result list.
X	  (article 0)
X	  (subject nil)
X	  (message-id nil)
X	  (from nil)
X	  (xref nil)
X	  (lines 0)
X	  (date nil))
X      (while sequence
X	;;(nntp-send-strings-to-server "HEAD" (car sequence))
X	(setq article (car sequence))
X	(setq file
X	      (concat nnspool-current-directory (prin1-to-string article)))
X	(if (and (file-exists-p file)
X		 (not (file-directory-p file)))
X	    (progn
X	      (erase-buffer)
X	      (insert-file-contents file)
X	      (goto-char (point-min))
X	      (search-forward "\n\n" nil 'move)
X	      (narrow-to-region (point-min) (point))
X	      ;; Make it possible to search `\nFIELD'.
X	      (goto-char (point-min))
X	      (insert "\n")
X	      ;; Extract From:
X	      (goto-char (point-min))
X	      (if (search-forward "\nFrom: " nil t)
X		  (setq from (buffer-substring
X			      (point)
X			      (save-excursion (end-of-line) (point))))
X		(setq from "Unknown User"))
X	      ;; Extract Subject:
X	      (goto-char (point-min))
X	      (if (search-forward "\nSubject: " nil t)
X		  (setq subject (buffer-substring
X				 (point)
X				 (save-excursion (end-of-line) (point))))
X		(setq subject "(None)"))
X	      ;; Extract Message-ID:
X	      (goto-char (point-min))
X	      (if (search-forward "\nMessage-ID: " nil t)
X		  (setq message-id (buffer-substring
X				    (point)
X				    (save-excursion (end-of-line) (point))))
X		(setq message-id nil))
X	      ;; Extract Date:
X	      (goto-char (point-min))
X	      (if (search-forward "\nDate: " nil t)
X		  (setq date (buffer-substring
X			      (point)
X			      (save-excursion (end-of-line) (point))))
X		(setq date nil))
X	      ;; Extract Lines:
X	      (goto-char (point-min))
X	      (if (search-forward "\nLines: " nil t)
X		  (setq lines (string-to-int
X			       (buffer-substring
X				(point)
X				(save-excursion (end-of-line) (point)))))
X		(setq lines 0))
X	      ;; Extract Xref:
X	      (goto-char (point-min))
X	      (if (search-forward "\nXref: " nil t)
X		  (setq xref (buffer-substring
X			      (point)
X			      (save-excursion (end-of-line) (point))))
X		(setq xref nil))
X	      (setq headers
X		    (cons (vector article subject from
X				  xref lines date message-id)
X			  headers))
X	      ))
X	(setq sequence (cdr sequence))
X	(setq count (1+ count))
X	(if (and (> number 100)
X		 (zerop (% count 20)))
X	    (message "NNSPOOL: %d%% of headers received."
X		     (/ (* count 100) number)))
X	)
X      (if (> number 100)
X	  (message "NNSPOOL: 100%% of headers received."))
X      (nreverse headers)
X      )))
X
X
X;;;
X;;; Replacement of NNTP Raw Interface.
X;;;
X
X(defun nntp-open-server (host &optional service)
X  "Open news server on HOST.
XIf HOST is nil, use value of environment variable `NNTPSERVER'.
XIf optional argument SERVICE is non-nil, open by the service name."
X  (let ((host (or host (getenv "NNTPSERVER")))
X	(status nil))
X    (setq nntp-status-message-string "")
X    (cond ((and (file-directory-p nnspool-spool-directory)
X		(file-exists-p nnspool-active-file)
X		(string-equal host (system-name)))
X	   (setq status (nntp-open-server-internal host service)))
X	  ((string-equal host (system-name))
X	   (setq nntp-status-message-string
X		 (format "%s has no news spool.  Goodbye." host)))
X	  ((null host)
X	   (setq nntp-status-message-string "NNTP server is not specified."))
X	  (t
X	   (setq nntp-status-message-string
X		 (format
X		  "Load `nntp' again if you'd like to talk to %s." host)))
X	  )
X    status
X    ))
X
X(defun nntp-close-server ()
X  "Close news server."
X  (nntp-close-server-internal))
X
X(fset 'nntp-request-quit (symbol-function 'nntp-close-server))
X
X(defun nntp-server-opened ()
X  "Return server process status, T or NIL.
XIf the stream is opened, return T, otherwise return NIL."
X  (and nntp-server-buffer
X       (get-buffer nntp-server-buffer)))
X
X(defun nntp-status-message ()
X  "Return server status response as string."
X  nntp-status-message-string
X  )
X
X(defun nntp-request-article (id)
X  "Select article by message ID (or number)."
X  (let ((file (if (stringp id)
SHAR_EOF
echo "End of part 4, continue with part 5"
echo "5" > s2_seq_.tmp
exit 0
-- 
Masanobu UMEDA
umerin@flab.flab.Fujitsu.JUNET
umerin%flab.flab.Fujitsu.JUNET@uunet.uu.NET