Path: utzoo!utgpu!water!watmath!clyde!att!osu-cis!tut.cis.ohio-state.edu!mailrus!ames!pasteur!ucbvax!decwrl!sun!pitstop!sundc!seismo!uunet!kddlab!ccut!titcca!fgw!flab!umerin From: umerin@flab.flab.fujitsu.JUNET (Masanobu UMEDA) Newsgroups: comp.emacs,fj.editor.emacs Subject: GNUS 3.8: a NNTP-base news reader for GNU Emacs (4 of 4) Message-ID: <4129@flab.flab.fujitsu.JUNET> Date: 19 Sep 88 03:23:26 GMT Reply-To: umerin@flab.flab.fujitsu.JUNET (Masanobu UMEDA) Organization: Fujitsu Laboratories Ltd., Kawasaki, Japan Lines: 595 ---- Cut Here and unpack ---- #!/bin/sh # this is part 4 of a multipart archive # do not concatenate these parts, unpack them in order with /bin/sh # file nntp.el continued # CurArch=4 if test ! -r s2_seq_.tmp then echo "Please unpack part 1 first!" exit 1; fi ( read Scheck if test "$Scheck" != $CurArch then echo "Please unpack part $Scheck next!" exit 1; else exit 0; fi ) < s2_seq_.tmp || exit 1 sed 's/^X//' << 'SHAR_EOF' >> nntp.el 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(defun nntp-find-header-by-number (headers number) X "Return a header which is a element of HEADERS and has NUMBER." X (let ((found nil)) X (while (and headers (not found)) X (if (eq number (nntp-header-number (car headers))) X (setq found (car headers))) X (setq headers (cdr headers))) X found X )) X X(defun nntp-find-header-by-id (headers id) X "Return a header which is a element of HEADERS and has message-ID." X (let ((found nil)) X (while (and headers (not found)) X (if (string-equal id (nntp-header-id (car headers))) X (setq found (car headers))) X (setq headers (cdr headers))) X found 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 (setq nntp-status-message-string "") X (if (nntp-open-server-internal host service) X (let ((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 '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 status 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 (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 (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 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) 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 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 (erase-buffer) X (setq nntp-server-process X (open-network-stream "nntpd" (current-buffer) X host (or service "nntp"))) 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. X (condition-case () X (accept-process-output nntp-server-process) X (error nil)) X )) SHAR_EOF chmod 0444 nntp.el || echo "restore of nntp.el fails" set `wc -c nntp.el`;Sum=$1 if test "$Sum" != "20613" then echo original size 20613, 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