Path: utzoo!attcan!uunet!kddlab!ccut!ascgw!fgw!flab!umerin
From: umerin@flab.flab.fujitsu.JUNET (Masanobu UMEDA)
Newsgroups: comp.emacs
Subject: Good GNUS version 3 (2 of 2)
Message-ID: <3511@flab.flab.fujitsu.JUNET>
Date: 25 May 88 04:21:52 GMT
Reply-To: umerin@flab.flab.fujitsu.JUNET (Masanobu UMEDA)
Distribution: comp
Organization: Fujitsu Laboratories Ltd., Kawasaki, Japan
Lines: 515
Posted: Wed May 25 13:21:52 1988

: This is a shar archive.  Extract with sh, not csh.
: The rest of this file will extract:
: nntp.el
echo x nntp.el
sed 's/^X//' > nntp.el << '*-*-END-of-nntp.el-*-*'
X;;; NNTP (RFC977) Interface for GNU Emacs
X;; Copyright (C) 1987, 1988 Fujitsu Laboratoris LTD.
X;; Copyrigth (C) 1987, 1988 Masanobu UMEDA (umerin@flab.flab.Fujitsu.JUNET)
X;; $Header: nntp.el,v 3.0 88/05/25 12:55:09 umerin Locked $
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;; Select routine may signal an error or fall into infinite loop while
X;;  waiting for server response. In this case, you'd better not use
X;;  byte-compiled code but original source. If you still have a
X;;  trouble with it, set variable `nntp-buggy-select' to T.
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-server-process nil
X  "NNTP news server process.")
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(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) ...)'.
XNews group must be selected before calling me."
X  (save-excursion
X    (set-buffer (process-buffer nntp-server-process))
X    (erase-buffer)
X    (let ((number (length sequence))
X	  (headers nil)			;Hold result list
X	  (article 0)
X	  (subject nil)
X	  (xref nil)
X	  (from nil)
X	  (last-point (point-min))
X	  (count 0))
X      ;; Send HEAD command.
X      (while sequence
X	(nntp-send-strings-to-server "HEAD" (car sequence))
X	(setq sequence (cdr sequence))
X	;; Every 200 header requests we have to read stream in order
X	;;  to avoid deadlock.
X	(setq count (1+ count))
X	(if (zerop (% count 200))
X	    (nntp-accept-response))
X	)
X      ;; Wait for completion of reply.
X      ;; We cannot do
X      ;;(nntp-accept-response)
X      ;;  since all of replies may be accepted.
X      (accept-process-output)
X      (setq count 0)
X      (while (progn
X	       (goto-char last-point)
X	       (setq count (+ count (nntp-count-reply "^[0-9]")))
X	       (< count number))
X	(setq last-point (point))
X	;; If number of headers is greater than 100, give informative
X	;;  messages.
X	(if (and (> number 100)
X		 (zerop (% count 20)))
X	    (message "NNTP: %d%% of headers received."
X		     (/ (* count 100) number)))
X	(nntp-accept-response))
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 recieved.
X      ;; First, delete unnecessary lines.
X      (goto-char (point-min))
X      (delete-non-matching-lines
X       "^Subject:[ \t]\\|^Xref:[ \t]\\|^From:[ \t]\\|^[23]")
X      ;; Then examines replies.
X      (while (not (eobp))
X	(cond ((looking-at "^[23].*[ \t]+\\([0-9]+\\)[ \t]+") ;Article exists.
X	       (setq article (string-to-int
X			      (buffer-substring (match-beginning 1)
X						(match-end 1))))
X	       (forward-line 1)
X	       (setq subject nil)
X	       (setq xref nil)
X	       (setq from nil)
X	       ;; It is better to extract From:, Subject: and Xref:
X	       ;;  field values in this order.
X	       (while (looking-at "^[^23]")
X		 (if (looking-at "^From:[ \t]\\(.*\\)\r$")
X		     (progn
X		       ;; Extract From: field.
X		       (setq from (buffer-substring (match-beginning 1)
X						    (match-end 1)))
X		       (forward-line 1)))
X		 (if (looking-at "^Subject:[ \t]\\(.*\\)\r$")
X		     (progn
X		       ;; Extract Subject: field.
X		       (setq subject (buffer-substring (match-beginning 1)
X						       (match-end 1)))
X		       (forward-line 1)))
X		 (if (looking-at "^Xref:[ \t]\\(.*\\)\r$")
X		     (progn
X		       ;; Extract Xref: field.
X		       (setq xref (buffer-substring (match-beginning 1)
X						    (match-end 1)))
X		       (forward-line 1)))
X		 )
X	       (if (null subject)
X		   (setq subject "(None)"))
X	       (if (null from)
X		   (setq from "Unknown User"))
X	       (setq headers
X		     (cons (list article subject from xref) headers))
X	       )
X	      (t
X	       (error "NNTP: Recieve error on line: %s"
X		      (buffer-substring
X		       (point)
X		       (save-excursion (end-of-line) (point))))
X	       )))
X      (nreverse headers)
X      )))
X
X(defun nntp-count-reply (regexp)
X  "Count matches for REGEXP from point."
X  (let ((count 0))
X    (while (and (not (eobp))
X		(re-search-forward regexp nil 'move))
X      (setq count (1+ count))
X      )
X    ;; Return count
X    count
X    ))
X
X
X;;;
X;;; Raw Interface to Network News Transfer Protocol (RFC977)
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
X		  (getenv "NNTPSERVER")
X		  (error "NNTP: no server host is specified."))))
X    (if (nntp-open-server-internal host service)
X	(progn
X	  ;; Do check unexpected close of connection.
X	  ;; Suggested by feldmark@hanako.stars.flab.fujitsu.junet.
X	  (set-process-sentinel nntp-server-process 'nntp-default-sentinel)
X	  (nntp-wait-for-response "^[23].*\r$")
X	  ))
X    ))
X
X(defun nntp-close-server ()
X  "Close news server."
X  (unwind-protect
X      (progn
X	;; Un-set default sentinel function before closing connection.
X	(if (eq 'nntp-default-sentinel
X		(process-sentinel nntp-server-process))
X	    (set-process-sentinel nntp-server-process nil))
X	;; We cannot send QUIT command unless the process is running.
X	(if (memq (process-status nntp-server-process) '(run open))
X	    (nntp-send-command nil "QUIT"))
X	)
X    (nntp-close-server-internal)
X    ))
X
X(fset 'nntp-request-quit (symbol-function 'nntp-close-server))
X
X(defun nntp-request-article (id)
X  "Select article by message ID (or number)."
X  (prog1
X      (nntp-send-command "^\\.\r$" "ARTICLE" id)
X    (nntp-decode-text)
X    ))
X
X(defun nntp-request-body (id)
X  "Select article body by message ID (or number)."
X  (prog1
X      (nntp-send-command "^\\.\r$" "BODY" id)
X    (nntp-decode-text)
X    ))
X
X(defun nntp-request-head (id)
X  "Select article head by message ID (or number)."
X  (prog1
X      (nntp-send-command "^\\.\r$" "HEAD" id)
X    (nntp-decode-text)
X    ))
X
X(defun nntp-request-stat (id)
X  "Select article by message ID (or number)."
X  (nntp-send-command "^[23].*\r$" "STAT" id))
X
X(defun nntp-request-group (group)
X  "Select news GROUP."
X  ;; 1.2a NNTP's group command is buggy. "^M" (\r) is not appended to
X  ;;  end of the status message.
X  (nntp-send-command "^[23].*$" "GROUP" group))
X
X(defun nntp-request-list ()
X  "List valid newsgoups."
X  (prog1
X      (nntp-send-command "^\\.\r$" "LIST")
X    (nntp-decode-text)
X    ))
X
X(defun nntp-request-last ()
X  "Set current article pointer to the previous article
Xin the current news group."
X  (nntp-send-command "^[23].*\r$" "LAST"))
X
X(defun nntp-request-next ()
X  "Advance current article pointer."
X  (nntp-send-command "^[23].*\r$" "NEXT"))
X
X(defun nntp-request-post ()
X  "Post a new news in current buffer."
X  (if (nntp-send-command "^[23].*\r$" "POST")
X      (progn
X	(nntp-encode-text)
X	(nntp-send-region-to-server (point-min) (point-max))
X	;; 1.2a NNTP's post command is buggy. "^M" (\r) is not
X	;;  appended to end of the status message.
X	(nntp-wait-for-response "^[23].*$")
X	)))
X
X(defun nntp-default-sentinel (proc status)
X  "Default sentinel function for NNTP server process."
X  (if (and nntp-server-process
X	   (eq (process-status nntp-server-process) 'closed))
X      (error "NNTP: Connection closed.")
X    ))
X
X;; Encoding and decoding of NNTP text.
X
X(defun nntp-decode-text ()
X  "Decode text transmitted by NNTP.
X1. Delete `^M' at end of line.
X2. Delete `.' at end of buffer (end of text mark).
X3. Delete `.' at beginning of line."
X  (save-excursion
X    (set-buffer (process-buffer nntp-server-process))
X    ;; Insert newline at end of buffer.
X    (goto-char (point-max))
X    (if (not (bolp))
X	(insert "\n"))
X    ;; Delete `^M' at end of line.
X    (goto-char (point-min))
X    ;; (replace-regexp "\r$" "")
X    (while (not (eobp))
X      (end-of-line)
X      (forward-char -1)
X      (if (looking-at "\r$")
X	  (delete-char 1))
X      (forward-line 1)
X      )
X    ;; Delete `.' at end of buffer (end of text mark).
X    (goto-char (point-max))
X    (forward-line -1)
X    (beginning-of-line)
X    (if (looking-at "^\\.$")
X	(kill-line 1))
X    ;; Replace `..' at beginning of line with `.'.
X    (goto-char (point-min))
X    ;; (replace-regexp "^\\.\\." ".")
X    (while (not (eobp))
X      (if (looking-at "^\\.\\.")
X	  (delete-char 1))
X      (forward-line 1)
X      (beginning-of-line))
X    ))
X
X(defun nntp-encode-text ()
X  "Encode text in current buffer for NNTP transmission.
X1. Insert `.' at beginning of line.
X2. Insert `.' at end of buffer (end of text mark)."
X  (save-excursion
X    ;; Insert newline at end of buffer.
X    (goto-char (point-max))
X    (if (not (bolp))
X	(insert "\n"))
X    ;; Replace `.' ad beginning of line with `..'.
X    (goto-char (point-min))
X    ;; (replace-regexp "^\\." "..")
X    (while (not (eobp))
X      (if (looking-at "^\\.")
X	  (insert "."))
X      (forward-line 1)
X      (beginning-of-line))
X    ;; Insert `.' at end of buffer (end of text mark).
X    (goto-char (point-max))
X    (insert ".\n")
X    ))
X
X
X;;;
X;;; Synchronous Communication with NNTP Server
X;;;
X
X(defun nntp-send-command (response cmd &rest args)
X  "Wailt for server RESPONSE after sending CMD and optional ARGS to
Xnews server."
X  (save-excursion
X    ;; Clear communication buffer.
X    (set-buffer (process-buffer nntp-server-process))
X    (erase-buffer)
X    (apply 'nntp-send-strings-to-server cmd args)
X    (if response
X	(nntp-wait-for-response response)
X      t)
X    ))
X
X(defun nntp-wait-for-response (regexp)
X  "Wait for server response which matches REGEXP."
X  (save-excursion
X    (let ((status t)
X	  (wait t))
X      (set-buffer (process-buffer nntp-server-process))
X      ;; Wait for status response (RFC977).
X      ;; 1xx - Informative message.
X      ;; 2xx - Command ok.
X      ;; 3xx - Command ok so far, send the rest of it.
X      ;; 4xx - Command was correct, but couldn't be performed for some
X      ;;       reason.
X      ;; 5xx - Command unimplemented, or incorrect, or a serious
X      ;;       program error occurred.
X      (nntp-accept-response)
X      (while wait
X	(goto-char (point-min))
X	(cond ((looking-at "[23]")
X	       (setq wait nil))
X	      ((looking-at "[45]")
X	       (setq status nil)
X	       (setq wait nil))
X	      (t (nntp-accept-response))
X	      ))
X      (if status
X	  (progn
X	    (setq wait t)
X	    (while wait
X	      (goto-char (point-max))
X	      (forward-line -1)
X	      (beginning-of-line)
X	      ;;(message (buffer-substring
X	      ;;	 (point)
X	      ;;	 (save-excursion (end-of-line) (point))))
X	      (if (looking-at regexp)
X		  (setq wait nil)
X		(message "NNTP: Reading...")
X		(nntp-accept-response)
X		(message "")
X		))
X	    ;; Successfully recieved server response.
X	    t
X	    ))
X      )))
X
X
X;;;
X;;; Low-Level Interface to NNTP Server
X;;; 
X
X(defun nntp-send-strings-to-server (&rest strings)
X  "Send list of STRINGS to news server as command and its arguments."
X  (let ((cmd (car strings))
X	(strings (cdr strings)))
X    ;; Command and each argument must be separeted by one or more spaces.
X    (while strings
X      (setq cmd (concat cmd " " (car strings)))
X      (setq strings (cdr strings)))
X    ;; Command line must be terminated by a CR-LF.
X    (process-send-string nntp-server-process (concat cmd "\n"))
X    ))
X
X(defun nntp-send-region-to-server (begin end)
X  "Send current buffer region (from BEGIN to END) to news server."
X  (save-excursion
X    (save-excursion
X      ;; Clear communication buffer.
X      (set-buffer (process-buffer nntp-server-process))
X      (erase-buffer))
X    (copy-to-buffer (process-buffer nntp-server-process) begin end)
X    ;; We have to work on the buffer associated with NNTP server
X    ;;  process because of NEmacs hack.
X    (set-buffer (process-buffer nntp-server-process))
X    (setq begin (point-min))
X    (setq end (point-max))
X    ;; `process-send-region' does not work if text to be sent is very
X    ;;  large. I don't know maximum size of text sent correctly.
X    (let ((last nil)
X	  (size 100))			;Size of text sent at once.
X      (save-restriction
X	(narrow-to-region begin end)
X	(goto-char begin)
X	(while (not (eobp))
X	  ;;(setq last (min end (+ (point) size)))
X	  ;; NEmacs gets confused if character at `last' is Kanji.
X	  (setq last (save-excursion
X		       (goto-char (min end (+ (point) size)))
X		       (or (eobp) (forward-char 1)) ;Adjust point
X		       (point)))
X	  (process-send-region nntp-server-process (point) last)
X	  ;; I don't know whether the next codes solve the known
X	  ;;  problem of communication error of GNU Emacs.
X	  (accept-process-output)
X	  ;;(sit-for 0)
X	  (goto-char last)
X	  )))
X    ;; We cannot erase buffer, because reply may be received.
X    (delete-region begin end)
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    ;; Initialize communication buffer.
X    (set-buffer (get-buffer-create " *nntpd*"))
X    (kill-all-local-variables)
X    (erase-buffer)
X    (setq nntp-server-process
X	  (open-network-stream "nntpd" (current-buffer)
X			       host (or service "nntp")))
X    ;; You can change kanji-fileio-code in hooks.
X    (run-hooks 'nntp-server-hook)
X    ;; Return the server process.
X    nntp-server-process
X    ))
X
X(defun nntp-close-server-internal ()
X  "Close connection to news server."
X  (delete-process nntp-server-process)
X  (setq nntp-server-process nil))
X
X(defun nntp-accept-response ()
X  "Read response of server.
XIt is known that communication speed will be improved much by defining
Xthis function as macro."
X  (if nntp-buggy-select
X      (progn
X	;; We cannot use `accept-process-output'.
X	(message "NNTP: Reading...")
X	(sleep-for 1)
X	(message ""))
X    (accept-process-output nntp-server-process)
X    ))
*-*-END-of-nntp.el-*-*
-- 
Masanobu UMEDA
umerin@flab.flab.Fujitsu.JUNET
umerin%flab.flab.Fujitsu.JUNET@uunet.uu.NET