lisp/nntp.el

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