code.delx.au - gnu-emacs/blob - lisp/nntp.el

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