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: nntp-based news reader (again) (2 of 3)
Message-ID: <3681@flab.flab.fujitsu.JUNET>
Date: 16 Jun 88 05:49:50 GMT
References: <3680@flab.flab.fujitsu.JUNET>
Reply-To: umerin@flab.flab.fujitsu.JUNET (Masanobu UMEDA)
Organization: Fujitsu Laboratories Ltd., Kawasaki, Japan
Lines: 1480

---- Cut Here and unpack ----
#!/bin/sh
# this is part 2 of a multipart archive
# do not concatenate these parts, unpack them in order with /bin/sh
# file gnus.el continued
#
CurArch=2
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
echo "x - Continuing file gnus.el"
sed 's/^X//' << 'SHAR_EOF' >> gnus.el
X	    (bury-buffer gnus-Article-display-buffer))
X	(switch-to-buffer gnus-Group-display-buffer)
X	(delete-other-windows)
X	(gnus-Group-next-unread-group)
X	)))
X
X
X;;;
X;;; GNUS Article display mode
X;;;
X
X
X(if gnus-Article-mode-map
X    nil
X  (setq gnus-Article-mode-map (make-keymap))
X  (suppress-keymap gnus-Article-mode-map)
X  (define-key gnus-Article-mode-map " " 'scroll-up)
X  (define-key gnus-Article-mode-map "\177" 'scroll-down)
X  (define-key gnus-Article-mode-map "h" 'gnus-Article-show-subjects)
X  (define-key gnus-Article-mode-map "s" 'gnus-Article-show-subjects)
X  (define-key gnus-Article-mode-map "?" 'describe-mode)
X  (define-key gnus-Article-mode-map "q" 'gnus-Subject-exit)
X  (define-key gnus-Article-mode-map "Q" 'gnus-Subject-quit))
X
X(defun gnus-Article-mode ()
X  "Major mode for reading news articles.
XAll normal editing commands are turned off.
XInstead, these commands are available:
X\\{gnus-Article-mode-map}
X
XEntry to this mode calls the value of gnus-Article-mode-hook with no arguments,
Xif that value is non-nil."
X  (interactive)
X  (kill-all-local-variables)
X  (setq major-mode 'gnus-Article-mode)
X  (setq mode-name "GNUS")
X  (gnus-Article-set-mode-line)
X  (use-local-map gnus-Article-mode-map)
X  (setq buffer-read-only t)		;Disable modification
X  (run-hooks 'gnus-Article-mode-hook))
X
X(defun gnus-Article-setup-buffer ()
X  "Initialize article display buffer."
X  (save-excursion
X    (if (get-buffer gnus-Article-display-buffer)
X	nil
X      (set-buffer (get-buffer-create gnus-Article-display-buffer))
X      (gnus-Article-mode))
X    ))
X
X(defun gnus-Article-prepare (article &optional all-headers)
X  "Prepare ARTICLE in article display buffer.
XIf optional argument ALL-HEADERS is non-nil, all headers are inserted."
X  (save-excursion
X    (gnus-Article-setup-buffer)
X    (set-buffer gnus-Article-display-buffer)
X    (let ((buffer-read-only nil))
X      (erase-buffer)
X      (if (nntp-request-article article)
X	  (progn
X	    ;; Setup article buffer
X	    (gnus-copy-to-buffer (current-buffer))
X	    (gnus-Article-convert-format all-headers)
X	    ;; Set article pointer.
X	    (setq gnus-previous-article gnus-current-article)
X	    (setq gnus-current-article article)
X	    (if (not (eq gnus-previous-article gnus-current-article))
X		(gnus-Subject-mark-read gnus-current-article))
X	    ;; Next function must be called after setting
X	    ;;  `gnus-current-article' variable.
X	    (gnus-Article-set-mode-line)
X	    )
X	(gnus-Subject-mark-read article)
X	(error "No such article (may be canceled)."))
X      )))
X
X(defun gnus-Article-show-all-headers ()
X  "Show all article headers in article display buffer."
X  (gnus-Article-prepare gnus-current-article t))
X
X(defun gnus-Article-set-mode-line ()
X  "Set Article mode line string."
X  (setq mode-line-process
X	(concat " "
X		(if (integerp gnus-current-article)
X		    (int-to-string gnus-current-article)
X		  "??")
X		"/"
X		(if (integerp gnus-current-group-end)
X		    (int-to-string gnus-current-group-end)
X		  gnus-current-group-end)))
X  (setq mode-line-buffer-identification
X	(concat "GNUS: "
X		gnus-current-news-group
X		;; Enough spaces to pad group name to 17 positions.
X		(substring "                 "
X			   0 (max 0 (- 17 (length gnus-current-news-group))))))
X  (set-buffer-modified-p t)
X  (sit-for 0))
X
X(defun gnus-Article-convert-format (&optional all-headers)
X  "Beautify article text.
XIf optional argument ALL-HEADERS is non-nil, all of headers will be displayed."
X  (save-excursion
X    (save-restriction
X      (goto-char (point-min))
X      (let* ((start (point))
X	     (end (condition-case ()
X		      (progn (search-forward "\n\n") (point))
X		    (error nil)))
X	     (has-from nil)
X	     (has-date nil))
X	(if end
X	    (progn
X	      (narrow-to-region start end)
X	      (goto-char start)
X	      (setq has-from (search-forward "\nFrom:" nil t))
X	      (goto-char start)
X	      (setq has-date (search-forward "\nDate:" nil t))
X	      (if (and (not has-from) has-date)
X		  (progn
X		    (goto-char start)
X		    (search-forward "\nDate:")
X		    (beginning-of-line)
X		    (kill-line 1)))
X	      (if (not all-headers)
X		  (gnus-Article-delete-headers start))
X	      ))
X	))))
X
X(defun gnus-Article-delete-headers (pos)
X  "Delete unnecessary headers."
X  (goto-char pos)
X  (and (stringp gnus-ignored-headers)
X       (while (re-search-forward gnus-ignored-headers nil t)
X	 (beginning-of-line)
X	 (delete-region (point)
X			(progn (re-search-forward "\n[^ \t]")
X			       (forward-char -1)
X			       (point))))))
X
X;; Working on article's buffer
X
X(defun gnus-Article-next-page ()
X  "Show next page of current article.
XIf end of article, return T. Otherwise return nil."
X  (move-to-window-line -1)
X  (if (eobp)
X      t
X    (scroll-up)
X    nil
X    ))
X
X(defun gnus-Article-prev-page ()
X  "Show previous page of current article."
X  (scroll-down))
X
X(defun gnus-Article-next-digest ()
X  "Move to head of next digested message.
XSet mark at end of digested message."
X  (end-of-line)
X  (if (re-search-forward "^Subject:[ \t]" nil t)
X      (let ((begin (progn
X		     (beginning-of-line) (point))))
X	;; Search for end of this message.
X	(end-of-line)
X	(if (re-search-forward "^Subject:[ \t]" nil t)
X	    (progn
X	      (search-backward "\n\n")
X	      (forward-line 1))
X	  (goto-char (point-max)))
X	(push-mark)			;Set mark at end of digested message.
X	(goto-char begin)
X	;; Show From: and Subject: fields.
X	(recenter 1))
X    (message "End of message.")
X    ))
X
X(defun gnus-Article-prev-digest ()
X  "Move to head of previous digested message."
X  (beginning-of-line)
X  (if (re-search-backward "^Subject:[ \t]" nil t)
X      (let ((begin (point)))
X	;; Search for end of this message.
X	(end-of-line)
X	(if (re-search-forward "^Subject:[ \t]" nil t)
X	    (progn
X	      (search-backward "\n\n")
X	      (forward-line 1))
X	  (goto-char (point-max)))
X	(push-mark)			;Set mark at end of digested message.
X	(goto-char begin)
X	;; Show From: and Subject: fields.
X	(recenter 1))
X    (goto-char (point-min))
X    (message "Top of message.")
X    ))
X
X(defun gnus-Article-show-subjects ()
X  "Reconfigure windows in order to show subjects."
X  (interactive)
X  (pop-to-buffer gnus-Subject-display-buffer)
X  (delete-other-windows)
X  (gnus-Subject-configure-window))
X
X
X;;;
X;;; General functions.
X;;;
X
X(defun gnus-start-news-server (&optional ask-host)
X  "Open network stream to remote news server.
XIf optional argument ASK-HOST is non-nil, ask you host name that news
Xserver is running even if it is defined."
X  (if (nntp-server-active-p)
X      ;; Stream is already opened.
X      nil
X    ;; Open NNTP news server.
X    (if (or ask-host
X	    (null gnus-server-host))
X	(setq gnus-server-host
X	      (read-string "News Server host: " gnus-server-host)))
X    (if (string-equal gnus-server-host (system-name))
X	(progn
X	  ;; Use local news spool.
X	  (require 'nnspool)
X	  (message "Looking up local news spool"))
X      (message "Connecting to News Server on %s" gnus-server-host))
X    (if (null (nntp-open-server gnus-server-host))
X	(error "Cannot open News Server on %s" gnus-server-host))
X    ))
X
X(defun gnus-select-news-group (group &optional show-all)
X  "Select news GROUP.
XIf optional argument SHOW-ALL is non-nil, all of articles in the group
Xare selected."
X  (if (nntp-request-group group)
X      (let ((unread (assoc group gnus-unread-assoc)))
X	(setq gnus-current-news-group group)
X	(if show-all
X	    ;; Select all active articles.
X	    (let ((active (assoc group gnus-active-assoc)))
X	      (setq gnus-current-group-begin (car (nth 2 active)))
X	      (setq gnus-current-group-end (cdr (nth 2 active)))
X	      (setq gnus-current-group-articles
X		    (gnus-uncompress-sequence (nthcdr 2 active)))
X	      )
X	  ;; Select unread articles only.
X	  (setq gnus-current-group-begin (car (nth 2 unread)))
X	  (setq gnus-current-group-end (cdr (car (reverse (nthcdr 2 unread)))))
X	  (setq gnus-current-group-articles
X		(gnus-uncompress-sequence (nthcdr 2 unread)))
X	  )
X	;; Reset article pointer and etc.
X	(setq gnus-current-article nil)
X	(setq gnus-previous-article nil)
X	(setq gnus-current-group-unread-articles
X	      (gnus-uncompress-sequence (nthcdr 2 unread)))
X	(setq gnus-current-group-headers
X	      (nntp-retrieve-headers gnus-current-group-articles))
X	;; GROUP is successfully selected.
X	t
X	)
X    ))
X
X(defun gnus-clear-system ()
X  "Clear all variables and buffer."
X  ;; Clear variables.
X  (setq gnus-active-assoc nil)
X  (setq gnus-newsrc-assoc nil)
X  (setq gnus-unread-assoc nil)
X  ;; Kill buffers
X  (if (get-buffer gnus-Article-display-buffer)
X      (kill-buffer gnus-Article-display-buffer))
X  (if (get-buffer gnus-Subject-display-buffer)
X      (kill-buffer gnus-Subject-display-buffer))
X  (if (get-buffer gnus-Group-display-buffer)
X      (kill-buffer gnus-Group-display-buffer)))
X
X(defun gnus-copy-to-buffer (buffer &optional append)
X  "Copy server response to BUFFER (or buffer name).
XIf optional argument APPEND is non-nil, append to buffer."
X  (let ((buffer (get-buffer-create buffer)))
X    (set-buffer buffer)
X    (goto-char (point-max))
X    (save-excursion
X      (set-buffer nntp-server-buffer)
X      (if append
X	  (append-to-buffer buffer (point-min) (point-max))
X	(copy-to-buffer buffer (point-min) (point-max))))
X    ;; Return BUFFER itself.
X    buffer
X    ))
X
X(defun gnus-simplify-subject (subject)
X  "Remove `Re:' and words in parentheses."
X  ;; Remove `Re:'
X  (let ((case-fold-search t))		;Ignore case.
X    (if (string-match "\\`re: " subject)
X	(while (string-match "\\`re: " subject)
X	  (setq subject (substring subject 4))
X	  (if (string-match "\\`[ \t]+\\([^ \t].*\\)\\'" subject)
X	      (setq subject (substring subject (match-beginning 1))))
X	  ))
X    ;; Remove words in parentheses.
X    ;; (string-match "([ \t]*in[ \t]+.*)" subject)
X    (while (string-match "(.*)" subject)
X      (setq subject (concat (substring subject 0 (match-beginning 0))
X			    (substring subject (match-end 0))))
X      )
X    ;; Return subject string.
X    subject
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-active-assoc:
X;; (("general" t (1 . 1))
X;;  ("misc"    t (1 . 10))
X;;  ("test"  nil (1 . 99)) ...)
X;; GNUS internal format of gnus-unread-assoc:
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  (if (and gnus-active-assoc
X	   gnus-newsrc-assoc
X	   gnus-unread-assoc
X	   (not force))
X      (progn
X	;; Re-read active file only.
X	(gnus-read-active-file)
X	(gnus-add-new-news-group)
X	(gnus-get-unread-articles))
X    ;; Read .newsrc file and active file.
X    (gnus-read-newsrc-file)
X    (gnus-read-active-file)
X    (gnus-add-new-news-group)
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-server-host)))
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 nil)
X	(group-name nil)
X	(active nil)
X	(range nil)
X	(unread nil))
X    (message "Checking new news...")
X    (while read
X      (setq group (car read))		;About one news group
X      (setq group-name (car group))
X      (setq active (nth 2 (assoc group-name gnus-active-assoc)))
X      (if (and (not (null gnus-octive-assoc))
X	       (equal active (nth 2 (assoc group-name gnus-octive-assoc))))
X	  ;; There are no changes in this news group, so use old info.
X	  (setq unread (cons (assoc group-name gnus-unread-assoc) unread))
X	(setq range (gnus-difference-of-range active (nthcdr 2 group)))
X	(setq unread
X	      (cons (cons group-name	;Group name
X			  (cons (gnus-number-of-articles range)
X				range))	;Range of unread articles
X		    unread))
X	)
X      (setq read (cdr read))
X      )
X    (setq gnus-unread-assoc (nreverse unread))
X    (message "Checking new news... Done.")
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 news group."
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-headers-number header) unreads)
X	  ;; This article is not yet marked as read.
X	  nil
X	(setq xrefs (gnus-parse-xref-field (nntp-headers-xref header)))
X	;; For each cross reference info. on one Xref: field.
X	(while xrefs
X	  (let* ((xref (car xrefs))
X		 (group-xref (assoc (car xref) xref-list)))
X	    (if (string-equal group (car xref))
X		;; Ignore this group.
X		nil
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))
X			    xref-list)))
X	      ))
X	  (setq xrefs (cdr xrefs))
X	  ))
X      (setq headers (cdr headers)))
X    ;; Mark cross referenced articles as read.
X    (gnus-mark-xref-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 '(lambda (elt) (car elt)) 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-xref-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 (assoc group gnus-unread-assoc))))
X      (while idlist
X	(setq unread (delq (car idlist) unread))
X	(setq idlist (cdr idlist)))
X      (gnus-update-unread-articles group unread)
X      (setq xrefs (cdr xrefs))
X      )))
X
X(defun gnus-update-unread-articles (group unread-list)
X  "Update unread article information of news GROUP using UNREAD-LIST."
X  (let ((active (nth 2 (assoc group gnus-active-assoc)))
X	(unread (assoc group gnus-unread-assoc)))
X    ;; Update gnus-unread-assoc.
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    ))
X
X(defun gnus-compress-sequence (numbers)
X  "Convert list of sorted numbers to ranges."
X  (let* ((numbers (sort (copy-sequence numbers) '<)) ;Sort is destructive.
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-news-group ()
X  "Add new news group to gnus-newsrc-assoc."
X  (let ((active (reverse gnus-active-assoc))
X	(group nil))
X    (while active
X      (setq group (car (car active)))
X      (if (null (assoc group gnus-newsrc-assoc))
X	  ;; Found new news group.
X	  (let ((subscribe (not (or (string-equal group "control")
X				    (string-equal group "junk")))))
X	    (setq gnus-newsrc-assoc
X		  (cons (list group subscribe) gnus-newsrc-assoc))
X	    (gnus-update-newsrc-buffer group)
X	    (if subscribe
X		(message "New news group: %s is subscribed." group))
X	    ))
X      (setq active (cdr active))
X      )))
X
X;;(defun gnus-clean-up-newsrc ()
X;;  "Mark as read expired articles."
X;;  (let ((newsrc gnus-newsrc-assoc)
X;;	(group nil))
X;;    (message "Checking expired articles...")
X;;    (while newsrc
X;;      (setq group (car (car newsrc)))	;News group name
X;;      (setq newsrc (cdr newsrc))
X;;      (if (assoc group gnus-active-assoc) ;Must be active group
X;;	  (gnus-update-unread-articles
X;;	   group (gnus-uncompress-sequence
X;;		  (nthcdr 2 (assoc group gnus-unread-assoc)))))
X;;      )
X;;    (gnus-make-newsrc-buffer)
X;;    (message "Checking expired articles... Done.")
X;;    ))
X
X(defun gnus-delete-bogus-news-group (&optional confirm)
X  "Delete bogus news group.
XIf optional argument CONFIRM is non-nil, confirm deletion of news groups."
X  (let ((oldrc gnus-newsrc-assoc)
X	(newsrc nil))
X    (message "Checking bogus news groups...")
X    (while oldrc
X      (if (or (assoc (car (car oldrc)) gnus-active-assoc)
X	      (and confirm
X		   (not (y-or-n-p (format "Delete bogus news group: %s "
X					  (car (car oldrc)))))))
X	  ;; Active news group.
X	  (setq newsrc (cons (car oldrc) newsrc))
X	;; Found bogus news group.
X	(gnus-update-newsrc-buffer (car (car oldrc)) 'delete))
X      (setq oldrc (cdr oldrc))
X      )
X    ;; Update newsrc.
X    (setq gnus-newsrc-assoc (nreverse newsrc))
X    (message "Checking bogus news groups... Done.")
X    ))
X
X(defun gnus-read-active-file ()
X  "Get active file from news server."
X  (save-excursion
X    (message "Reading active file...")
X    (if (nntp-request-list)		;Get active file from server
X	(progn
X	  ;; Save OLD active info.
X	  (setq gnus-octive-assoc gnus-active-assoc)
X	  ;; Take care of unexpected situations.
X	  (gnus-copy-to-buffer " *GNUS-active*")
X	  (goto-char (point-min))
X	  (gnus-active-to-gnus-format)
X	  ;; Define variable gnus-active-assoc.
X	  (eval-current-buffer)
X	  (kill-buffer (current-buffer))
X	  (message "Reading active file... Done.")
X	  )
X      (error "Cannot read active file from news server."))
X    ))
X
X(defun gnus-active-to-gnus-format ()
X  "Convert NNTP active file format to internal format.
XBuffer becomes evaluable as lisp expression."
X  ;; Delete unnecessary lines.
X  (goto-char (point-min))
X  (delete-matching-lines "^to\\..*$")
X  ;; Process each lines.
X  (goto-char (point-min))
X  (while (not (eobp))
X    (if (re-search-forward "^\\([^ \t]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([ymn]\\).*$" nil t)
X	(replace-match
X	 (concat "(\"\\1\""
X		 (if (string-equal "y" (buffer-substring (match-beginning 4)
X							 (match-end 4)))
X		     " t " " nil ")
X		 "(\\3 . \\2))"))
X      (error "Active format error."))
X    (forward-line 1))
X  ;; Make the buffer evaluable.
X  (goto-char (point-min))
X  (insert "(setq gnus-active-assoc '(\n")
X  (goto-char (point-max))
X  (insert "))\n")
X  )
X
X(defun gnus-read-newsrc-file ()
X  "Read in .newsrc FILE."
X  (save-excursion
X    ;; If there exists site dependent .newsrc file (.newsrc-HOST), use
X    ;;  it instead of standard .newsrc file.
X    (setq gnus-current-startup-file (gnus-make-newsrc-file gnus-startup-file))
X    (let* ((newsrc-file gnus-current-startup-file)
X	   (quick-file (concat newsrc-file ".el"))
X	   (newsrc-mod (nth 5 (file-attributes newsrc-file)))
X	   (quick-mod (nth 5 (file-attributes quick-file))))
X      ;; Reset variables.
X      (setq gnus-newsrc-options nil)
X      (setq gnus-newsrc-assoc nil)
X      (cond ((not (file-exists-p newsrc-file)))
X	    ;; Some older version does not support function
X	    ;;  `file-newer-than-file-p'.
X	    ((and newsrc-mod quick-mod
X		  ;; .newsrc.el is newer than .newsrc.
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		  ;; Load quick .newsrc
X		  (condition-case nil
X		      (progn (load-file quick-file) (message "") t)
X		    (error nil))
X		  gnus-newsrc-assoc
X		  ))
X	    (t
X	     (message "Reading %s..." newsrc-file)
X	     (set-buffer (get-buffer-create " *GNUS-newsrc*"))
X	     (erase-buffer)
X	     (insert-file-contents newsrc-file)
X	     (gnus-newsrc-to-gnus-format)
X	     ;; Define variable gnus-newsrc-assoc.
X	     (condition-case nil
X		 (eval-current-buffer)
X	       (error
X		(error "Too complicated, or erroneous lines included in %s"
X		       newsrc-file))
X	       )
X	     (kill-buffer (current-buffer))
X	     (message "Reading %s... Done." newsrc-file))
X	    ))))
X
X(defun gnus-newsrc-to-gnus-format ()
X  "Convert newsrc format to gnus internal format.
XBuffer becomes evaluable as lisp expression."
X  ;; Make it easy to edit.
X  (goto-char (point-min))
X  (replace-regexp "$" " ")
X  (goto-char (point-min))
X  (replace-string "," " , ")
X  ;; Make sure .newsrc file is formated in standard way.
X  (goto-char (point-min))
X  (replace-string ":" ": ")
X  (goto-char (point-min))
X  (replace-string "!" "! ")
X  ;; Save options line to variable.
X  (goto-char (point-min))
X  (if (re-search-forward "^options[ \t]*\\(.*[^ \t]\\)[ \t]*$" nil t)
X      (progn
X	(setq gnus-newsrc-options (buffer-substring (match-beginning 1)
X						    (match-end 1)))
X	;; Delete options line.
X	(beginning-of-line)
X	(kill-line 1)			;Kill just one line.
X	))
X  ;; num -> (num . num)
X  (goto-char (point-min))
X  (replace-regexp "[ \t]\\([0-9]+\\)[ \t]" "(\\1 . \\1)")
X  ;; num1-num2 -> (num1 . num2)
X  (goto-char (point-min))
X  (while (re-search-forward "[ \t]\\([0-9]+\\)-\\([0-9]+\\)[ \t]" nil t)
X    (replace-match "(\\1 . \\2)")
X    ;; Need retry on this line.
X    (beginning-of-line))
X  ;; Delete ','.
X  (goto-char (point-min))
X  (replace-string "," " ")
X  ;; Put range of read article in list form.
X  (goto-char (point-min))
X  (replace-regexp "\\(^.*[!:][ ]*\\)\\(.*\\)$" "\\1(\\2)")
X  ;; Process Subscribed news group.
X  (goto-char (point-min))
X  (replace-regexp "\\(^.*\\):\\(.*\\)$" "(\"\\1\" t . \\2)")
X  ;; Process UnSubscribed news group.
X  (goto-char (point-min))
X  (replace-regexp "\\(^.*\\)!\\(.*\\)$" "(\"\\1\" nil . \\2)")
X  ;; Make the buffer evaluable.
X  (goto-char (point-min))
X  (insert "(setq gnus-newsrc-assoc '(\n")
X  (goto-char (point-max))
X  (insert "))\n")
X  )
X
X(defun gnus-save-newsrc-file ()
X  "Save to .newsrc FILE."
X  (if gnus-newsrc-assoc
X      (save-excursion
X	;; If there exists site dependent .newsrc file (.newsrc-HOST), use
X	;;  it instead of standard .newsrc file.
X	(message "Saving %s..." gnus-current-startup-file)
X	(set-buffer (find-file-noselect gnus-current-startup-file))
X	(let ((make-backup-files t)
X	      (version-control nil))
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	(erase-buffer)
X	(gnus-gnus-to-quick-newsrc-format)
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 (find-file-noselect gnus-current-startup-file))
X    (goto-char (point-min))
X    (if (re-search-forward (concat "^" (regexp-quote group) "[:!]") nil t)
X	(progn
X	  ;; Delete old info.
X	  (beginning-of-line)
X	  (kill-line 1)
X	  ))
X    (if (not delete)
X	(let ((newsrc (assoc group gnus-newsrc-assoc)))
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(defun gnus-gnus-to-quick-newsrc-format ()
X  "Insert gnus-newsrc-assoc as evaluable format."
X  ;; Save options line.
X  (if gnus-newsrc-options
X      (insert "(setq gnus-newsrc-options \"" gnus-newsrc-options "\")\n"))
X  ;; Save newsrc assoc list.
X  (insert "(setq gnus-newsrc-assoc '")
X  (insert (prin1-to-string gnus-newsrc-assoc))
X  (insert ")"))
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;;(defun gnus-make-newsrc-buffer ()
X;;  "Update .newsrc buffer completely."
X;;  (save-excursion
X;;    (set-buffer (find-file-noselect gnus-current-startup-file))
X;;    (erase-buffer)
X;;    (gnus-gnus-to-newsrc-format)
X;;    ))
X;;
X;;(defun gnus-gnus-to-newsrc-format ()
X;;  "Convert gnus-newsrc-assoc to .newsrc format."
X;;  (let ((newsrc gnus-newsrc-assoc)
X;;	(group nil))
X;;    ;; Options line.
X;;    (if gnus-newsrc-options
X;;	(insert "options " gnus-newsrc-options "\n"))
X;;    ;; Article information.
X;;    (while newsrc
X;;      (setq group (car newsrc))
X;;      (insert (car group)		;Group name
X;;	      (if (nth 1 group)		;Subscribed?
X;;		  ": " "! "))
X;;      (gnus-ranges-to-newsrc-format (nthcdr 2 group)) ;Read articles
X;;      (insert "\n")
X;;      (setq newsrc (cdr newsrc))
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 JUNET.
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 JUNET? ")
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 (= 0 (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	  (erase-buffer)
X	  (and subject
X	       (progn (if (string-match "\\`Re: " subject)
X			  (while (string-match "\\`Re: " subject)
X			    (setq subject (substring subject 4))))
X		      (setq subject (concat "Re: " subject))))
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 JUNET 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 JUNET? ")
X      (let ((buffer (current-buffer))
X	    (subject nil)
X	    (newsgroups nil)
X	    (distribution nil))
X	(save-restriction
X	  (and (not (= 0 (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	(erase-buffer)
X	;; Ask newsgroups, subject and distribution if you are a
X	;;  novice user.
X	;; Suggested by yuki@flab.fujitsu.junet.
X	(if gnus-novice-user
X	    (progn
X	      ;; Subscribed news group names are required for
X	      ;;  completing read of news group.
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	      (setq subject (read-string "Subject: "))
X	      (setq distribution (substring newsgroups 0
X					    (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 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	)
X    (message "")))
X
X;; `news-inews' in `newspost.el' is re-defined.
X
X(defun news-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-active-p)))
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 news server.
X      ;; News 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      (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 JUNET...")
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)
X	  (message "Posting to JUNET... 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 news server is opened by `news-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 ()
X  "NNTP inews interface."
X  (let ((signature (expand-file-name "~/.signature" nil))
X	(distribution nil)
X	(lines nil))
X    (save-excursion
X      (copy-to-buffer " *GNUS-posting*" (point-min) (point-max))
X      (set-buffer " *GNUS-posting*")
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      ;; Count lines of article body.
X      (goto-char (point-min))
X      (search-forward "\n\n")
X      (setq lines (count-lines (point) (point-max)))
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 lines))
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]*|\\(.*\\)\\'" 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	       ;;(message "Piping out article to program: %s" program)
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	     ;;(message "Saving article copy to file: %s"
X	     ;;	      gnus-author-copy-file)
X	     ;; Save article in Unix mail format.
X	     ;; This is much convenient for Emacs user.
X	     (rmail-output gnus-author-copy-file)))
X      ;; Post 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-control-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 (concat (gnus-inews-login-name) "@"
X					       (gnus-inews-domain-name)))))
X	  (message "The article's not yours.")
X	;; Make control article.
X	(set-buffer (get-buffer-create " *GNUS-posting*"))
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 0)
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	  (message "Failed to cancel your article."))
X	(kill-buffer (current-buffer))
X	))
X    ))
X
X(defun gnus-inews-insert-headers (lines)
X  "Prepare article headers."
X  (save-excursion
X    (let* ((login-name (gnus-inews-login-name))
X	   (domain-name (gnus-inews-domain-name))
X	   (full-name (or (getenv "NAME")
X			  (user-full-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 login-name))
X	   (organization (or (getenv "ORGANIZATION")
X			     gnus-your-organization)))
X      ;; Insert from top of headers.
X      (goto-char (point-min))
X      (insert "Path: " gnus-server-host "!" login-name "\n"
X	      "From: " login-name "@" domain-name
X	      (if (or (string-equal full-name "")
X		      (string-equal full-name "&"))
X		  "\n"
X		(concat " (" 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	      "Date: " (gnus-inews-date) "\n"
X	      "Organization: " organization "\n"
X	      "Lines: " (int-to-string lines) "\n"
X	      )
X      (or (mail-fetch-field "distribution")
X	  (insert "Distribution: \n"))
X      )))
X
X(defun gnus-inews-login-name ()
X  "Return user's login name."
X  (or (getenv "USER")
X      (getenv "LOGNAME")
X      (user-login-name)))
X
X(defun gnus-inews-domain-name ()
X  "Return user's domain name"
X  (let ((domain (or (getenv "DOMAINNAME")
X		    gnus-your-domain)))
X    (if (or (null domain)
X	    (string-equal domain ""))
X	(progn
X	  (setq domain (read-string "Your domain name (no host): "))
X	  (setq gnus-your-domain domain)))
X    (concat (system-name)
X	    ;; Host name and domain name must be separated by
X	    ;;  one period `.'.
X	    (if (string-equal "." (substring domain 0 1)) "" ".")
X	    domain
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 "GNUS: cannot understand current-time-string: %s." date))
X    ))
X
X(defun gnus-inews-date ()
X  "News format date string of today."
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		(gnus-unix-time-to-gmtime
X		 gnus-your-time-zone
X		 (substring date (match-beginning 3) (match-end 3))) ;Time
X		" GMT")
X      (error "GNUS: cannot understand current-time-string: %s." date))
X    ))
X
X(defun gnus-unix-time-to-gmtime (time-zone time)
X  "Convert unix time to GM time."
X  (if (string-match "^\\([0-9]+\\):\\(.*\\)$" time)
X      (concat
X       (format "%02d"
X	       (+ time-zone (string-to-int (substring time
X						      (match-beginning 1)
X						      (match-end 1)))))
X       ":"
X       (substring time
X		  (match-beginning 2)
X		  (match-end 2)))
X    (error "GNUS: cannot understand `%s' as unix time format." time)
X    ))
X
X
X;;Local variables:
X;;eval: (put 'eval-in-buffer-window 'lisp-indent-hook 1)
X;;end:
SHAR_EOF
echo "File gnus.el is complete"
chmod 0444 gnus.el || echo "restore of gnus.el fails"
set `wc -c gnus.el`;Sum=$1
if test "$Sum" != "89395"
then echo original size 89395, current size $Sum;fi
echo "x - extracting nntp.el (Text)"
sed 's/^X//' << 'SHAR_EOF' > nntp.el &&
X;;; NNTP (RFC977) Interface for GNU Emacs
X;; Copyright (C) 1987, 1988 Fujitsu Laboratoris LTD.
X;; Copyright (C) 1987, 1988 Masanobu UMEDA (umerin@flab.flab.Fujitsu.JUNET)
X;; $Header: nntp.el,v 3.4 88/06/16 14:37: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 NNTP
X;;  package.
X
X;; Trouble shooting of NNTP
X;;
X;; (1) Select routine may signal an error or fall into infinite loop
X;;  while waiting for server response. In this case, you'd better not
X;;  use byte-compiled code but original source. If you still have a
X;;  trouble with it, set variable `nntp-buggy-select' to T.
X;;
X;; (2) Emacs may hang while retrieving headers since too many requests
X;;  have been sent to news server without reading their replies. In
X;;  this case, reduce number of requests sent to the server at once by
X;;  setting smaller value to `nntp-maximum-request'.
X
X(provide 'nntp)
X
X(defvar nntp-server-hook nil
X  "*Hooks for NNTP news server.
XIf Kanji code of news server is different from local kanji code, you
Xhave to put the following code in your .emacs file:
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
X(defvar nntp-buggy-select (memq system-type '(usg-unix-v fujitsu-uts))
X  "*T if select routine is buggy.
XIf select routine signals error or fall into infinite loop while
Xwaiting for server response, the value must be set to T.
XIn case of Fujitsu UTS it is set to T since `accept-process-output'
Xdoesn't work properly.")
X
X(defvar nntp-maximum-request 400
X  "*Maximum number of requests sent to news server at once.
XIf Emacs hangs while retrieving headers, set smaller value than the default.")
X
X(defvar nntp-server-buffer nil
X  "Buffer associated with NNTP news server process.")
X
X(defvar nntp-server-process nil
X  "NNTP news 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 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-headers-number (headers)
X  "Return article number in HEADERS."
X  (` (car (, headers))))
X
X(defmacro nntp-headers-subject (headers)
X  "Return subject string in HEADERS."
X  (` (nth 1 (, headers))))
X
X(defmacro nntp-headers-from (headers)
X  "Return author string in HEADERS."
X  (` (nth 2 (, headers))))
X
X(defmacro nntp-headers-xref (headers)
X  "Return xref string in HEADERS."
X  (` (nth 3 (, headers))))
X
X(defmacro nntp-headers-lines (headers)
X  "Return lines in HEADERS."
X  (` (nth 4 (, headers))))
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) ...)'.
XAccess macros to contents of the list is defined as `nntp-headers-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	  (from nil)
X	  (xref nil)
X	  (lines 0))
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		(if (and (> number 100)
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]")
X      (if (looking-at "^[23]")
X	  (while (progn
X		   (goto-char (- (point-max) 3))
X		   (not (looking-at "^\\.\r$")))
X	    (nntp-accept-response)
X	    ))
X      (if (> number 100)
X	  (message "NNTP: 100%% of headers received."))
X      ;; Now all of replies are received.
X      ;; First, delete unnecessary lines.
SHAR_EOF
echo "End of part 2"
echo "File nntp.el is continued in part 3"
echo "3" > s2_seq_.tmp
exit 0
-- 
Masanobu UMEDA
umerin@flab.flab.Fujitsu.JUNET
umerin%flab.flab.Fujitsu.JUNET@uunet.uu.NET