home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 2: Applications / Linux Cubed Series 2 - Applications.iso / editors / emacs / xemacs / xemacs-1.006 / xemacs-1 / lib / xemacs-19.13 / lisp / gnus / old-nntp.el < prev    next >
Encoding:
Text File  |  1995-03-25  |  23.4 KB  |  733 lines
  1. ;;; nntp.el --- NNTP (RFC977) Interface for GNU Emacs
  2.  
  3. ;; Copyright (C) 1987, 1988, 1989, 1990, 1992, 1993 Free Software Foundation, Inc.
  4.  
  5. ;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
  6. ;; Keywords: news
  7.  
  8. ;; This file is part of XEmacs.
  9.  
  10. ;; XEmacs is free software; you can redistribute it and/or modify it
  11. ;; under the terms of the GNU General Public License as published by
  12. ;; the Free Software Foundation; either version 2, or (at your option)
  13. ;; any later version.
  14.  
  15. ;; XEmacs is distributed in the hope that it will be useful, but
  16. ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  17. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  18. ;; General Public License for more details.
  19.  
  20. ;; You should have received a copy of the GNU General Public License
  21. ;; along with XEmacs; see the file COPYING.  If not, write to the Free
  22. ;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  23.  
  24.  
  25. ;;; Commentary:
  26.  
  27. ;; This implementation is tested on both 1.2a and 1.5 version of the
  28. ;; NNTP package.
  29.  
  30. ;; Troubleshooting of NNTP
  31. ;;
  32. ;; (1) Select routine may signal an error or fall into infinite loop
  33. ;;  while waiting for the server response. In this case, you'd better
  34. ;;  not use byte-compiled codes but original source. If you still have
  35. ;;  a problems with it, set the variable `nntp-buggy-select' to T.
  36. ;;
  37. ;; (2) Emacs may hang up while retrieving headers since too many
  38. ;;  requests have been sent to the NNTP server without reading their
  39. ;;  replies. In this case, reduce the number of the requests sent to
  40. ;;  the server at one time by setting the variable
  41. ;;  `nntp-maximum-request' to a lower value.
  42. ;;
  43. ;; (3) If the TCP/IP stream (open-network-stream) is not supported by
  44. ;;  emacs, compile and install `tcp.el' and `tcp.c' which is an
  45. ;;  emulation program of the stream. If you modified `tcp.c' for your
  46. ;;  system, please send me the diffs. I'll include some of them in the
  47. ;;  future releases.
  48.  
  49. ;;; Code:
  50.  
  51. (defvar nntp-server-hook nil
  52.   "*Hooks for the NNTP server.
  53. If the kanji code of the NNTP server is different from the local kanji
  54. code, the correct kanji code of the buffer associated with the NNTP
  55. server must be specified as follows:
  56.  
  57. (setq nntp-server-hook
  58.       (function
  59.        (lambda ()
  60.      ;; Server's Kanji code is EUC (NEmacs hack).
  61.      (make-local-variable 'kanji-fileio-code)
  62.      (setq kanji-fileio-code 0))))
  63.  
  64. If you'd like to change something depending on the server in this
  65. hook, use the variable `nntp-server-name'.")
  66.  
  67. (defvar nntp-large-newsgroup 50
  68.   "*The number of the articles which indicates a large newsgroup.
  69. If the number of the articles is greater than the value, verbose
  70. messages will be shown to indicate the current status.")
  71.  
  72. (defvar nntp-buggy-select (memq system-type '(usg-unix-v fujitsu-uts))
  73.   "*T if your select routine is buggy.
  74. If the select routine signals error or fall into infinite loop while
  75. waiting for the server response, the variable must be set to t.  In
  76. case of Fujitsu UTS, it is set to T since `accept-process-output'
  77. doesn't work properly.")
  78.  
  79. ;; jwz: I've found that 400 is too big for this, but 200 works.
  80. (defvar nntp-maximum-request 200
  81.   "*The maximum number of the requests sent to the NNTP server at one time.
  82. If Emacs hangs up while retrieving headers, set the variable to a
  83. lower value.")
  84.  
  85. (defvar nntp-debug-read 10000
  86.   "*Display '...' every 10Kbytes of a message being received if it is non-nil.
  87. If it is a number, dots are displayed per the number.")
  88.  
  89.  
  90. (defconst nntp-version "NNTP 3.12"
  91.   "Version numbers of this version of NNTP.")
  92.  
  93. (defvar nntp-server-name nil
  94.   "The name of the host running NNTP server.")
  95.  
  96. (defvar nntp-server-buffer nil
  97.   "Buffer associated with NNTP server process.")
  98.  
  99. (defvar nntp-server-process nil
  100.   "The NNTP server process.
  101. You'd better not use this variable in NNTP front-end program but
  102. instead use `nntp-server-buffer'.")
  103.  
  104. (defvar nntp-status-string nil
  105.   "Save the server response message.
  106. You'd better not use this variable in NNTP front-end program but
  107. instead call function `nntp-status-message' to get status message.")
  108.  
  109. ;;;
  110. ;;; Extended Command for retrieving many headers.
  111. ;;;
  112. ;; Retrieving lots of headers by sending command asynchronously.
  113. ;; Access functions to headers are defined as macro.
  114.  
  115. (defmacro nntp-header-number (header)
  116.   "Return article number in HEADER."
  117.   (` (aref (, header) 0)))
  118.  
  119. (defmacro nntp-set-header-number (header number)
  120.   "Set article number of HEADER to NUMBER."
  121.   (` (aset (, header) 0 (, number))))
  122.  
  123. (defmacro nntp-header-subject (header)
  124.   "Return subject string in HEADER."
  125.   (` (aref (, header) 1)))
  126.  
  127. (defmacro nntp-set-header-subject (header subject)
  128.   "Set article subject of HEADER to SUBJECT."
  129.   (` (aset (, header) 1 (, subject))))
  130.  
  131. (defmacro nntp-header-from (header)
  132.   "Return author string in HEADER."
  133.   (` (aref (, header) 2)))
  134.  
  135. (defmacro nntp-set-header-from (header from)
  136.   "Set article author of HEADER to FROM."
  137.   (` (aset (, header) 2 (, from))))
  138.  
  139. (defmacro nntp-header-xref (header)
  140.   "Return xref string in HEADER."
  141.   (` (aref (, header) 3)))
  142.  
  143. (defmacro nntp-set-header-xref (header xref)
  144.   "Set article xref of HEADER to xref."
  145.   (` (aset (, header) 3 (, xref))))
  146.  
  147. (defmacro nntp-header-lines (header)
  148.   "Return lines in HEADER."
  149.   (` (aref (, header) 4)))
  150.  
  151. (defmacro nntp-set-header-lines (header lines)
  152.   "Set article lines of HEADER to LINES."
  153.   (` (aset (, header) 4 (, lines))))
  154.  
  155. (defmacro nntp-header-date (header)
  156.   "Return date in HEADER."
  157.   (` (aref (, header) 5)))
  158.  
  159. (defmacro nntp-set-header-date (header date)
  160.   "Set article date of HEADER to DATE."
  161.   (` (aset (, header) 5 (, date))))
  162.  
  163. (defmacro nntp-header-id (header)
  164.   "Return Id in HEADER."
  165.   (` (aref (, header) 6)))
  166.  
  167. (defmacro nntp-set-header-id (header id)
  168.   "Set article Id of HEADER to ID."
  169.   (` (aset (, header) 6 (, id))))
  170.  
  171. (defmacro nntp-header-references (header)
  172.   "Return references (or in-reply-to) in HEADER."
  173.   (` (aref (, header) 7)))
  174.  
  175. (defmacro nntp-set-header-references (header ref)
  176.   "Set article references of HEADER to REF."
  177.   (` (aset (, header) 7 (, ref))))
  178.  
  179. (defun nntp-retrieve-headers (sequence)
  180.   "Return list of article headers specified by SEQUENCE of article id.
  181. The format of list is
  182.  `([NUMBER SUBJECT FROM XREF LINES DATE MESSAGE-ID REFERENCES] ...)'.
  183. If there is no References: field, In-Reply-To: field is used instead.
  184. Reader macros for the vector are defined as `nntp-header-FIELD'.
  185. Writer macros for the vector are defined as `nntp-set-header-FIELD'.
  186. Newsgroup must be selected before calling this."
  187.   (save-excursion
  188.     (set-buffer nntp-server-buffer)
  189.     (erase-buffer)
  190.     (let ((number (length sequence))
  191.       (last-point (point-min))
  192.       (received 0)
  193.       (count 0)
  194.       (headers nil)            ;Result list.
  195.       (article 0)
  196.       (subject nil)
  197.       (message-id)
  198.       (from nil)
  199.       (xref nil)
  200.       (lines 0)
  201.       (date nil)
  202.       (references nil))
  203.       ;; Send HEAD command.
  204.       (while sequence
  205.     (nntp-send-strings-to-server "HEAD" (car sequence))
  206.     (setq sequence (cdr sequence))
  207.     (setq count (1+ count))
  208.     ;; Every 400 header requests we have to read stream in order
  209.     ;;  to avoid deadlock.
  210.     (if (or (null sequence)        ;All requests have been sent.
  211.         (zerop (% count nntp-maximum-request)))
  212.         (progn
  213.           (accept-process-output)
  214.           (while (progn
  215.                (goto-char last-point)
  216.                ;; Count replies.
  217.                (while (re-search-forward "^[0-9]" nil t)
  218.              (setq received (1+ received)))
  219.                (setq last-point (point))
  220.                (< received count))
  221.         ;; If number of headers is greater than 100, give
  222.         ;;  informative messages.
  223.         (and (numberp nntp-large-newsgroup)
  224.              (> number nntp-large-newsgroup)
  225.              (zerop (% received 20))
  226.              (gnus-lazy-message "NNTP: Receiving headers... %d%%"
  227.                     (/ (* received 100) number)))
  228.         (nntp-accept-response))
  229.           ))
  230.     )
  231.       ;; Wait for text of last command.
  232.       (goto-char (point-max))
  233.       (re-search-backward "^[0-9]" nil t)
  234.       (if (looking-at "^[23]")
  235.       (while (progn
  236.            (goto-char (- (point-max) 3))
  237.            (not (looking-at "^\\.\r$")))
  238.         (nntp-accept-response)))
  239.       (and (numberp nntp-large-newsgroup)
  240.        (> number nntp-large-newsgroup)
  241.        (message "NNTP: Receiving headers... done"))
  242.       ;; Now all of replies are received.
  243.       (setq received number)
  244.       ;; First, fold continuation lines.
  245.       (goto-char (point-min))
  246.       (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t)
  247.         (replace-match " " t t))
  248.       ;;(delete-non-matching-lines
  249.       ;; "^Subject:\\|^Xref:\\|^From:\\|^Lines:\\|^Date:\\|^References:\\|^[23]")
  250.       (and (numberp nntp-large-newsgroup)
  251.        (> number nntp-large-newsgroup)
  252.        (message "NNTP: Parsing headers..."))
  253.       ;; Then examines replies.
  254.       (goto-char (point-min))
  255.       (while (not (eobp))
  256.     (cond ((looking-at "^[23][0-9][0-9][ \t]+\\([0-9]+\\)[ \t]+\\(<[^>]+>\\)")
  257.            (setq article
  258.              (string-to-int
  259.               (buffer-substring (match-beginning 1) (match-end 1))))
  260.            (setq message-id
  261.              (buffer-substring (match-beginning 2) (match-end 2)))
  262.            (forward-line 1)
  263.            ;; Set default value.
  264.            (setq subject nil)
  265.            (setq xref nil)
  266.            (setq from nil)
  267.            (setq lines 0)
  268.            (setq date nil)
  269.            (setq references nil)
  270.            ;; Thanks go to mly@AI.MIT.EDU (Richard Mlynarik)
  271.            (while (and (not (eobp))
  272.                (not (memq (following-char) '(?2 ?3))))
  273.          (if (looking-at "\\(From\\|Subject\\|Date\\|Lines\\|Xref\\|References\\|In-Reply-To\\):[ \t]+\\([^ \t\n]+.*\\)\r$")
  274.              (let ((s (buffer-substring
  275.                    (match-beginning 2) (match-end 2)))
  276.                (c (char-after (match-beginning 0))))
  277.                ;; We don't have to worry about letter case.
  278.                (cond ((char-equal c ?F)    ;From:
  279.                   (setq from s))
  280.                  ((char-equal c ?S)    ;Subject:
  281.                   (setq subject s))
  282.                  ((char-equal c ?D)    ;Date:
  283.                   (setq date s))
  284.                  ((char-equal c ?L)    ;Lines:
  285.                   (setq lines (string-to-int s)))
  286.                  ((char-equal c ?X)    ;Xref:
  287.                   (setq xref s))
  288.                  ((char-equal c ?R)    ;References:
  289.                   (setq references s))
  290.                  ;; In-Reply-To: should be used only when
  291.                  ;; there is no References: field.
  292.                  ((and (char-equal c ?I) ;In-Reply-To:
  293.                    (null references))
  294.                   (setq references s))
  295.                  )))
  296.          (forward-line 1))
  297.            ;; Finished to parse one header.
  298.            (if (null subject)
  299.            (setq subject "(None)"))
  300.            (if (null from)
  301.            (setq from "(Unknown User)"))
  302.            ;; Collect valid article only.
  303.            (and article
  304.             message-id
  305.             (setq headers
  306.               (cons (vector article subject from
  307.                     xref lines date
  308.                     message-id references) headers)))
  309.            )
  310.           (t (forward-line 1))
  311.           )
  312.     (setq received (1- received))
  313.     (and (numberp nntp-large-newsgroup)
  314.          (> number nntp-large-newsgroup)
  315.          (zerop (% received 20))
  316.          (gnus-lazy-message "NNTP: Parsing headers... %d%%"
  317.                 (/ (* received 100) number)))
  318.     )
  319.       (and (numberp nntp-large-newsgroup)
  320.        (> number nntp-large-newsgroup)
  321.        (message "NNTP: Parsing headers... done"))
  322.       (nreverse headers)
  323.       )))
  324.  
  325.  
  326. ;;;
  327. ;;; Raw Interface to Network News Transfer Protocol (RFC977).
  328. ;;;
  329.  
  330. (defun nntp-open-server (host &optional service)
  331.   "Open news server on HOST.
  332. If HOST is nil, use value of environment variable `NNTPSERVER'.
  333. If optional argument SERVICE is non-nil, open by the service name."
  334.   (let ((host (or host (getenv "NNTPSERVER")))
  335.     (status nil))
  336.     (setq nntp-status-string "")
  337.     (cond ((and host (nntp-open-server-internal host service))
  338.        (setq status (nntp-wait-for-response "^[23].*\r$"))
  339.  
  340.        ;; With some INN servers, we need to do this to convince it to
  341.        ;; behave in the conventional way and not assume we want to do
  342.        ;; a batch transfer of news.  With older NNTP servers, this will
  343.        ;; provoke a "500 unknown command", which we can simply ignore.
  344.        ;; -jwz, from felix@laas.fr.
  345.        (nntp-send-command "^.*\r$" "mode reader")
  346.  
  347.        ;; Do check unexpected close of connection.
  348.        ;; Suggested by feldmark@hanako.stars.flab.fujitsu.junet.
  349.        (if status
  350.            (set-process-sentinel nntp-server-process
  351.                      'nntp-default-sentinel)
  352.          ;; We have to close connection here, since function
  353.          ;;  `nntp-server-opened' may return incorrect status.
  354.          (nntp-close-server-internal)
  355.          ))
  356.       ((null host)
  357.        (setq nntp-status-string "NNTP server is not specified."))
  358.       )
  359.     status
  360.     ))
  361.  
  362. (defun nntp-close-server ()
  363.   "Close news server."
  364.   (unwind-protect
  365.       (progn
  366.     ;; Un-set default sentinel function before closing connection.
  367.     (and nntp-server-process
  368.          (eq 'nntp-default-sentinel
  369.          (process-sentinel nntp-server-process))
  370.          (set-process-sentinel nntp-server-process nil))
  371.     ;; We cannot send QUIT command unless the process is running.
  372.     (if (nntp-server-opened)
  373.         (nntp-send-command nil "QUIT"))
  374.     )
  375.     (nntp-close-server-internal)
  376.     ))
  377.  
  378. (fset 'nntp-request-quit (symbol-function 'nntp-close-server))
  379.  
  380. (defun nntp-server-opened ()
  381.   "Return server process status, T or NIL.
  382. If the stream is opened, return T, otherwise return NIL."
  383.   (and nntp-server-process
  384.        (memq (process-status nntp-server-process) '(open run))))
  385.  
  386. (defun nntp-status-message ()
  387.   "Return server status response as string."
  388.   (if (and nntp-status-string
  389.        ;; NNN MESSAGE
  390.        (string-match "[0-9][0-9][0-9][ \t]+\\([^\r]*\\).*$"
  391.              nntp-status-string))
  392.       (substring nntp-status-string (match-beginning 1) (match-end 1))
  393.     ;; Empty message if nothing.
  394.     ""
  395.     ))
  396.  
  397. (defun nntp-request-article (id)
  398.   "Select article by message ID (or number)."
  399.   (prog1
  400.       ;; If NEmacs, end of message may look like: "\256\215" (".^M")
  401.       (nntp-send-command "^\\.\r$" "ARTICLE" id)
  402.     (nntp-decode-text)
  403.     ))
  404.  
  405. (defun nntp-request-body (id)
  406.   "Select article body by message ID (or number)."
  407.   (prog1
  408.       ;; If NEmacs, end of message may look like: "\256\215" (".^M")
  409.       (nntp-send-command "^\\.\r$" "BODY" id)
  410.     (nntp-decode-text)
  411.     ))
  412.  
  413. (defun nntp-request-head (id)
  414.   "Select article head by message ID (or number)."
  415.   (prog1
  416.       (nntp-send-command "^\\.\r$" "HEAD" id)
  417.     (nntp-decode-text)
  418.     ))
  419.  
  420. (defun nntp-request-stat (id)
  421.   "Select article by message ID (or number)."
  422.   (nntp-send-command "^[23].*\r$" "STAT" id))
  423.  
  424. (defun nntp-request-group (group)
  425.   "Select news GROUP."
  426.   ;; 1.2a NNTP's group command is buggy. "^M" (\r) is not appended to
  427.   ;;  end of the status message.
  428.   (nntp-send-command "^[23].*$" "GROUP" group))
  429.  
  430. (defun nntp-request-list ()
  431.   "List active newsgroups."
  432.   (prog1
  433.       (nntp-send-command "^\\.\r$" "LIST")
  434.     (nntp-decode-text)
  435.     ))
  436.  
  437. (defun nntp-request-list-newsgroups ()
  438.   "List newsgroups (defined in NNTP2)."
  439.   (prog1
  440.       (nntp-send-command "^\\.\r$" "LIST NEWSGROUPS")
  441.     (nntp-decode-text)
  442.     ))
  443.  
  444. (defun nntp-request-list-distributions ()
  445.   "List distributions (defined in NNTP2)."
  446.   (prog1
  447.       (nntp-send-command "^\\.\r$" "LIST DISTRIBUTIONS")
  448.     (nntp-decode-text)
  449.     ))
  450.  
  451. (defun nntp-request-last ()
  452.   "Set current article pointer to the previous article
  453. in the current news group."
  454.   (nntp-send-command "^[23].*\r$" "LAST"))
  455.  
  456. (defun nntp-request-next ()
  457.   "Advance current article pointer."
  458.   (nntp-send-command "^[23].*\r$" "NEXT"))
  459.  
  460. (defun nntp-request-post ()
  461.   "Post a new news in current buffer."
  462.   ;; Some hosts take forever to post, so I added more status msgs. -- jwz
  463.   (message "NNTP: awaiting POST connection...")
  464.   (if (nntp-send-command "^[23].*\r$" "POST")
  465.       (progn
  466.     (message "NNTP: got POST connection; encoding text...")
  467.     (nntp-encode-text)
  468.     (message "NNTP: got POST connection; sending text...")
  469.     (nntp-send-region-to-server (point-min) (point-max))
  470.     ;; 1.2a NNTP's post command is buggy. "^M" (\r) is not
  471.     ;;  appended to end of the status message.
  472.     (message "NNTP: text sent; awaiting response...")
  473.     (prog1
  474.         (nntp-wait-for-response "^[23].*$")
  475.       (message "NNTP: post complete.")))))
  476.  
  477. (defun nntp-default-sentinel (proc status)
  478.   "Default sentinel function for NNTP server process."
  479.   (if (and nntp-server-process
  480.        (not (nntp-server-opened)))
  481.       (error "NNTP: Connection closed.")
  482.     ))
  483.  
  484. ;; Encoding and decoding of NNTP text.
  485.  
  486. (defun nntp-decode-text ()
  487.   "Decode text transmitted by NNTP.
  488. 0. Delete status line.
  489. 1. Delete `^M' at end of line.
  490. 2. Delete `.' at end of buffer (end of text mark).
  491. 3. Delete `.' at beginning of line."
  492.   (save-excursion
  493.     (set-buffer nntp-server-buffer)
  494.     ;; Insert newline at end of buffer.
  495.     (goto-char (point-max))
  496.     (if (not (bolp))
  497.     (insert "\n"))
  498.     ;; Delete status line.
  499.     (goto-char (point-min))
  500.     (delete-region (point) (progn (forward-line 1) (point)))
  501.     ;; Delete `^M' at end of line.
  502.     ;; (replace-regexp "\r$" "")
  503.     (while (not (eobp))
  504.       (end-of-line)
  505.       (if (= (preceding-char) ?\r)
  506.       (delete-char -1))
  507.       (forward-line 1)
  508.       )
  509.     ;; Delete `.' at end of buffer (end of text mark).
  510.     (goto-char (point-max))
  511.     (forward-line -1)            ;(beginning-of-line)
  512.     (if (looking-at "^\\.$")
  513.     (delete-region (point) (progn (forward-line 1) (point))))
  514.     ;; Replace `..' at beginning of line with `.'.
  515.     (goto-char (point-min))
  516.     ;; (replace-regexp "^\\.\\." ".")
  517.     (while (search-forward "\n.." nil t)
  518.       (delete-char -1))
  519.     ))
  520.  
  521. (defun nntp-encode-text ()
  522.   "Encode text in current buffer for NNTP transmission.
  523. 1. Insert `.' at beginning of line.
  524. 2. Insert `.' at end of buffer (end of text mark)."
  525.   (save-excursion
  526.     ;; Insert newline at end of buffer.
  527.     (goto-char (point-max))
  528.     (if (not (bolp))
  529.     (insert "\n"))
  530.     ;; Replace `.' at beginning of line with `..'.
  531.     (goto-char (point-min))
  532.     ;; (replace-regexp "^\\." "..")
  533.     (while (search-forward "\n." nil t)
  534.       (insert "."))
  535.     ;; Insert `.' at end of buffer (end of text mark).
  536.     (goto-char (point-max))
  537.     (insert ".\r\n")
  538.     ))
  539.  
  540.  
  541. ;;;
  542. ;;; Synchronous Communication with NNTP Server.
  543. ;;;
  544.  
  545. (defun nntp-send-command (response cmd &rest args)
  546.   "Wait for server RESPONSE after sending CMD and optional ARGS to server."
  547.   (save-excursion
  548.     ;; Clear communication buffer.
  549.     (set-buffer nntp-server-buffer)
  550.     (erase-buffer)
  551.     (apply 'nntp-send-strings-to-server cmd args)
  552.     (if response
  553.     (nntp-wait-for-response response)
  554.       t)
  555.     ))
  556.  
  557. (defun nntp-wait-for-response (regexp)
  558.   "Wait for server response which matches REGEXP."
  559.   (save-excursion
  560.     (let ((status t)
  561.       (wait t))
  562.       (set-buffer nntp-server-buffer)
  563.       ;; Wait for status response (RFC977).
  564.       ;; 1xx - Informative message.
  565.       ;; 2xx - Command ok.
  566.       ;; 3xx - Command ok so far, send the rest of it.
  567.       ;; 4xx - Command was correct, but couldn't be performed for some
  568.       ;;       reason.
  569.       ;; 5xx - Command unimplemented, or incorrect, or a serious
  570.       ;;       program error occurred.
  571.       (nntp-accept-response)
  572.       (while wait
  573.     (goto-char (point-min))
  574.     (cond ((looking-at "[23]")
  575.            (setq wait nil))
  576.           ((looking-at "[45]")
  577.            (setq status nil)
  578.            (setq wait nil))
  579.           (t (nntp-accept-response))
  580.           ))
  581.       ;; Save status message.
  582.       (end-of-line)
  583.       (setq nntp-status-string
  584.         (buffer-substring (point-min) (point)))
  585.       (if status
  586.       (progn
  587.         (setq wait t)
  588.         (while wait
  589.           (goto-char (point-max))
  590.           (forward-line -1)        ;(beginning-of-line)
  591.           ;;(message (buffer-substring
  592.           ;;     (point)
  593.           ;;     (save-excursion (end-of-line) (point))))
  594.           (if (looking-at regexp)
  595.           (setq wait nil)
  596.         (let ((k (/ (buffer-size) 1024)))
  597.           (gnus-lazy-message (if (> k 0)
  598.                      "NNTP: Reading (%sk)..."
  599.                        "NNTP: Reading...")
  600.                      k))
  601.         (nntp-accept-response)
  602.         ))
  603.         ;; Remove "reading" message if any.
  604.         (message nil)
  605.         ;; Successfully received server response.
  606.         t
  607.         ))
  608.       )))
  609.  
  610.  
  611. ;;;
  612. ;;; Low-Level Interface to NNTP Server.
  613. ;;; 
  614.  
  615. (defun nntp-send-strings-to-server (&rest strings)
  616.   "Send list of STRINGS to news server as command and its arguments."
  617.   (let ((cmd (car strings))
  618.     (strings (cdr strings)))
  619.     ;; Command and each argument must be separated by one or more spaces.
  620.     (while strings
  621.       (setq cmd (concat cmd " " (car strings)))
  622.       (setq strings (cdr strings)))
  623.     ;; Command line must be terminated by a CR-LF.
  624.     (process-send-string nntp-server-process (concat cmd "\r\n"))
  625.     ))
  626.  
  627. (defun nntp-send-region-to-server (begin end)
  628.   "Send current buffer region (from BEGIN to END) to news server."
  629.   (save-excursion
  630.     ;; We have to work in the buffer associated with NNTP server
  631.     ;;  process because of NEmacs hack.
  632.     (copy-to-buffer nntp-server-buffer begin end)
  633.     (set-buffer nntp-server-buffer)
  634.     (setq begin (point-min))
  635.     (setq end (point-max))
  636.     ;; `process-send-region' does not work if text to be sent is very
  637.     ;;  large. I don't know maximum size of text sent correctly.
  638.     (let* ((last nil)
  639.        (size 100)            ;Size of text sent at once.
  640.        (total (/ (- end begin) size))
  641.        (sent 0))
  642.       (save-restriction
  643.     (narrow-to-region begin end)
  644.     (goto-char begin)
  645.     (while (not (eobp))
  646.       (gnus-lazy-message "NNTP: got POST connection; sending text...%d%%"
  647.                  (/ (* 100 sent) total))
  648.       (setq sent (+ sent 1))
  649.       ;;(setq last (min end (+ (point) size)))
  650.       ;; NEmacs gets confused if character at `last' is Kanji.
  651.       (setq last (save-excursion
  652.                (goto-char (min end (+ (point) size)))
  653.                (or (eobp) (forward-char 1)) ;Adjust point
  654.                (point)))
  655.       (process-send-region nntp-server-process (point) last)
  656.       ;; I don't know whether the next codes solve the known
  657.       ;;  problem of communication error of GNU Emacs.
  658.       (accept-process-output)
  659.       ;;(sit-for 0)
  660.       (goto-char last)
  661.       )))
  662.     ;; We cannot erase buffer, because reply may be received.
  663.     (delete-region begin end)
  664.     ))
  665.  
  666. (defun nntp-open-server-internal (host &optional service)
  667.   "Open connection to news server on HOST by SERVICE (default is nntp)."
  668.   (save-excursion
  669.     ;; Use TCP/IP stream emulation package if needed.
  670.     (or (fboundp 'open-network-stream)
  671.     (require 'tcp))
  672.     ;; Initialize communication buffer.
  673.     (setq nntp-server-buffer (get-buffer-create " *nntpd*"))
  674.     (set-buffer nntp-server-buffer)
  675.     (buffer-disable-undo (current-buffer))
  676.     (erase-buffer)
  677.     (kill-all-local-variables)
  678.     (setq case-fold-search t)        ;Should ignore case.
  679.     (setq nntp-server-process
  680.       (open-network-stream "nntpd" (current-buffer)
  681.                    host (or service "nntp")))
  682.     (setq nntp-server-name host)
  683.     ;; It is possible to change kanji-fileio-code in this hook.
  684.     (run-hooks 'nntp-server-hook)
  685.     ;; Kill this process without complaint when exiting Emacs
  686.     ;; (the .newsrc file is the interesting part, not the connection.)
  687.     (process-kill-without-query nntp-server-process)
  688.     ;; Return the server process.
  689.     nntp-server-process
  690.     ))
  691.  
  692. (defun nntp-close-server-internal ()
  693.   "Close connection to news server."
  694.   (if nntp-server-process
  695.       (delete-process nntp-server-process))
  696.   (if nntp-server-buffer
  697.       (kill-buffer nntp-server-buffer))
  698.   (setq nntp-server-buffer nil)
  699.   (setq nntp-server-process nil))
  700.  
  701. (defun nntp-accept-response ()
  702.   "Read response of server.
  703. It is well-known that the communication speed will be much improved by
  704. defining this function as macro."
  705.   ;; To deal with server process exiting before
  706.   ;;  accept-process-output is called.
  707.   ;; Suggested by Jason Venner <jason@violet.berkeley.edu>.
  708.   ;; This is a copy of `nntp-default-sentinel'.
  709.   (or (memq (process-status nntp-server-process) '(open run))
  710.       (error "NNTP: Connection closed."))
  711.   (if nntp-buggy-select
  712.       (progn
  713.     ;; We cannot use `accept-process-output'.
  714.     ;; Fujitsu UTS requires messages during sleep-for. I don't know why.
  715.     (gnus-lazy-message "NNTP: Reading...")
  716.     (sleep-for 1)
  717.     (message ""))
  718.     (condition-case errorcode
  719.     (accept-process-output nntp-server-process)
  720.       (error
  721.        (cond ((string-equal "select error: Invalid argument" (nth 1 errorcode))
  722.           ;; Ignore select error.
  723.           nil
  724.           )
  725.          (t
  726.           (signal (car errorcode) (cdr errorcode))))
  727.        ))
  728.     ))
  729.  
  730. (provide 'nntp)
  731.  
  732. ;;; nntp.el ends here
  733.