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 (5 of 9)
Message-ID: <4804@flab.flab.fujitsu.JUNET>
Date: 23 Feb 89 07:23:21 GMT
Reply-To: umerin@flab.flab.fujitsu.JUNET (Masanobu UMEDA)
Followup-To: comp.emacs
Organization: Fujitsu Laboratories Ltd., Kawasaki, Japan.
Lines: 1433

---- Cut Here and unpack ----
#!/bin/sh
# this is part 5 of a multipart archive
# do not concatenate these parts, unpack them in order with /bin/sh
# file gnus.el continued
#
CurArch=5
if test ! -r s2_seq_.tmp
then echo "Please unpack part 1 first!"
     exit 1; fi
( read Scheck
  if test "$Scheck" != $CurArch
  then echo "Please unpack part $Scheck next!"
       exit 1;
  else exit 0; fi
) < s2_seq_.tmp || exit 1
sed 's/^X//' << 'SHAR_EOF' >> gnus.el
X	     (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      ;; Check duplications of newsgroups.
X      ;; Note: Checking the duplications takes very long time.
X      (if (assoc newsgroup gnus-newsrc-assoc)
X	  (message "Ignore duplicated newsgroup: %s" newsgroup)
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 (cons (string-to-int subrange)
X				   (string-to-int subrange))
X			     read-list)))
X		(t
X		 (ding) (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  ;; Note: We cannot save .newsrc file if all newsgroups are removed
X  ;; from the variable gnus-newsrc-assoc.
X  (and gnus-newsrc-assoc
X       gnus-current-startup-file
X       (save-excursion
X	 ;; A buffer containing .newsrc file may be deleted.
X	 (set-buffer (find-file-noselect 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    ;; Taking account of the killed startup file.
X    ;; Suggested by tale@pawl.rpi.edu.
X    (set-buffer (or (get-file-buffer gnus-current-startup-file)
X		    (find-file-noselect gnus-current-startup-file)))
X    ;; Delete ALL entries which match for GROUP.
X    (goto-char (point-min))
X    (while (re-search-forward
X	    (concat "^[ \t]*" (regexp-quote group) "[ \t]*[:!]") nil t)
X      (beginning-of-line)
X      (delete-region (point) (progn (forward-line 1) (point)))
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		 (artbuf (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	    ;; Make news-reply-yank-original work on current article.
X	    (setq mail-reply-buffer artbuf)
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 artbuf)
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	  ;; Distribution must be as same as original article.
X	  (mail-position-on-field "Distribution")
X	  (insert (or 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 ((artbuf (current-buffer))
X	    (newsgroups			;Default newsgroup.
X	     (if (eq major-mode 'gnus-Article-mode) gnus-newsgroup-name))
X	    (subject 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	    ;; Make news-reply-yank-original work on the current article.
X	    (setq mail-reply-buffer artbuf)
X	  (erase-buffer)
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		(or newsgroups		;Use the default newsgroup.
X		    (setq newsgroups
X			  (completing-read "Newsgroup: " gnus-newsrc-assoc
X					   nil 'require-match
X					   newsgroups ;Default newsgroup.
X					   )))
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	  (news-setup () subject () newsgroups artbuf)
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	;; We cannot signal an error.
X	(ding) (message "Article 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
X	 (if gnus-signature-file
X	     (expand-file-name gnus-signature-file 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      (if signature
X	  (progn
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	    ))
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: "
X	      ;; Support GENERICPATH. Suggested by vixie@decwrl.dec.com.
X	      (cond ((null gnus-use-generic-path)
X		     (concat gnus-nntp-server "!"))
X		    ((stringp gnus-use-generic-path)
X		     (concat gnus-use-generic-path "!"))
X		    (t ""))
X	      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 a string, use it as the domain
Xname; if it is non-nil, strip of local host name from the domain name.
XIf the function `system-name' returns full internet name and the
Xdomain is undefined, the domain name is got from it."
X  (let ((domain (or (if (stringp genericfrom) genericfrom)
X		    (getenv "DOMAINNAME")
X		    gnus-your-domain
X		    ;; Function `system-name' may return full internet name.
X		    ;; Suggested by Mike DeCorte <mrd@sun.soe.clarkson.edu>.
X		    (if (string-match "\\." (system-name))
X			(substring (system-name) (match-end 0)))
X		    (read-string "Domain name (no host): ")))
X	(host (or (if (string-match "\\." (system-name))
X		      (substring (system-name) 0 (match-beginning 0)))
X		  (system-name))))
X    (if (string-equal "." (substring domain 0 1))
X	(setq domain (substring domain 1)))
X    (if (null gnus-your-domain)
X	(setq gnus-your-domain domain))
X    ;; Support GENERICFROM as same as standard Bnews system.
X    ;; Suggested by ohm@kaba.junet and vixie@decwrl.dec.com.
X    (cond ((null genericfrom)
X	   (concat host "." domain))
X	  ;;((stringp genericfrom) genericfrom)
X	  (t domain))
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 0444 gnus.el || echo "restore of gnus.el fails"
set `wc -c gnus.el`;Sum=$1
if test "$Sum" != "190991"
then echo original size 190991, 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, 1989 Fujitsu Laboratories LTD.
X;; Copyright (C) 1988, 1989 Masanobu UMEDA
X;; $Header: mhspool.el,v 1.3 89/02/23 15:40:15 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 patches to nnspool.el package of GNUS, an
X;; NNTP-based network news reader. This package enables you to read
X;; mail or articles in MH folders, or articles saved by GNUS. In any
X;; case, the file names of mail or articles must consist of only
X;; numeric letters.
X
X;; Before using this package, you have to create a server specific
X;; startup file according to the directory which you want to read. For
X;; example, if you want to read mail under the directory named
X;; `~/Mail', the file must be a file named `.newsrc-:Mail'. (There is
X;; no way to specify hierarchical directory now.) In this case, the
X;; name of the NNTP server 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(defvar mhspool-list-directory-switches "-R"
X  "*Switches for nntp-request-list to pass to `ls' for gettting file lists.
XOne entry should appear on one line. You may need to add `-1' option.")
X
X(defconst mhspool-version "MHSPOOL 1.3"
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 mhspool-list-directory-switches 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 0444 mhspool.el || echo "restore of mhspool.el fails"
set `wc -c mhspool.el`;Sum=$1
if test "$Sum" != "5799"
then echo original size 5799, current size $Sum;fi
sed 's/^X//' << 'SHAR_EOF' > nnspool.el &&
X;;; Spool patches to NNTP package for GNU Emacs
X;; Copyright (C) 1988, 1989 Fujitsu Laboratories LTD.
X;; Copyright (C) 1988, 1989 Masanobu UMEDA
X;; $Header: nnspool.el,v 1.8 89/02/23 15:40:02 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(defvar nnspool-inews-program news-inews-program
X  "*Program to post news.")
X
X(defvar nnspool-inews-switches "-h"
X  "*Switches for nntp-request-post to pass to `inews' for posting 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
X
X(defconst nnspool-version "NNSPOOL 1.8"
X  "Version numbers of this version of NNSPOOL.")
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 nntp-large-newsgroup)
X		 (zerop (% count 20)))
X	    (message "NNSPOOL: %d%% of headers received."
X		     (/ (* count 100) number)))
X	)
X      (if (> number nntp-large-newsgroup)
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)
X		  (nnspool-find-article-by-message-id id)
X		(concat nnspool-current-directory (prin1-to-string id)))))
X    (if (and (stringp file)
X	     (file-exists-p file)
X	     (not (file-directory-p file)))
X	(save-excursion
X	  (nnspool-find-file file)))
X    ))
X
X(defun nntp-request-body (id)
X  "Select article body by message ID (or number)."
X  (if (nntp-request-article id)
X      (save-excursion
X	(set-buffer nntp-server-buffer)
X	(goto-char (point-min))
X	(if (search-forward "\n\n" nil t)
X	    (delete-region (point-min) (point)))
X	t
X	)
X    ))
X
X(defun nntp-request-head (id)
X  "Select article head by message ID (or number)."
X  (if (nntp-request-article id)
X      (save-excursion
X	(set-buffer nntp-server-buffer)
X	(goto-char (point-min))
X	(if (search-forward "\n\n" nil t)
X	    (delete-region (1- (point)) (point-max)))
X	t
X	)
X    ))
X
X(defun nntp-request-stat (id)
X  "Select article by message ID (or number)."
X  (error "NNSPOOL: STAT is not implemented."))
X
X(defun nntp-request-group (group)
X  "Select news GROUP."
X  (let ((pathname (nnspool-article-pathname group)))
X    (if (file-directory-p pathname)
X	(setq nnspool-current-directory pathname))
X    ))
X
X(defun nntp-request-list ()
X  "List valid newsgoups."
X  (save-excursion
X    (nnspool-find-file nnspool-active-file)))
X
X(defun nntp-request-last ()
X  "Set current article pointer to the previous article
Xin the current news group."
X  (error "NNSPOOL: LAST is not implemented."))
X
X(defun nntp-request-next ()
X  "Advance current article pointer."
X  (error "NNSPOOL: NEXT is not implemented."))
X
X(defun nntp-request-post ()
X  "Post a new news in current buffer."
X  (save-excursion
X    ;; We have to work in the server buffer because of NEmacs hack.
X    (copy-to-buffer nntp-server-buffer (point-min) (point-max))
X    (set-buffer nntp-server-buffer)
X    (call-process-region (point-min) (point-max)
X    			 nnspool-inews-program 'delete t nil
X			 nnspool-inews-switches
X			 )
X    (prog1
X	(or (zerop (buffer-size))
X	    ;; If inews returns strings, it must be error message 
X	    ;;  unless SPOOLNEWS is defined.  
X	    ;; This condition is very weak, but there is no good rule 
X	    ;;  identifying errors when SPOOLNEWS is defined.  
X	    ;; Suggested by ohm@kaba.junet.
X	    (string-match "spooled" (buffer-string)))
X      ;; Make status message by unfolding lines.
X      (subst-char-in-region (point-min) (point-max) ?\n ?\\ 'noundo)
X      (setq nntp-status-message-string (buffer-string))
X      (erase-buffer))
X    ))
X
X
X;;;
X;;; Replacement of Low-Level Interface to NNTP Server.
X;;; 
X
X(defun nntp-open-server-internal (host &optional service)
X  "Open connection to news server on HOST by SERVICE (default is nntp)."
X  (save-excursion
X    (if (not (string-equal host (system-name)))
X	(error "NNSPOOL: Load `nntp' again if you'd like to talk to %s." host))
X    ;; Initialize communication buffer.
X    (setq nntp-server-buffer (get-buffer-create " *nntpd*"))
X    (set-buffer nntp-server-buffer)
X    (kill-all-local-variables)
X    (buffer-flush-undo (current-buffer))
X    (erase-buffer)
X    (setq nntp-server-process nil)
X    (setq nntp-server-name host)
X    ;; It is possible to change kanji-fileio-code in this hook.
X    (run-hooks 'nntp-server-hook)
X    t
X    ))
X
X(defun nntp-close-server-internal ()
X  "Close connection to news server."
X  (if (get-file-buffer nnspool-history-file)
X      (kill-buffer (get-file-buffer nnspool-history-file)))
X  (if nntp-server-buffer
X      (kill-buffer nntp-server-buffer))
X  (setq nntp-server-buffer nil)
X  (setq nntp-server-process nil))
X
X(defun nnspool-find-article-by-message-id (id)
X  "Return full pathname of an artilce identified by message-ID."
X  (save-excursion
X    (let ((buffer (get-file-buffer nnspool-history-file)))
X      (if buffer
X	  (set-buffer buffer)
X	;; Finding history file may take lots of time.
X	(message "Reading history file...")
X	(set-buffer (find-file-noselect nnspool-history-file))
X	(message "Reading history file... done")))
X    ;; Search from end of the file. I think this is much faster than
X    ;; do from the beginning of the file.
X    (goto-char (point-max))
X    (if (re-search-backward
X	 (concat "^" (regexp-quote id)
X		 "[ \t].*[ \t]\\([^ \t/]+\\)/\\([0-9]+\\)[ \t]*$") nil t)
X	(let ((group (buffer-substring (match-beginning 1) (match-end 1)))
X	      (number (buffer-substring (match-beginning 2) (match-end 2))))
X	  (concat (nnspool-article-pathname group) number))
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 (insert-file-contents file) t)
X    (file-error nil)
X    ))
X
X(defun nnspool-article-pathname (group)
X  "Make pathname to news GROUP."
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    (concat (file-name-as-directory nnspool-spool-directory) group "/")
X    ))
SHAR_EOF
chmod 0444 nnspool.el || echo "restore of nnspool.el fails"
set `wc -c nnspool.el`;Sum=$1
if test "$Sum" != "11260"
then echo original size 11260, current size $Sum;fi
sed 's/^X//' << 'SHAR_EOF' > nntp.el &&
X;;; NNTP (RFC977) Interface for GNU Emacs
X;; Copyright (C) 1987, 1988, 1989 Fujitsu Laboratories LTD.
X;; Copyright (C) 1987, 1988, 1989 Masanobu UMEDA
X;; $Header: nntp.el,v 3.8 89/02/23 15:39:34 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;; This implementation is tested on both 1.2a and 1.5 version of the
X;; NNTP package.
X
X;; Troubleshooting of NNTP
X;;
X;; (1) Select routine may signal an error or fall into infinite loop
X;;  while waiting for the server response. In this case, you'd better
X;;  not use byte-compiled codes but original source. If you still have
X;;  a problems with it, set the variable `nntp-buggy-select' to T.
X;;
X;; (2) Emacs may hang up while retrieving headers since too many
X;;  requests have been sent to the NNTP server without reading their
X;;  replies. In this case, reduce the number of the requests sent to
X;;  the server at one time by setting the variable
X;;  `nntp-maximum-request' to a lower value.
X;;
X;; (3) If the TCP/IP stream (open-network-stream) is not supported by
X;;  emacs, compile and install `tcp.el' and `tcp.c' which is an
X;;  emulation program of the stream. If you modified `tcp.c' for your
X;;  system, please send me the diffs. I'll include some of them in the
X;;  future releases.
X
X(provide 'nntp)
X
X(defvar nntp-server-hook nil
X  "*Hooks for the NNTP server.
XIf the kanji code of the NNTP server is different from the local kanji
Xcode, the correct kanji code of the buffer associated with the NNTP
Xserver must be specified as follows:
X
X(setq nntp-server-hook
X      '(lambda ()
X	 ;; Server's Kanji code is EUC (NEmacs hack).
X	 (make-local-variable 'kanji-fileio-code)
X	 (setq kanji-fileio-code 0)))
X
XIf you'd like to change something depending on the server in this
Xhook, use the variable `nntp-server-name'.")
X
X(defvar nntp-buggy-select (memq system-type '(usg-unix-v fujitsu-uts))
X  "*T if your select routine is buggy.
XIf the select routine signals error or fall into infinite loop while
Xwaiting for the server response, the variable must be set to t.  In
Xcase of Fujitsu UTS, it is set to T since `accept-process-output'
Xdoesn't work properly.")
X
X(defvar nntp-maximum-request 400
X  "*The maximum number of the requests sent to the NNTP server at one time.
XIf Emacs hangs up while retrieving headers, set the variable to a
Xlower value.")
X
X(defvar nntp-large-newsgroup 50
X  "*The number of the articles which indicates a large newsgroup.
XIf the number of the articles is greater than the value, verbose
Xmessages will be shown to indicate the current status.")
X
X
X(defconst nntp-version "NNTP 3.8"
X  "Version numbers of this version of NNTP.")
X
X(defvar nntp-server-name nil
X  "The name of the host running the NNTP server.")
X
X(defvar nntp-server-buffer nil
X  "Buffer associated with the NNTP server process.")
X
X(defvar nntp-server-process nil
X  "The NNTP server process.
XYou'd better not use this variable in NNTP front-end program but
Xinstead use `nntp-server-buffer'.")
X
X(defvar nntp-status-message-string nil
X  "Save the server response message.
XYou'd better not use this variable in NNTP front-end program but
Xinstead call function `nntp-status-message' to get status message.")
X
X;;;
X;;; Extended Command for retrieving many headers.
X;;;
X;; Retrieving lots of headers by sending command asynchronously.
X;; Access functions to headers are defined as macro.
X
X(defmacro nntp-header-number (header)
X  "Return article number in HEADER."
X  (` (aref (, header) 0)))
X
X(defmacro nntp-set-header-number (header number)
X  "Set article number of HEADER to NUMBER."
X  (` (aset (, header) 0 (, number))))
X
X(defmacro nntp-header-subject (header)
X  "Return subject string in HEADER."
X  (` (aref (, header) 1)))
X
X(defmacro nntp-set-header-subject (header subject)
X  "Set article subject of HEADER to SUBJECT."
X  (` (aset (, header) 1 (, subject))))
X
X(defmacro nntp-header-from (header)
X  "Return author string in HEADER."
X  (` (aref (, header) 2)))
X
X(defmacro nntp-set-header-from (header from)
X  "Set article author of HEADER to FROM."
X  (` (aset (, header) 2 (, from))))
X
X(defmacro nntp-header-xref (header)
X  "Return xref string in HEADER."
X  (` (aref (, header) 3)))
X
X(defmacro nntp-set-header-xref (header xref)
X  "Set article xref of HEADER to xref."
X  (` (aset (, header) 3 (, xref))))
X
X(defmacro nntp-header-lines (header)
X  "Return lines in HEADER."
X  (` (aref (, header) 4)))
X
X(defmacro nntp-set-header-lines (header lines)
X  "Set article lines of HEADER to LINES."
X  (` (aset (, header) 4 (, lines))))
X
X(defmacro nntp-header-date (header)
X  "Return date in HEADER."
X  (` (aref (, header) 5)))
X
X(defmacro nntp-set-header-date (header date)
X  "Set article date of HEADER to DATE."
X  (` (aset (, header) 5 (, date))))
X
X(defmacro nntp-header-id (header)
X  "Return date in HEADER."
X  (` (aref (, header) 6)))
X
X(defmacro nntp-set-header-id (header id)
X  "Set article ID of HEADER to ID."
X  (` (aset (, header) 6 (, id))))
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 ((number (length sequence))
X	  (last-point (point-min))
X	  (received 0)
X	  (count 0)
X	  (headers nil)			;Result list.
X	  (article 0)
X	  (subject nil)
X	  (message-id)
X	  (from nil)
X	  (xref nil)
X	  (lines 0)
X	  (date nil))
X      ;; Send HEAD command.
X      (while sequence
X	(nntp-send-strings-to-server "HEAD" (car sequence))
X	(setq sequence (cdr sequence))
X	(setq count (1+ count))
X	;; Every 400 header requests we have to read stream in order
X	;;  to avoid deadlock.
X	(if (or (null sequence)		;All requests have been sent.
X		(zerop (% count nntp-maximum-request)))
X	    (progn
X	      (accept-process-output)
X	      (while (progn
X		       (goto-char last-point)
X		       ;; Count replies.
X		       (while (re-search-forward "^[0-9]" nil t)
X			 (setq received (1+ received)))
X		       (setq last-point (point))
X		       (< received count))
X		;; If number of headers is greater than 100, give
X		;;  informative messages.
X		(and (> number nntp-large-newsgroup)
X		     (zerop (% received 20))
X		     (message "NNTP: %d%% of headers received."
X			      (/ (* received 100) number)))
X		(nntp-accept-response))
X	      ))
X	)
X      ;; Wait for text of last command.
X      (goto-char (point-max))
X      (re-search-backward "^[0-9]" nil t)
X      (if (looking-at "^[23]")
X	  (while (progn
X		   (goto-char (- (point-max) 3))
X		   (not (looking-at "^\\.\r$")))
SHAR_EOF
echo "End of part 5, continue with part 6"
echo "6" > s2_seq_.tmp
exit 0