lisp/nntp.el

   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 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       (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
  73 (defvar nntp-buggy-select (memq system-type '(fujitsu-uts))
  74   "*Non-nil if your select routine is buggy.
  75 If the select routine signals error or fall into infinite loop while
  76 waiting for the server response, the variable must be set to t.  In
  77 case of Fujitsu UTS, it is set to t since `accept-process-output'
  78 doesn't work properly.")
  79
  80 (defvar nntp-maximum-request 400
  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 \f
  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                      (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              (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 \f
 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            ;; Do check unexpected close of connection.
 340            ;; Suggested by feldmark@hanako.stars.flab.fujitsu.junet.
 341            (if status
 342                (progn (set-process-sentinel nntp-server-process
 343                                             'nntp-default-sentinel)
 344                       (nntp-send-command "^[25].*\r$" "MODE" "READER"))
 345              ;; We have to close connection here, since function
 346              ;;  `nntp-server-opened' may return incorrect status.
 347              (nntp-close-server-internal)
 348              ))
 349           ((null host)
 350            (setq nntp-status-string "NNTP server is not specified."))
 351           )
 352     status
 353     ))
 354
 355 (defun nntp-close-server ()
 356   "Close news server."
 357   (unwind-protect
 358       (progn
 359         ;; Un-set default sentinel function before closing connection.
 360         (and nntp-server-process
 361              (eq 'nntp-default-sentinel
 362                  (process-sentinel nntp-server-process))
 363              (set-process-sentinel nntp-server-process nil))
 364         ;; We cannot send QUIT command unless the process is running.
 365         (if (nntp-server-opened)
 366             (nntp-send-command nil "QUIT"))
 367         )
 368     (nntp-close-server-internal)
 369     ))
 370
 371 (fset 'nntp-request-quit (symbol-function 'nntp-close-server))
 372
 373 (defun nntp-server-opened ()
 374   "Return server process status, T or NIL.
 375 If the stream is opened, return T, otherwise return NIL."
 376   (and nntp-server-process
 377        (memq (process-status nntp-server-process) '(open run))))
 378
 379 (defun nntp-status-message ()
 380   "Return server status response as string."
 381   (if (and nntp-status-string
 382            ;; NNN MESSAGE
 383            (string-match "[0-9][0-9][0-9][ \t]+\\([^\r]*\\).*$"
 384                          nntp-status-string))
 385       (substring nntp-status-string (match-beginning 1) (match-end 1))
 386     ;; Empty message if nothing.
 387     ""
 388     ))
 389
 390 (defun nntp-request-article (id)
 391   "Select article by message ID (or number)."
 392   (prog1
 393       ;; If NEmacs, end of message may look like: "\256\215" (".^M")
 394       (nntp-send-command "^\\.\r$" "ARTICLE" id)
 395     (nntp-decode-text)
 396     ))
 397
 398 (defun nntp-request-body (id)
 399   "Select article body by message ID (or number)."
 400   (prog1
 401       ;; If NEmacs, end of message may look like: "\256\215" (".^M")
 402       (nntp-send-command "^\\.\r$" "BODY" id)
 403     (nntp-decode-text)
 404     ))
 405
 406 (defun nntp-request-head (id)
 407   "Select article head by message ID (or number)."
 408   (prog1
 409       (nntp-send-command "^\\.\r$" "HEAD" id)
 410     (nntp-decode-text)
 411     ))
 412
 413 (defun nntp-request-stat (id)
 414   "Select article by message ID (or number)."
 415   (nntp-send-command "^[23].*\r$" "STAT" id))
 416
 417 (defun nntp-request-group (group)
 418   "Select news GROUP."
 419   ;; 1.2a NNTP's group command is buggy. "^M" (\r) is not appended to
 420   ;;  end of the status message.
 421   (nntp-send-command "^[23].*$" "GROUP" group))
 422
 423 (defun nntp-request-list ()
 424   "List active newsgroups."
 425   (prog1
 426       (nntp-send-command "^\\.\r$" "LIST")
 427     (nntp-decode-text)
 428     ))
 429
 430 (defun nntp-request-list-newsgroups ()
 431   "List newsgroups (defined in NNTP2)."
 432   (prog1
 433       (nntp-send-command "^\\.\r$" "LIST NEWSGROUPS")
 434     (nntp-decode-text)
 435     ))
 436
 437 (defun nntp-request-list-distributions ()
 438   "List distributions (defined in NNTP2)."
 439   (prog1
 440       (nntp-send-command "^\\.\r$" "LIST DISTRIBUTIONS")
 441     (nntp-decode-text)
 442     ))
 443
 444 (defun nntp-request-last ()
 445   "Set current article pointer to the previous article
 446 in the current news group."
 447   (nntp-send-command "^[23].*\r$" "LAST"))
 448
 449 (defun nntp-request-next ()
 450   "Advance current article pointer."
 451   (nntp-send-command "^[23].*\r$" "NEXT"))
 452
 453 (defun nntp-request-post ()
 454   "Post a new news in current buffer."
 455   (if (nntp-send-command "^[23].*\r$" "POST")
 456       (progn
 457         (nntp-encode-text)
 458         (nntp-send-region-to-server (point-min) (point-max))
 459         ;; 1.2a NNTP's post command is buggy. "^M" (\r) is not
 460         ;;  appended to end of the status message.
 461         (nntp-wait-for-response "^[23].*$")
 462         )))
 463
 464 (defun nntp-default-sentinel (proc status)
 465   "Default sentinel function for NNTP server process."
 466   (if (and nntp-server-process
 467            (not (nntp-server-opened)))
 468       (error "NNTP: Connection closed.")
 469     ))
 470
 471 ;; Encoding and decoding of NNTP text.
 472
 473 (defun nntp-decode-text ()
 474   "Decode text transmitted by NNTP.
 475 0. Delete status line.
 476 1. Delete `^M' at end of line.
 477 2. Delete `.' at end of buffer (end of text mark).
 478 3. Delete `.' at beginning of line."
 479   (save-excursion
 480     (set-buffer nntp-server-buffer)
 481     ;; Insert newline at end of buffer.
 482     (goto-char (point-max))
 483     (if (not (bolp))
 484         (insert "\n"))
 485     ;; Delete status line.
 486     (goto-char (point-min))
 487     (delete-region (point) (progn (forward-line 1) (point)))
 488     ;; Delete `^M' at end of line.
 489     ;; (replace-regexp "\r$" "")
 490     (while (not (eobp))
 491       (end-of-line)
 492       (if (= (preceding-char) ?\r)
 493           (delete-char -1))
 494       (forward-line 1)
 495       )
 496     ;; Delete `.' at end of buffer (end of text mark).
 497     (goto-char (point-max))
 498     (forward-line -1)                   ;(beginning-of-line)
 499     (if (looking-at "^\\.$")
 500         (delete-region (point) (progn (forward-line 1) (point))))
 501     ;; Replace `..' at beginning of line with `.'.
 502     (goto-char (point-min))
 503     ;; (replace-regexp "^\\.\\." ".")
 504     (while (search-forward "\n.." nil t)
 505       (delete-char -1))
 506     ))
 507
 508 (defun nntp-encode-text ()
 509   "Encode text in current buffer for NNTP transmission.
 510 1. Insert `.' at beginning of line.
 511 2. Insert `.' at end of buffer (end of text mark)."
 512   (save-excursion
 513     ;; Insert newline at end of buffer.
 514     (goto-char (point-max))
 515     (if (not (bolp))
 516         (insert "\n"))
 517     ;; Replace `.' at beginning of line with `..'.
 518     (goto-char (point-min))
 519     ;; (replace-regexp "^\\." "..")
 520     (while (search-forward "\n." nil t)
 521       (insert "."))
 522     ;; Insert `.' at end of buffer (end of text mark).
 523     (goto-char (point-max))
 524     (insert ".\r\n")
 525     ))
 526
 527 \f
 528 ;;;
 529 ;;; Synchronous Communication with NNTP Server.
 530 ;;;
 531
 532 (defun nntp-send-command (response cmd &rest args)
 533   "Wait for server RESPONSE after sending CMD and optional ARGS to server."
 534   (save-excursion
 535     ;; Clear communication buffer.
 536     (set-buffer nntp-server-buffer)
 537     (erase-buffer)
 538     (apply 'nntp-send-strings-to-server cmd args)
 539     (if response
 540         (nntp-wait-for-response response)
 541       t)
 542     ))
 543
 544 (defun nntp-wait-for-response (regexp)
 545   "Wait for server response which matches REGEXP."
 546   (save-excursion
 547     (let ((status t)
 548           (wait t)
 549           (dotnum 0)                    ;Number of "." being displayed.
 550           (dotsize                      ;How often "." displayed.
 551            (if (numberp nntp-debug-read) nntp-debug-read 10000)))
 552       (set-buffer nntp-server-buffer)
 553       ;; Wait for status response (RFC977).
 554       ;; 1xx - Informative message.
 555       ;; 2xx - Command ok.
 556       ;; 3xx - Command ok so far, send the rest of it.
 557       ;; 4xx - Command was correct, but couldn't be performed for some
 558       ;;       reason.
 559       ;; 5xx - Command unimplemented, or incorrect, or a serious
 560       ;;       program error occurred.
 561       (nntp-accept-response)
 562       (while wait
 563         (goto-char (point-min))
 564         (cond ((looking-at "[23]")
 565                (setq wait nil))
 566               ((looking-at "[45]")
 567                (setq status nil)
 568                (setq wait nil))
 569               (t (nntp-accept-response))
 570               ))
 571       ;; Save status message.
 572       (end-of-line)
 573       (setq nntp-status-string
 574             (buffer-substring (point-min) (point)))
 575       (if status
 576           (progn
 577             (setq wait t)
 578             (while wait
 579               (goto-char (point-max))
 580               (forward-line -1)         ;(beginning-of-line)
 581               ;;(message (buffer-substring
 582               ;;         (point)
 583               ;;         (save-excursion (end-of-line) (point))))
 584               (if (looking-at regexp)
 585                   (setq wait nil)
 586                 (if nntp-debug-read
 587                     (let ((newnum (/ (buffer-size) dotsize)))
 588                       (if (not (= dotnum newnum))
 589                           (progn
 590                             (setq dotnum newnum)
 591                             (message "NNTP: Reading %s"
 592                                      (make-string dotnum ?.))))))
 593                 (nntp-accept-response)
 594                 ;;(if nntp-debug-read (message ""))
 595                 ))
 596             ;; Remove "...".
 597             (if (and nntp-debug-read (> dotnum 0))
 598                 (message ""))
 599             ;; Successfully received server response.
 600             t
 601             ))
 602       )))
 603
 604 \f
 605 ;;;
 606 ;;; Low-Level Interface to NNTP Server.
 607 ;;;
 608
 609 (defun nntp-send-strings-to-server (&rest strings)
 610   "Send list of STRINGS to news server as command and its arguments."
 611   (let ((cmd (car strings))
 612         (strings (cdr strings)))
 613     ;; Command and each argument must be separated by one or more spaces.
 614     (while strings
 615       (setq cmd (concat cmd " " (car strings)))
 616       (setq strings (cdr strings)))
 617     ;; Command line must be terminated by a CR-LF.
 618     (process-send-string nntp-server-process (concat cmd "\r\n"))
 619     ))
 620
 621 (defun nntp-send-region-to-server (begin end)
 622   "Send current buffer region (from BEGIN to END) to news server."
 623   (save-excursion
 624     ;; We have to work in the buffer associated with NNTP server
 625     ;;  process because of NEmacs hack.
 626     (copy-to-buffer nntp-server-buffer begin end)
 627     (set-buffer nntp-server-buffer)
 628     (process-send-region nntp-server-process (point-min) (point-max))
 629     ;; We cannot erase buffer, because reply may be received.
 630     (delete-region begin end)
 631     ))
 632
 633 (defun nntp-open-server-internal (host &optional service)
 634   "Open connection to news server on HOST by SERVICE (default is nntp)."
 635   (save-excursion
 636     ;; Use TCP/IP stream emulation package if needed.
 637     (or (fboundp 'open-network-stream)
 638         (require 'tcp))
 639     ;; Initialize communication buffer.
 640     (setq nntp-server-buffer (get-buffer-create " *nntpd*"))
 641     (set-buffer nntp-server-buffer)
 642     (buffer-flush-undo (current-buffer))
 643     (erase-buffer)
 644     (kill-all-local-variables)
 645     (setq case-fold-search t)           ;Should ignore case.
 646     (setq nntp-server-process
 647           (open-network-stream "nntpd" (current-buffer)
 648                                host (or service "nntp")))
 649     (setq nntp-server-name host)
 650     ;; It is possible to change kanji-fileio-code in this hook.
 651     (run-hooks 'nntp-server-hook)
 652     ;; Return the server process.
 653     nntp-server-process
 654     ))
 655
 656 (defun nntp-close-server-internal ()
 657   "Close connection to news server."
 658   (if nntp-server-process
 659       (delete-process nntp-server-process))
 660   (if nntp-server-buffer
 661       (kill-buffer nntp-server-buffer))
 662   (setq nntp-server-buffer nil)
 663   (setq nntp-server-process nil))
 664
 665 (defun nntp-accept-response ()
 666   "Read response of server.
 667 It is well-known that the communication speed will be much improved by
 668 defining this function as macro."
 669   ;; To deal with server process exiting before
 670   ;;  accept-process-output is called.
 671   ;; Suggested by Jason Venner <jason@violet.berkeley.edu>.
 672   ;; This is a copy of `nntp-default-sentinel'.
 673   (or (memq (process-status nntp-server-process) '(open run))
 674       (error "NNTP: Connection closed."))
 675   (if nntp-buggy-select
 676       (progn
 677         ;; We cannot use `accept-process-output'.
 678         ;; Fujitsu UTS requires messages during sleep-for. I don't know why.
 679         (message "NNTP: Reading...")
 680         (sleep-for 1)
 681         (message ""))
 682     (condition-case errorcode
 683         (accept-process-output nntp-server-process)
 684       (error
 685        (cond ((string-equal "select error: Invalid argument" (nth 1 errorcode))
 686               ;; Ignore select error.
 687               nil
 688               )
 689              (t
 690               (signal (car errorcode) (cdr errorcode))))
 691        ))
 692     ))
 693
 694 (provide 'nntp)
 695
 696 ;;; nntp.el ends here