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

---- 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 nnspool.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' >> nnspool.el
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    			 "-h")
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"
X			  (buffer-substring (point-min) (point-max))))
X      ;; Make status message by unfolding lines.
X      (subst-char-in-region (point-min) (point-max) ?\n ?\\ 'noundo)
X      (setq nntp-status-message-string
X	    (buffer-substring (point-min) (point-max)))
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 0644 nnspool.el || echo "restore of nnspool.el fails"
set `wc -c nnspool.el`;Sum=$1
if test "$Sum" != "11173"
then echo original size 11173, current size $Sum;fi
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.7 88/11/11 14:56:50 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;; (3) If 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 it in the future
X;;  release.
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
XIf you'd like to change something depending on server in this hook,
Xuse variable `nntp-server-name'.")
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
X(defconst nntp-version "NNTP 3.7"
X  "Version numbers of this version of NNTP.")
X
X(defvar nntp-server-name nil
X  "Host name of NNTP server.")
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-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		(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.
X      (goto-char (point-min))
X      (delete-non-matching-lines
X       "^Subject:\\|^Xref:\\|^From:\\|^Lines:\\|^Date:\\|^[23]")
X      (if (> number 100)
X	  (message "NNTP: Parsing headers..."))
X      ;; Then examines replies.
X      (while (not (eobp))
X	(cond ((looking-at "^[23].*[ \t]+\\([0-9]+\\)[ \t]+\\(<.+>\\)")
X	       (setq article
X		     (string-to-int
X		      (buffer-substring (match-beginning 1) (match-end 1))))
X	       (setq message-id
X		     (buffer-substring (match-beginning 2) (match-end 2)))
X	       (forward-line 1)
X	       ;; Set default value.
X	       (setq subject nil)
X	       (setq xref nil)
X	       (setq from nil)
X	       (setq lines 0)
X	       (setq date nil)
X	       ;; It is better to extract From:, Subject:, Date:,
X	       ;;  Lines: and Xref: field values in *THIS* order.
X	       ;; Forward-line each time after getting expected value
X	       ;;  in order to reduce count of string matching.
X	       (while (looking-at "^[^23]")
X		 (if (looking-at "^From:[ \t]\\(.*\\)\r$")
X		     (progn
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		       (setq subject (buffer-substring (match-beginning 1)
X						       (match-end 1)))
X		       (forward-line 1)))
X		 (if (looking-at "^Date:[ \t]\\(.*\\)\r$")
X		     (progn
X		       (setq date (buffer-substring (match-beginning 1)
X						    (match-end 1)))
X		       (forward-line 1)))
X		 (if (looking-at "^Lines:[ \t]\\(.*\\)\r$")
X		     (progn
X		       (setq lines (string-to-int
X				    (buffer-substring (match-beginning 1)
X						      (match-end 1))))
X		       (forward-line 1)))
X		 (if (looking-at "^Xref:[ \t]\\(.*\\)\r$")
X		     (progn
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 (vector article subject from
X				   xref lines date message-id)
X			   headers))
X	       )
X	      (t (forward-line 1))	;Skip invalid field (ex. Subject:abc)
X	      ))
X      (nreverse headers)
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 (getenv "NNTPSERVER")))
X	(status nil))
X    (setq nntp-status-message-string "")
X    (cond ((and host (nntp-open-server-internal host service))
X	   (setq status (nntp-wait-for-response "^[23].*\r$"))
X	   ;; Do check unexpected close of connection.
X	   ;; Suggested by feldmark@hanako.stars.flab.fujitsu.junet.
X	   (if status
X	       (set-process-sentinel nntp-server-process
X				     'nntp-default-sentinel)
X	     ;; We have to close connection here, since function
X	     ;;  `nntp-server-opened' may return incorrect status.
X	     (nntp-close-server-internal)
X	     ))
X	  ((null host)
X	   (setq nntp-status-message-string "NNTP server is not specified."))
X	  )
X    status
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	(and nntp-server-process
X	     (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 (nntp-server-opened)
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-server-opened ()
X  "Return server process status, T or NIL.
XIf the stream is opened, return T, otherwise return NIL."
X  (and nntp-server-process
X       (memq (process-status nntp-server-process) '(open run))))
X
X(defun nntp-status-message ()
X  "Return server status response as string."
X  (if (and nntp-status-message-string
X	   ;; NNN MESSAGE
X	   (string-match "[0-9][0-9][0-9][ \t]+\\([^\r]*\\).*$"
X			 nntp-status-message-string))
X      (substring nntp-status-message-string (match-beginning 1) (match-end 1))
X    ;; Empty message if nothing.
X    ""
X    ))
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	   (not (nntp-server-opened)))
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.
X0. Delete status line.
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 nntp-server-buffer)
X    ;; Insert newline at end of buffer.
X    (goto-char (point-max))
X    (if (not (bolp))
X	(insert "\n"))
X    ;; Delete status line.
X    (goto-char (point-min))
X    (kill-line 1)
X    ;; Delete `^M' at end of line.
X    ;; (replace-regexp "\r$" "")
X    (while (not (eobp))
X      (end-of-line)
X      (if (= (preceding-char) ?\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)			;(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 (search-forward "\n.." nil t)
X      (delete-char -1))
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 `.' at beginning of line with `..'.
X    (goto-char (point-min))
X    ;; (replace-regexp "^\\." "..")
X    (while (search-forward "\n." nil t)
X      (insert "."))
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  "Wait for server RESPONSE after sending CMD and optional ARGS to server."
X  (save-excursion
X    ;; Clear communication buffer.
X    (set-buffer nntp-server-buffer)
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 nntp-server-buffer)
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      ;; Save status message.
X      (end-of-line)
X      (setq nntp-status-message-string
X	    (buffer-substring (point-min) (point)))
X      (if status
X	  (progn
X	    (setq wait t)
X	    (while wait
X	      (goto-char (point-max))
X	      (forward-line -1)		;(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 received 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    ;; We have to work in the buffer associated with NNTP server
X    ;;  process because of NEmacs hack.
X    (copy-to-buffer nntp-server-buffer begin end)
X    (set-buffer nntp-server-buffer)
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    ;; Use TCP/IP stream emulation package if needed.
X    (or (fboundp 'open-network-stream)
X	(require 'tcp))
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
X	  (open-network-stream "nntpd" (current-buffer)
X			       host (or service "nntp")))
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    ;; Return the server process.
X    nntp-server-process
X    ))
X
X(defun nntp-close-server-internal ()
X  "Close connection to news server."
X  (if nntp-server-process
X      (delete-process nntp-server-process))
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 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	;; Fujitsu UTS requires messages during sleep-for. I don't know why.
X	(message "NNTP: Reading...")
X	(sleep-for 1)
X	(message ""))
X    ;; To deal with server process exiting before
X    ;;  accept-process-output is called.
X    ;; Suggested by Jason Venner <jason@violet.berkeley.edu>.
X    (condition-case ()
X	(accept-process-output nntp-server-process)
X      (error nil))
X    ))
SHAR_EOF
chmod 0644 nntp.el || echo "restore of nntp.el fails"
set `wc -c nntp.el`;Sum=$1
if test "$Sum" != "20236"
then echo original size 20236, current size $Sum;fi
sed 's/^X//' << 'SHAR_EOF' > tcp.el &&
X;;; TCP/IP stream emulation for GNU Emacs
X;; Copyright (C) 1988 Fujitsu Laboratoris LTD.
X;; Copyright (C) 1988 Masanobu UMEDA (umerin@flab.flab.Fujitsu.JUNET)
X;; $Header: tcp.el,v 1.2 88/11/11 14:58:08 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;; Note on TCP package:
X;;
X;; This package provides TCP/IP stream emulation on GNU Emacs. If
X;; function `open-network-stream' is not defined in Emacs, but your
X;; operating system has a capability of network stream connection,
X;; the tcp package can be used for communicating with NNTP server.
X;;
X;; The tcp package runs inferior process named `tcp' which actually
X;; does the role of `open-network-stream'. Before loading the package,
X;; compile `tcp.c' and install it as `tcp' on a emacs search path. If
X;; you modify `tcp.c', please send diffs to umerin@flab.Fujitsu.JUNET.
X;; I'll include it in the next release.
X;;
X;; This file also contains small pieces of emacs lisp codes for
X;; compatibility with some old version of GNU Emacs. If these codes
X;; does wrong for your emacs, please remove all or parts of them.
X
X(provide 'tcp)
X
X(defvar tcp-program-name "tcp"
X  "Program name emulating open-network-stream function.")
X
X(defun open-network-stream (name buffer host service)
X  "Open a TCP connection for a service to a host.
XReturns a subprocess-object to represent the connection.
XInput and output work as for subprocesses; `delete-process' closes it.
XArgs are NAME BUFFER HOST SERVICE.
XNAME is name for process.  It is modified if necessary to make it unique.
XBUFFER is the buffer (or buffer-name) to associate with the process.
X Process output goes at end of that buffer, unless you specify
X an output stream or filter function to handle the output.
X BUFFER may be also nil, meaning that this process is not associated
X with any buffer
XThird arg is name of the host to connect to.
XFourth arg SERVICE is name of the service desired, or an integer
X specifying a port number to connect to."
X  (let ((proc
X	 (start-process name buffer 
X			tcp-program-name
X			"-h" host 
X			"-s" (if (stringp service)
X				 service
X			       (int-to-string service))
X			)))
X    (process-kill-without-query proc)
X    ;; Return process
X    proc
X    ))
X
X(if (fboundp 'load-library)
X    nil
X  ;; Following definitions are only for compatibility with *OOOOOLD*
X  ;;  Emacs, especially SX/A Emacs (a variant of GNU Emacs).
X  ;; If your Emacs does not have `load-library' function, you have to
X  ;;  load this tcp package before loading `gnus'.
X
X  ;; By Yasunari,Itoh at PFU limited.
X  (defvar news-inews-program "inews"
X    "Function to post news.")
X  (defvar news-path "/usr/spool/news/"
X    "The root directory below which all news files are stored.")
X
X  (fset 'load-library (symbol-function 'load))
X  (fset 'process-send-string (symbol-function 'send-string))
X  (fset 'process-send-region (symbol-function 'send-region))
X
X  (load "backquote")
X
X  (defun one-window-p (&optional win)
X    (if (or (not win)(eq win t)) (setq win (selected-window)))
X    (eq (selected-window)(next-window win)))
X
X  (fset 'bury-buffer-org (symbol-function 'bury-buffer))
X  (fset 'apply-org (symbol-function 'apply))
X
X  (defun bury-buffer (&optional buffer)
X    (let ((buf (or buffer (current-buffer))))
X      (bury-buffer-org buf)))
X
X  (defun apply (func &rest args)
X    (let* ((last (car (reverse args)))
X	   (before (reverse (cdr (reverse args))))
X	   (org-arg (append before last)))
X      (apply-org func org-arg)))
X
X  (defun file-name-as-directory (filename &optional expand-filename)
X    (let* ((expanded 
X	   (if expand-filename (expand-file-name filename)
X	     filename))
X	   (tail-ix (1- (length expanded))))
X      (if (and (> tail-ix 0)
X	       (= (aref expanded tail-ix) ?/)) expanded
X	(concat expanded "/"))))
X
X  )
SHAR_EOF
chmod 0644 tcp.el || echo "restore of tcp.el fails"
set `wc -c tcp.el`;Sum=$1
if test "$Sum" != "4538"
then echo original size 4538, current size $Sum;fi
sed 's/^X//' << 'SHAR_EOF' > tcp.c &&
X/*
X * TCP/IP stream emulation for GNU Emacs.
X * Copyright (C) 1988 Fujitsu Laboratoris LTD.
X * Copyright (C) 1988 Masanobu UMEDA (umerin@flab.flab.Fujitsu.JUNET)
X * $Header: tcp.c,v 1.1 88/09/29 19:40:38 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 * For Fujitsu UTS compile with:
X *	cc -O -o tcp tcp.c -DFUJITSU_UTS -lu -lsocket
X
X * If you modifies the source for your system, please send me the
X * diffs. I'll includes it in the future release.
X *
X * Yasunari,Itoh at PFU limited contributed for Fujitsu UTS and SX/A.
X */
X
X#ifndef lint
Xstatic char *rcsId = "$Header: tcp.c,v 1.1 88/09/29 19:40:38 umerin Exp $";
X#endif
X
X#include <stdio.h>
X#include <fcntl.h>
X#include <ctype.h>
X#include <sys/types.h>
X
X#ifdef FUJITSU_UTS
X#define USG
X#include <sys/ucbtypes.h>
X#include <sys/tisp/socket.h>
X#include <netdb.h>
X#include <sys/tisp/in.h>
X#else
X#include <sys/socket.h>
X#include <netdb.h>
X#include <netinet/in.h>
X#endif
X
X#ifdef USG
X#include <sys/stat.h>
X#include <signal.h>
X#endif
X
X#ifdef FUJITSU_UTS
X#define bcopy(f,t,n)    memcpy(t,f,n)
X#define bcmp(b1,b2,n)   (memcmp(b1,b2,n)!=0)
X#define bzero(b,n)      memset(b,0,n)
X#endif
X
X#ifdef USG
Xint selectable = 1;
X
Xsigout()
X{
X  fcntl(fileno(stdin),F_SETFL,0);
X  exit(-1);
X}
X#endif
X
Xmain(argc, argv)
Xint	argc;
Xchar	*argv[];
X{
X  struct hostent	*host;
X  struct sockaddr_in	sockin, sockme;
X  struct servent	*serv;
X  char	*hostname;
X  char	*service;
X  int	port;
X  int	readfds;
X  int	server;			/* NNTP Server */
X  int	emacsIn = fileno(stdin); /* Emacs intput */
X  int	emacsOut = fileno(stdout); /* Emacs output */
X  char	buffer[1024];
X  int	nbuffer;		/* Number of bytes in buffer */
X
X  while(--argc > 0){
X    switch(**(++argv)){
X    case '-':
X      {
X	char	*p = &argv[0][1];
X	if(strcmp(p,"s")==0){	/* Service name */
X	  service = *(++argv);
X	  --argc;
X	} else if(strcmp(p,"h")==0){ /* Host name */
X	  hostname = *(++argv);
X	  --argc;
X	} else {
X	  fprintf(stderr, "Usage: tcp -h HOST -s SERVICE\n");
X	  exit(1);
X	}
X      }
X      break;
X    default:
X      fprintf(stderr, "Usage: tcp -h HOST -s SERVICE\n");
X      exit(1);
X      break;
X    }
X  }
X
X  if((host = gethostbyname(hostname)) == NULL){
X    perror("gethostbyname");
X    exit(1);
X  }
X  if(isdigit(service[0]))
X    port = atoi(service);
X  else {
X    serv = getservbyname(service, "tcp");
X    if(serv == NULL){
X      perror("getservbyname");
X      exit(1);
X    }
X    port = serv->s_port;
X  }
X
X  bzero(&sockin, sizeof(sockin));
X  sockin.sin_family = host->h_addrtype;
X  bcopy(host->h_addr, &sockin.sin_addr, host->h_length);
X  sockin.sin_port = htons(port);
X  if((server = socket(AF_INET, SOCK_STREAM, 0)) < 0) {
X    perror("socket");
X    exit(1);
X  }
X  if(setsockopt(server, SOL_SOCKET, SO_REUSEADDR, 0, 0)) {
X    perror("setsockopt");
X    exit(1);
X  }
X  bzero(&sockme, sizeof(sockme));
X  sockme.sin_family = sockin.sin_family;
X  sockme.sin_addr.s_addr = INADDR_ANY;
X  if(bind(server, &sockme, sizeof(sockme)) < 0){
X    perror("bind");
X    exit(1);
X  }
X  if(connect(server, &sockin, sizeof (sockin)) < 0){
X    perror("connect");
X    close(server);
X    exit(1);
X  }
X
X#ifdef O_NDELAY
X  fcntl(server, F_SETFL, O_NDELAY);
X
X#ifdef USG
X  /* USG pipe cannot not select emacsIn */
X  {
X    struct stat statbuf;
X    fstat (emacsIn,&statbuf);
X    if (statbuf.st_mode & 010000)
X      selectable = 0;
X    if (!selectable){
X      signal(SIGINT,sigout);
X      fcntl(emacsIn, F_SETFL, O_NDELAY);
X    }
X  }
X#endif
X#endif
X
X  /* Connection established. */
X  while(1){
X    readfds = (1 << server) | (1 << emacsIn);
X    if(select(32, &readfds, NULL, NULL, (struct timeval *)NULL) == -1){
X      perror("select");
X      exit(1);
X    }
X    if(readfds & (1 << emacsIn)){
X      /* From Emacs */
X      nbuffer = read(emacsIn, buffer, sizeof buffer -1);
X
X#ifdef USG
X      if (selectable && nbuffer == 0){
X	goto finish;
X      } else if (!(readfds & (1 << server)) && nbuffer == 0){
X	sleep (1);
X      } else 
X#else
X      if(nbuffer == 0)
X	goto finish;
X#endif
X      if((nbuffer > 0) && (write(server, buffer, nbuffer) != nbuffer))
X	goto finish;
X    }
X    if(readfds & (1 << server)){
X      /* From NNTP server */
X      nbuffer = read(server, buffer, sizeof buffer -1);
X      if(nbuffer == 0)
X	goto finish;
X      if((nbuffer > 0) && (write(emacsOut, buffer, nbuffer) != nbuffer))
X	goto finish;
X    }
X  }
X
X  /* End of communication. */
X finish:
X  close(server);
X#ifdef USG
X  if (!selectable) fcntl(emacsIn, F_SETFL,0);
X#endif
X  close(emacsIn);
X  close(emacsOut);
X  exit(0);
X}
SHAR_EOF
chmod 0644 tcp.c || echo "restore of tcp.c fails"
set `wc -c tcp.c`;Sum=$1
if test "$Sum" != "5236"
then echo original size 5236, current size $Sum;fi
rm -f s2_seq_.tmp
echo "You have unpacked the last part"
exit 0
-- 
Masanobu UMEDA
umerin@flab.flab.Fujitsu.JUNET
umerin%flab.flab.Fujitsu.JUNET@uunet.uu.NET