--- /dev/null
+;;; MH folder access using NNTP for GNU Emacs
+;; Copyright (C) 1988, 1989 Fujitsu Laboratories LTD.
+;; Copyright (C) 1988, 1989, 1990 Masanobu UMEDA
+;; $Header: mhspool.el,v 1.5 90/03/23 13:25:23 umerin Locked $
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY. No author or distributor
+;; accepts responsibility to anyone for the consequences of using it
+;; or for whether it serves any particular purpose or works at all,
+;; unless he says so in writing. Refer to the GNU Emacs General Public
+;; License for full details.
+
+;; Everyone is granted permission to copy, modify and redistribute
+;; GNU Emacs, but only under the conditions described in the
+;; GNU Emacs General Public License. A copy of this license is
+;; supposed to have been given to you along with GNU Emacs so you
+;; can know your rights and responsibilities. It should be in a
+;; file named COPYING. Among other things, the copyright notice
+;; and this notice must be preserved on all copies.
+
+(provide 'mhspool)
+(require 'nntp)
+
+;; This package enables you to read mail or articles in MH folders, or
+;; articles saved by GNUS. In any case, the file names of mail or
+;; articles must consist of only numeric letters.
+
+;; Before using this package, you have to create a server specific
+;; startup file according to the directory which you want to read. For
+;; example, if you want to read mail under the directory named
+;; `~/Mail', the file must be a file named `.newsrc-:Mail'. (There is
+;; no way to specify hierarchical directory now.) In this case, the
+;; name of the NNTP server passed to GNUS must be `:Mail'.
+
+(defvar mhspool-list-directory-switches '("-R")
+ "*Switches for nntp-request-list to pass to `ls' for gettting file lists.
+One entry should appear on one line. You may need to add `-1' option.")
+
+\f
+
+(defconst mhspool-version "MHSPOOL 1.5"
+ "Version numbers of this version of MHSPOOL.")
+
+(defvar mhspool-spool-directory "~/Mail"
+ "Private mail directory.")
+
+(defvar mhspool-current-directory nil
+ "Current news group directory.")
+
+;;;
+;;; Replacement of Extended Command for retrieving many headers.
+;;;
+
+(defun mhspool-retrieve-headers (sequence)
+ "Return list of article headers specified by SEQUENCE of article id.
+The format of list is
+ `([NUMBER SUBJECT FROM XREF LINES DATE MESSAGE-ID REFERENCES] ...)'.
+Reader macros for the vector are defined as `nntp-header-FIELD'.
+Writer macros for the vector are defined as `nntp-set-header-FIELD'.
+News group must be selected before calling me."
+ (save-excursion
+ (set-buffer nntp-server-buffer)
+ ;;(erase-buffer)
+ (let ((file nil)
+ (number (length sequence))
+ (count 0)
+ (headers nil) ;Result list.
+ (article 0)
+ (subject nil)
+ (message-id nil)
+ (from nil)
+ (xref nil)
+ (lines 0)
+ (date nil)
+ (references nil))
+ (while sequence
+ ;;(nntp-send-strings-to-server "HEAD" (car sequence))
+ (setq article (car sequence))
+ (setq file
+ (concat mhspool-current-directory (prin1-to-string article)))
+ (if (and (file-exists-p file)
+ (not (file-directory-p file)))
+ (progn
+ (erase-buffer)
+ (insert-file-contents file)
+ ;; Make message body invisible.
+ (goto-char (point-min))
+ (search-forward "\n\n" nil 'move)
+ (narrow-to-region (point-min) (point))
+ ;; Fold continuation lines.
+ (goto-char (point-min))
+ (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t)
+ (replace-match " " t t))
+ ;; Make it possible to search for `\nFIELD'.
+ (goto-char (point-min))
+ (insert "\n")
+ ;; Extract From:
+ (goto-char (point-min))
+ (if (search-forward "\nFrom: " nil t)
+ (setq from (buffer-substring
+ (point)
+ (save-excursion (end-of-line) (point))))
+ (setq from "(Unknown User)"))
+ ;; Extract Subject:
+ (goto-char (point-min))
+ (if (search-forward "\nSubject: " nil t)
+ (setq subject (buffer-substring
+ (point)
+ (save-excursion (end-of-line) (point))))
+ (setq subject "(None)"))
+ ;; Extract Message-ID:
+ (goto-char (point-min))
+ (if (search-forward "\nMessage-ID: " nil t)
+ (setq message-id (buffer-substring
+ (point)
+ (save-excursion (end-of-line) (point))))
+ (setq message-id nil))
+ ;; Extract Date:
+ (goto-char (point-min))
+ (if (search-forward "\nDate: " nil t)
+ (setq date (buffer-substring
+ (point)
+ (save-excursion (end-of-line) (point))))
+ (setq date nil))
+ ;; Extract Lines:
+ (goto-char (point-min))
+ (if (search-forward "\nLines: " nil t)
+ (setq lines (string-to-int
+ (buffer-substring
+ (point)
+ (save-excursion (end-of-line) (point)))))
+ (setq lines 0))
+ ;; Extract Xref:
+ (goto-char (point-min))
+ (if (search-forward "\nXref: " nil t)
+ (setq xref (buffer-substring
+ (point)
+ (save-excursion (end-of-line) (point))))
+ (setq xref nil))
+ ;; Extract References:
+ ;; If no References: field, use In-Reply-To: field instead.
+ ;; Suggested by tanaka@flab.fujitsu.co.jp (Hiroshi TANAKA).
+ (goto-char (point-min))
+ (if (or (search-forward "\nReferences: " nil t)
+ (search-forward "\nIn-Reply-To: " nil t))
+ (setq references (buffer-substring
+ (point)
+ (save-excursion (end-of-line) (point))))
+ (setq references nil))
+ (setq headers
+ (cons (vector article subject from
+ xref lines date
+ message-id references) headers))
+ ))
+ (setq sequence (cdr sequence))
+ (setq count (1+ count))
+ (and (numberp nntp-large-newsgroup)
+ (> number nntp-large-newsgroup)
+ (zerop (% count 20))
+ (message "MHSPOOL: %d%% of headers received."
+ (/ (* count 100) number)))
+ )
+ (and (numberp nntp-large-newsgroup)
+ (> number nntp-large-newsgroup)
+ (message "MHSPOOL: 100%% of headers received."))
+ (nreverse headers)
+ )))
+
+\f
+;;;
+;;; Replacement of NNTP Raw Interface.
+;;;
+
+(defun mhspool-open-server (host &optional service)
+ "Open news server on HOST.
+If HOST is nil, use value of environment variable `NNTPSERVER'.
+If optional argument SERVICE is non-nil, open by the service name."
+ (let ((host (or host (getenv "NNTPSERVER")))
+ (status nil))
+ ;; Get directory name from HOST name.
+ (if (string-match ":\\(.+\\)$" host)
+ (progn
+ (setq mhspool-spool-directory
+ (file-name-as-directory
+ (expand-file-name
+ (substring host (match-beginning 1) (match-end 1))
+ (expand-file-name "~/" nil))))
+ (setq host (system-name)))
+ (setq mhspool-spool-directory nil))
+ (setq nntp-status-message-string "")
+ (cond ((and (stringp host)
+ (stringp mhspool-spool-directory)
+ (file-directory-p mhspool-spool-directory)
+ (string-equal host (system-name)))
+ (setq status (mhspool-open-server-internal host service)))
+ ((string-equal host (system-name))
+ (setq nntp-status-message-string
+ (format "No such directory: %s. Goodbye."
+ mhspool-spool-directory)))
+ ((null host)
+ (setq nntp-status-message-string "NNTP server is not specified."))
+ (t
+ (setq nntp-status-message-string
+ (format "MHSPOOL: cannot talk to %s." host)))
+ )
+ status
+ ))
+
+(defun mhspool-close-server ()
+ "Close news server."
+ (mhspool-close-server-internal))
+
+(fset 'mhspool-request-quit (symbol-function 'mhspool-close-server))
+
+(defun mhspool-server-opened ()
+ "Return server process status, T or NIL.
+If the stream is opened, return T, otherwise return NIL."
+ (and nntp-server-buffer
+ (get-buffer nntp-server-buffer)))
+
+(defun mhspool-status-message ()
+ "Return server status response as string."
+ nntp-status-message-string
+ )
+
+(defun mhspool-request-article (id)
+ "Select article by message ID (or number)."
+ (let ((file (concat mhspool-current-directory (prin1-to-string id))))
+ (if (and (stringp file)
+ (file-exists-p file)
+ (not (file-directory-p file)))
+ (save-excursion
+ (mhspool-find-file file)))
+ ))
+
+(defun mhspool-request-body (id)
+ "Select article body by message ID (or number)."
+ (if (mhspool-request-article id)
+ (save-excursion
+ (set-buffer nntp-server-buffer)
+ (goto-char (point-min))
+ (if (search-forward "\n\n" nil t)
+ (delete-region (point-min) (point)))
+ t
+ )
+ ))
+
+(defun mhspool-request-head (id)
+ "Select article head by message ID (or number)."
+ (if (mhspool-request-article id)
+ (save-excursion
+ (set-buffer nntp-server-buffer)
+ (goto-char (point-min))
+ (if (search-forward "\n\n" nil t)
+ (delete-region (1- (point)) (point-max)))
+ t
+ )
+ ))
+
+(defun mhspool-request-stat (id)
+ "Select article by message ID (or number)."
+ (error "MHSPOOL: STAT is not implemented."))
+
+(defun mhspool-request-group (group)
+ "Select news GROUP."
+ (cond ((file-directory-p
+ (mhspool-article-pathname group))
+ ;; Mail/NEWS.GROUP/N
+ (setq mhspool-current-directory
+ (mhspool-article-pathname group)))
+ ((file-directory-p
+ (mhspool-article-pathname
+ (mhspool-replace-chars-in-string group ?. ?/)))
+ ;; Mail/NEWS/GROUP/N
+ (setq mhspool-current-directory
+ (mhspool-article-pathname
+ (mhspool-replace-chars-in-string group ?. ?/))))
+ ))
+
+(defun mhspool-request-list ()
+ "List valid newsgoups."
+ (save-excursion
+ (let* ((newsgroup nil)
+ (articles nil)
+ (directory (file-name-as-directory
+ (expand-file-name mhspool-spool-directory nil)))
+ (folder-regexp (concat "^" (regexp-quote directory) "\\(.+\\):$"))
+ (buffer (get-buffer-create " *GNUS file listing*")))
+ (set-buffer nntp-server-buffer)
+ (erase-buffer)
+ (set-buffer buffer)
+ (erase-buffer)
+ (apply 'call-process
+ "ls" nil t nil
+ (append mhspool-list-directory-switches (list directory)))
+ (goto-char (point-min))
+ (while (re-search-forward folder-regexp nil t)
+ (setq newsgroup
+ (mhspool-replace-chars-in-string
+ (buffer-substring (match-beginning 1) (match-end 1)) ?/ ?.))
+ (setq articles nil)
+ (forward-line 1) ;(beginning-of-line)
+ ;; Thank nobu@flab.fujitsu.junet for his bug fixes.
+ (while (and (not (eobp))
+ (not (looking-at "^$")))
+ (if (looking-at "^[0-9]+$")
+ (setq articles
+ (cons (string-to-int
+ (buffer-substring
+ (match-beginning 0) (match-end 0)))
+ articles)))
+ (forward-line 1))
+ (if articles
+ (princ (format "%s %d %d n\n" newsgroup
+ (apply (function max) articles)
+ (apply (function min) articles))
+ nntp-server-buffer))
+ )
+ (kill-buffer buffer)
+ (set-buffer nntp-server-buffer)
+ (buffer-size)
+ )))
+
+(defun mhspool-request-last ()
+ "Set current article pointer to the previous article
+in the current news group."
+ (error "MHSPOOL: LAST is not implemented."))
+
+(defun mhspool-request-next ()
+ "Advance current article pointer."
+ (error "MHSPOOL: NEXT is not implemented."))
+
+(defun mhspool-request-post ()
+ "Post a new news in current buffer."
+ (setq nntp-status-message-string "MHSPOOL: what do you mean post?")
+ nil
+ )
+
+\f
+;;;
+;;; Replacement of Low-Level Interface to NNTP Server.
+;;;
+
+(defun mhspool-open-server-internal (host &optional service)
+ "Open connection to news server on HOST by SERVICE (default is nntp)."
+ (save-excursion
+ (if (not (string-equal host (system-name)))
+ (error "MHSPOOL: cannot talk to %s." host))
+ ;; Initialize communication buffer.
+ (setq nntp-server-buffer (get-buffer-create " *nntpd*"))
+ (set-buffer nntp-server-buffer)
+ (buffer-flush-undo (current-buffer))
+ (erase-buffer)
+ (kill-all-local-variables)
+ (setq case-fold-search t) ;Should ignore case.
+ (setq nntp-server-process nil)
+ (setq nntp-server-name host)
+ ;; It is possible to change kanji-fileio-code in this hook.
+ (run-hooks 'nntp-server-hook)
+ t
+ ))
+
+(defun mhspool-close-server-internal ()
+ "Close connection to news server."
+ (if nntp-server-buffer
+ (kill-buffer nntp-server-buffer))
+ (setq nntp-server-buffer nil)
+ (setq nntp-server-process nil))
+
+(defun mhspool-find-file (file)
+ "Insert FILE in server buffer safely."
+ (set-buffer nntp-server-buffer)
+ (erase-buffer)
+ (condition-case ()
+ (progn
+ (insert-file-contents file)
+ (goto-char (point-min))
+ ;; If there is no body, `^L' appears at end of file. Special
+ ;; hack for MH folder.
+ (and (search-forward "\n\n" nil t)
+ (string-equal (buffer-substring (point) (point-max)) "\^L")
+ (delete-char 1))
+ t
+ )
+ (file-error nil)
+ ))
+
+(defun mhspool-article-pathname (group)
+ "Make pathname for GROUP."
+ (concat (file-name-as-directory mhspool-spool-directory) group "/"))
+
+(defun mhspool-replace-chars-in-string (string from to)
+ "Replace characters in STRING from FROM to TO."
+ (let ((string (substring string 0)) ;Copy string.
+ (len (length string))
+ (idx 0))
+ ;; Replace all occurence of FROM with TO.
+ (while (< idx len)
+ (if (= (aref string idx) from)
+ (aset string idx to))
+ (setq idx (1+ idx)))
+ string
+ ))
--- /dev/null
+;;; Spool access using NNTP for GNU Emacs
+;; Copyright (C) 1988, 1989 Fujitsu Laboratories LTD.
+;; Copyright (C) 1988, 1989, 1990 Masanobu UMEDA
+;; $Header: nnspool.el,v 1.10 90/03/23 13:25:25 umerin Locked $
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY. No author or distributor
+;; accepts responsibility to anyone for the consequences of using it
+;; or for whether it serves any particular purpose or works at all,
+;; unless he says so in writing. Refer to the GNU Emacs General Public
+;; License for full details.
+
+;; Everyone is granted permission to copy, modify and redistribute
+;; GNU Emacs, but only under the conditions described in the
+;; GNU Emacs General Public License. A copy of this license is
+;; supposed to have been given to you along with GNU Emacs so you
+;; can know your rights and responsibilities. It should be in a
+;; file named COPYING. Among other things, the copyright notice
+;; and this notice must be preserved on all copies.
+
+(provide 'nnspool)
+(require 'nntp)
+
+(defvar nnspool-inews-program news-inews-program
+ "*Program to post news.")
+
+(defvar nnspool-inews-switches '("-h")
+ "*Switches for nnspool-request-post to pass to `inews' for posting news.")
+
+(defvar nnspool-spool-directory news-path
+ "*Local news spool directory.")
+
+(defvar nnspool-active-file "/usr/lib/news/active"
+ "*Local news active file.")
+
+(defvar nnspool-history-file "/usr/lib/news/history"
+ "*Local news history file.")
+
+\f
+
+(defconst nnspool-version "NNSPOOL 1.10"
+ "Version numbers of this version of NNSPOOL.")
+
+(defvar nnspool-current-directory nil
+ "Current news group directory.")
+
+;;;
+;;; Replacement of Extended Command for retrieving many headers.
+;;;
+
+(defun nnspool-retrieve-headers (sequence)
+ "Return list of article headers specified by SEQUENCE of article id.
+The format of list is
+ `([NUMBER SUBJECT FROM XREF LINES DATE MESSAGE-ID REFERENCES] ...)'.
+Reader macros for the vector are defined as `nntp-header-FIELD'.
+Writer macros for the vector are defined as `nntp-set-header-FIELD'.
+News group must be selected before calling me."
+ (save-excursion
+ (set-buffer nntp-server-buffer)
+ ;;(erase-buffer)
+ (let ((file nil)
+ (number (length sequence))
+ (count 0)
+ (headers nil) ;Result list.
+ (article 0)
+ (subject nil)
+ (message-id nil)
+ (from nil)
+ (xref nil)
+ (lines 0)
+ (date nil)
+ (references nil))
+ (while sequence
+ ;;(nntp-send-strings-to-server "HEAD" (car sequence))
+ (setq article (car sequence))
+ (setq file
+ (concat nnspool-current-directory (prin1-to-string article)))
+ (if (and (file-exists-p file)
+ (not (file-directory-p file)))
+ (progn
+ (erase-buffer)
+ (insert-file-contents file)
+ ;; Make message body invisible.
+ (goto-char (point-min))
+ (search-forward "\n\n" nil 'move)
+ (narrow-to-region (point-min) (point))
+ ;; Fold continuation lines.
+ (goto-char (point-min))
+ (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t)
+ (replace-match " " t t))
+ ;; Make it possible to search for `\nFIELD'.
+ (goto-char (point-min))
+ (insert "\n")
+ ;; Extract From:
+ (goto-char (point-min))
+ (if (search-forward "\nFrom: " nil t)
+ (setq from (buffer-substring
+ (point)
+ (save-excursion (end-of-line) (point))))
+ (setq from "(Unknown User)"))
+ ;; Extract Subject:
+ (goto-char (point-min))
+ (if (search-forward "\nSubject: " nil t)
+ (setq subject (buffer-substring
+ (point)
+ (save-excursion (end-of-line) (point))))
+ (setq subject "(None)"))
+ ;; Extract Message-ID:
+ (goto-char (point-min))
+ (if (search-forward "\nMessage-ID: " nil t)
+ (setq message-id (buffer-substring
+ (point)
+ (save-excursion (end-of-line) (point))))
+ (setq message-id nil))
+ ;; Extract Date:
+ (goto-char (point-min))
+ (if (search-forward "\nDate: " nil t)
+ (setq date (buffer-substring
+ (point)
+ (save-excursion (end-of-line) (point))))
+ (setq date nil))
+ ;; Extract Lines:
+ (goto-char (point-min))
+ (if (search-forward "\nLines: " nil t)
+ (setq lines (string-to-int
+ (buffer-substring
+ (point)
+ (save-excursion (end-of-line) (point)))))
+ (setq lines 0))
+ ;; Extract Xref:
+ (goto-char (point-min))
+ (if (search-forward "\nXref: " nil t)
+ (setq xref (buffer-substring
+ (point)
+ (save-excursion (end-of-line) (point))))
+ (setq xref nil))
+ ;; Extract References:
+ (goto-char (point-min))
+ (if (search-forward "\nReferences: " nil t)
+ (setq references (buffer-substring
+ (point)
+ (save-excursion (end-of-line) (point))))
+ (setq references nil))
+ (setq headers
+ (cons (vector article subject from
+ xref lines date
+ message-id references) headers))
+ ))
+ (setq sequence (cdr sequence))
+ (setq count (1+ count))
+ (and (numberp nntp-large-newsgroup)
+ (> number nntp-large-newsgroup)
+ (zerop (% count 20))
+ (message "NNSPOOL: %d%% of headers received."
+ (/ (* count 100) number)))
+ )
+ (and (numberp nntp-large-newsgroup)
+ (> number nntp-large-newsgroup)
+ (message "NNSPOOL: 100%% of headers received."))
+ (nreverse headers)
+ )))
+
+\f
+;;;
+;;; Replacement of NNTP Raw Interface.
+;;;
+
+(defun nnspool-open-server (host &optional service)
+ "Open news server on HOST.
+If HOST is nil, use value of environment variable `NNTPSERVER'.
+If optional argument SERVICE is non-nil, open by the service name."
+ (let ((host (or host (getenv "NNTPSERVER")))
+ (status nil))
+ (setq nntp-status-message-string "")
+ (cond ((and (file-directory-p nnspool-spool-directory)
+ (file-exists-p nnspool-active-file)
+ (string-equal host (system-name)))
+ (setq status (nnspool-open-server-internal host service)))
+ ((string-equal host (system-name))
+ (setq nntp-status-message-string
+ (format "%s has no news spool. Goodbye." host)))
+ ((null host)
+ (setq nntp-status-message-string "NNTP server is not specified."))
+ (t
+ (setq nntp-status-message-string
+ (format "NNSPOOL: cannot talk to %s." host)))
+ )
+ status
+ ))
+
+(defun nnspool-close-server ()
+ "Close news server."
+ (nnspool-close-server-internal))
+
+(fset 'nnspool-request-quit (symbol-function 'nnspool-close-server))
+
+(defun nnspool-server-opened ()
+ "Return server process status, T or NIL.
+If the stream is opened, return T, otherwise return NIL."
+ (and nntp-server-buffer
+ (get-buffer nntp-server-buffer)))
+
+(defun nnspool-status-message ()
+ "Return server status response as string."
+ nntp-status-message-string
+ )
+
+(defun nnspool-request-article (id)
+ "Select article by message ID (or number)."
+ (let ((file (if (stringp id)
+ (nnspool-find-article-by-message-id id)
+ (concat nnspool-current-directory (prin1-to-string id)))))
+ (if (and (stringp file)
+ (file-exists-p file)
+ (not (file-directory-p file)))
+ (save-excursion
+ (nnspool-find-file file)))
+ ))
+
+(defun nnspool-request-body (id)
+ "Select article body by message ID (or number)."
+ (if (nnspool-request-article id)
+ (save-excursion
+ (set-buffer nntp-server-buffer)
+ (goto-char (point-min))
+ (if (search-forward "\n\n" nil t)
+ (delete-region (point-min) (point)))
+ t
+ )
+ ))
+
+(defun nnspool-request-head (id)
+ "Select article head by message ID (or number)."
+ (if (nnspool-request-article id)
+ (save-excursion
+ (set-buffer nntp-server-buffer)
+ (goto-char (point-min))
+ (if (search-forward "\n\n" nil t)
+ (delete-region (1- (point)) (point-max)))
+ t
+ )
+ ))
+
+(defun nnspool-request-stat (id)
+ "Select article by message ID (or number)."
+ (error "NNSPOOL: STAT is not implemented."))
+
+(defun nnspool-request-group (group)
+ "Select news GROUP."
+ (let ((pathname (nnspool-article-pathname
+ (nnspool-replace-chars-in-string group ?. ?/))))
+ (if (file-directory-p pathname)
+ (setq nnspool-current-directory pathname))
+ ))
+
+(defun nnspool-request-list ()
+ "List valid newsgoups."
+ (save-excursion
+ (nnspool-find-file nnspool-active-file)))
+
+(defun nnspool-request-last ()
+ "Set current article pointer to the previous article
+in the current news group."
+ (error "NNSPOOL: LAST is not implemented."))
+
+(defun nnspool-request-next ()
+ "Advance current article pointer."
+ (error "NNSPOOL: NEXT is not implemented."))
+
+(defun nnspool-request-post ()
+ "Post a new news in current buffer."
+ (save-excursion
+ ;; We have to work in the server buffer because of NEmacs hack.
+ (copy-to-buffer nntp-server-buffer (point-min) (point-max))
+ (set-buffer nntp-server-buffer)
+ (apply 'call-process-region
+ (point-min) (point-max)
+ nnspool-inews-program 'delete t nil nnspool-inews-switches)
+ (prog1
+ (or (zerop (buffer-size))
+ ;; If inews returns strings, it must be error message
+ ;; unless SPOOLNEWS is defined.
+ ;; This condition is very weak, but there is no good rule
+ ;; identifying errors when SPOOLNEWS is defined.
+ ;; Suggested by ohm@kaba.junet.
+ (string-match "spooled" (buffer-string)))
+ ;; Make status message by unfolding lines.
+ (subst-char-in-region (point-min) (point-max) ?\n ?\\ 'noundo)
+ (setq nntp-status-message-string (buffer-string))
+ (erase-buffer))
+ ))
+
+\f
+;;;
+;;; Replacement of Low-Level Interface to NNTP Server.
+;;;
+
+(defun nnspool-open-server-internal (host &optional service)
+ "Open connection to news server on HOST by SERVICE (default is nntp)."
+ (save-excursion
+ (if (not (string-equal host (system-name)))
+ (error "NNSPOOL: cannot talk to %s." host))
+ ;; Initialize communication buffer.
+ (setq nntp-server-buffer (get-buffer-create " *nntpd*"))
+ (set-buffer nntp-server-buffer)
+ (buffer-flush-undo (current-buffer))
+ (erase-buffer)
+ (kill-all-local-variables)
+ (setq case-fold-search t) ;Should ignore case.
+ (setq nntp-server-process nil)
+ (setq nntp-server-name host)
+ ;; It is possible to change kanji-fileio-code in this hook.
+ (run-hooks 'nntp-server-hook)
+ t
+ ))
+
+(defun nnspool-close-server-internal ()
+ "Close connection to news server."
+ (if (get-file-buffer nnspool-history-file)
+ (kill-buffer (get-file-buffer nnspool-history-file)))
+ (if nntp-server-buffer
+ (kill-buffer nntp-server-buffer))
+ (setq nntp-server-buffer nil)
+ (setq nntp-server-process nil))
+
+(defun nnspool-find-article-by-message-id (id)
+ "Return full pathname of an artilce identified by message-ID."
+ (save-excursion
+ (let ((buffer (get-file-buffer nnspool-history-file)))
+ (if buffer
+ (set-buffer buffer)
+ ;; Finding history file may take lots of time.
+ (message "Reading history file...")
+ (set-buffer (find-file-noselect nnspool-history-file))
+ (message "Reading history file... done")))
+ ;; Search from end of the file. I think this is much faster than
+ ;; do from the beginning of the file.
+ (goto-char (point-max))
+ (if (re-search-backward
+ (concat "^" (regexp-quote id)
+ "[ \t].*[ \t]\\([^ \t/]+\\)/\\([0-9]+\\)[ \t]*$") nil t)
+ (let ((group (buffer-substring (match-beginning 1) (match-end 1)))
+ (number (buffer-substring (match-beginning 2) (match-end 2))))
+ (concat (nnspool-article-pathname
+ (nnspool-replace-chars-in-string group ?. ?/))
+ number))
+ )))
+
+(defun nnspool-find-file (file)
+ "Insert FILE in server buffer safely."
+ (set-buffer nntp-server-buffer)
+ (erase-buffer)
+ (condition-case ()
+ (progn (insert-file-contents file) t)
+ (file-error nil)
+ ))
+
+(defun nnspool-article-pathname (group)
+ "Make pathname for GROUP."
+ (concat (file-name-as-directory nnspool-spool-directory) group "/"))
+
+(defun nnspool-replace-chars-in-string (string from to)
+ "Replace characters in STRING from FROM to TO."
+ (let ((string (substring string 0)) ;Copy string.
+ (len (length string))
+ (idx 0))
+ ;; Replace all occurence of FROM with TO.
+ (while (< idx len)
+ (if (= (aref string idx) from)
+ (aset string idx to))
+ (setq idx (1+ idx)))
+ string
+ ))
--- /dev/null
+;;; NNTP (RFC977) Interface for GNU Emacs
+;; Copyright (C) 1987, 1988, 1989 Fujitsu Laboratories LTD.
+;; Copyright (C) 1987, 1988, 1989, 1990 Masanobu UMEDA
+;; $Header: nntp.el,v 3.10 90/03/23 13:25:27 umerin Locked $
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY. No author or distributor
+;; accepts responsibility to anyone for the consequences of using it
+;; or for whether it serves any particular purpose or works at all,
+;; unless he says so in writing. Refer to the GNU Emacs General Public
+;; License for full details.
+
+;; Everyone is granted permission to copy, modify and redistribute
+;; GNU Emacs, but only under the conditions described in the
+;; GNU Emacs General Public License. A copy of this license is
+;; supposed to have been given to you along with GNU Emacs so you
+;; can know your rights and responsibilities. It should be in a
+;; file named COPYING. Among other things, the copyright notice
+;; and this notice must be preserved on all copies.
+
+;; This implementation is tested on both 1.2a and 1.5 version of the
+;; NNTP package.
+
+;; Troubleshooting of NNTP
+;;
+;; (1) Select routine may signal an error or fall into infinite loop
+;; while waiting for the server response. In this case, you'd better
+;; not use byte-compiled codes but original source. If you still have
+;; a problems with it, set the variable `nntp-buggy-select' to T.
+;;
+;; (2) Emacs may hang up while retrieving headers since too many
+;; requests have been sent to the NNTP server without reading their
+;; replies. In this case, reduce the number of the requests sent to
+;; the server at one time by setting the variable
+;; `nntp-maximum-request' to a lower value.
+;;
+;; (3) If the TCP/IP stream (open-network-stream) is not supported by
+;; emacs, compile and install `tcp.el' and `tcp.c' which is an
+;; emulation program of the stream. If you modified `tcp.c' for your
+;; system, please send me the diffs. I'll include some of them in the
+;; future releases.
+
+(provide 'nntp)
+
+(defvar nntp-server-hook nil
+ "*Hooks for the NNTP server.
+If the kanji code of the NNTP server is different from the local kanji
+code, the correct kanji code of the buffer associated with the NNTP
+server must be specified as follows:
+
+(setq nntp-server-hook
+ '(lambda ()
+ ;; Server's Kanji code is EUC (NEmacs hack).
+ (make-local-variable 'kanji-fileio-code)
+ (setq kanji-fileio-code 0)))
+
+If you'd like to change something depending on the server in this
+hook, use the variable `nntp-server-name'.")
+
+(defvar nntp-buggy-select (memq system-type '(usg-unix-v fujitsu-uts))
+ "*T if your select routine is buggy.
+If the select routine signals error or fall into infinite loop while
+waiting for the server response, the variable must be set to t. In
+case of Fujitsu UTS, it is set to T since `accept-process-output'
+doesn't work properly.")
+
+(defvar nntp-maximum-request 400
+ "*The maximum number of the requests sent to the NNTP server at one time.
+If Emacs hangs up while retrieving headers, set the variable to a
+lower value.")
+
+(defvar nntp-large-newsgroup 50
+ "*The number of the articles which indicates a large newsgroup.
+If the number of the articles is greater than the value, verbose
+messages will be shown to indicate the current status.")
+
+\f
+(defconst nntp-version "NNTP 3.10"
+ "Version numbers of this version of NNTP.")
+
+(defvar nntp-server-name nil
+ "The name of the host running NNTP server.")
+
+(defvar nntp-server-buffer nil
+ "Buffer associated with NNTP server process.")
+
+(defvar nntp-server-process nil
+ "The NNTP server process.
+You'd better not use this variable in NNTP front-end program but
+instead use `nntp-server-buffer'.")
+
+(defvar nntp-status-message-string nil
+ "Save the server response message.
+You'd better not use this variable in NNTP front-end program but
+instead call function `nntp-status-message' to get status message.")
+
+;;;
+;;; Extended Command for retrieving many headers.
+;;;
+;; Retrieving lots of headers by sending command asynchronously.
+;; Access functions to headers are defined as macro.
+
+(defmacro nntp-header-number (header)
+ "Return article number in HEADER."
+ (` (aref (, header) 0)))
+
+(defmacro nntp-set-header-number (header number)
+ "Set article number of HEADER to NUMBER."
+ (` (aset (, header) 0 (, number))))
+
+(defmacro nntp-header-subject (header)
+ "Return subject string in HEADER."
+ (` (aref (, header) 1)))
+
+(defmacro nntp-set-header-subject (header subject)
+ "Set article subject of HEADER to SUBJECT."
+ (` (aset (, header) 1 (, subject))))
+
+(defmacro nntp-header-from (header)
+ "Return author string in HEADER."
+ (` (aref (, header) 2)))
+
+(defmacro nntp-set-header-from (header from)
+ "Set article author of HEADER to FROM."
+ (` (aset (, header) 2 (, from))))
+
+(defmacro nntp-header-xref (header)
+ "Return xref string in HEADER."
+ (` (aref (, header) 3)))
+
+(defmacro nntp-set-header-xref (header xref)
+ "Set article xref of HEADER to xref."
+ (` (aset (, header) 3 (, xref))))
+
+(defmacro nntp-header-lines (header)
+ "Return lines in HEADER."
+ (` (aref (, header) 4)))
+
+(defmacro nntp-set-header-lines (header lines)
+ "Set article lines of HEADER to LINES."
+ (` (aset (, header) 4 (, lines))))
+
+(defmacro nntp-header-date (header)
+ "Return date in HEADER."
+ (` (aref (, header) 5)))
+
+(defmacro nntp-set-header-date (header date)
+ "Set article date of HEADER to DATE."
+ (` (aset (, header) 5 (, date))))
+
+(defmacro nntp-header-id (header)
+ "Return Id in HEADER."
+ (` (aref (, header) 6)))
+
+(defmacro nntp-set-header-id (header id)
+ "Set article Id of HEADER to ID."
+ (` (aset (, header) 6 (, id))))
+
+(defmacro nntp-header-references (header)
+ "Return references in HEADER."
+ (` (aref (, header) 7)))
+
+(defmacro nntp-set-header-references (header ref)
+ "Set article references of HEADER to REF."
+ (` (aset (, header) 7 (, ref))))
+
+(defun nntp-retrieve-headers (sequence)
+ "Return list of article headers specified by SEQUENCE of article id.
+The format of list is
+ `([NUMBER SUBJECT FROM XREF LINES DATE MESSAGE-ID REFERENCES] ...)'.
+Reader macros for the vector are defined as `nntp-header-FIELD'.
+Writer macros for the vector are defined as `nntp-set-header-FIELD'.
+News group must be selected before calling me."
+ (save-excursion
+ (set-buffer nntp-server-buffer)
+ (erase-buffer)
+ (let ((number (length sequence))
+ (last-point (point-min))
+ (received 0)
+ (count 0)
+ (headers nil) ;Result list.
+ (article 0)
+ (subject nil)
+ (message-id)
+ (from nil)
+ (xref nil)
+ (lines 0)
+ (date nil)
+ (references nil))
+ ;; Send HEAD command.
+ (while sequence
+ (nntp-send-strings-to-server "HEAD" (car sequence))
+ (setq sequence (cdr sequence))
+ (setq count (1+ count))
+ ;; Every 400 header requests we have to read stream in order
+ ;; to avoid deadlock.
+ (if (or (null sequence) ;All requests have been sent.
+ (zerop (% count nntp-maximum-request)))
+ (progn
+ (accept-process-output)
+ (while (progn
+ (goto-char last-point)
+ ;; Count replies.
+ (while (re-search-forward "^[0-9]" nil t)
+ (setq received (1+ received)))
+ (setq last-point (point))
+ (< received count))
+ ;; If number of headers is greater than 100, give
+ ;; informative messages.
+ (and (numberp nntp-large-newsgroup)
+ (> number nntp-large-newsgroup)
+ (zerop (% received 20))
+ (message "NNTP: %d%% of headers received."
+ (/ (* received 100) number)))
+ (nntp-accept-response))
+ ))
+ )
+ ;; Wait for text of last command.
+ (goto-char (point-max))
+ (re-search-backward "^[0-9]" nil t)
+ (if (looking-at "^[23]")
+ (while (progn
+ (goto-char (- (point-max) 3))
+ (not (looking-at "^\\.\r$")))
+ (nntp-accept-response)))
+ (and (numberp nntp-large-newsgroup)
+ (> number nntp-large-newsgroup)
+ (message "NNTP: 100%% of headers received."))
+ ;; Now all of replies are received.
+ (setq received number)
+ ;; First, fold continuation lines.
+ (goto-char (point-min))
+ (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t)
+ (replace-match " " t t))
+ ;;(delete-non-matching-lines
+ ;; "^Subject:\\|^Xref:\\|^From:\\|^Lines:\\|^Date:\\|^References:\\|^[23]")
+ (and (numberp nntp-large-newsgroup)
+ (> number nntp-large-newsgroup)
+ (message "NNTP: Parsing headers..."))
+ ;; Then examines replies.
+ (goto-char (point-min))
+ (while (not (eobp))
+ (cond ((looking-at "^[23][0-9][0-9][ \t]+\\([0-9]+\\)[ \t]+\\(<[^>]+>\\)")
+ (setq article
+ (string-to-int
+ (buffer-substring (match-beginning 1) (match-end 1))))
+ (setq message-id
+ (buffer-substring (match-beginning 2) (match-end 2)))
+ (forward-line 1)
+ ;; Set default value.
+ (setq subject nil)
+ (setq xref nil)
+ (setq from nil)
+ (setq lines 0)
+ (setq date nil)
+ (setq references nil)
+ ;; Thanks go to mly@AI.MIT.EDU (Richard Mlynarik)
+ (while (and (not (eobp))
+ (not (memq (following-char) '(?2 ?3))))
+ (if (looking-at "\\(From\\|Subject\\|Date\\|Lines\\|Xref\\|References\\):[ \t]+\\([^ \t\n]+.*\\)\r$")
+ (let ((s (buffer-substring
+ (match-beginning 2) (match-end 2)))
+ (c (char-after (match-beginning 0))))
+ ;; We don't have to worry about letter case.
+ (cond ((char-equal c ?F) ;From:
+ (setq from s))
+ ((char-equal c ?S) ;Subject:
+ (setq subject s))
+ ((char-equal c ?D) ;Date:
+ (setq date s))
+ ((char-equal c ?L) ;Lines:
+ (setq lines (string-to-int s)))
+ ((char-equal c ?X) ;Xref:
+ (setq xref s))
+ ((char-equal c ?R) ;References:
+ (setq references s))
+ )))
+ (forward-line 1))
+ ;; Finished to parse one header.
+ (if (null subject)
+ (setq subject "(None)"))
+ (if (null from)
+ (setq from "(Unknown User)"))
+ (setq headers
+ (cons (vector article subject from
+ xref lines date
+ message-id references) headers))
+ )
+ (t (forward-line 1))
+ )
+ (setq received (1- received))
+ (and (numberp nntp-large-newsgroup)
+ (> number nntp-large-newsgroup)
+ (zerop (% received 20))
+ (message "NNTP: Parsing headers... %d%%"
+ (/ (* received 100) number)))
+ )
+ (and (numberp nntp-large-newsgroup)
+ (> number nntp-large-newsgroup)
+ (message "NNTP: Parsing headers... done"))
+ (nreverse headers)
+ )))
+
+\f
+;;;
+;;; Raw Interface to Network News Transfer Protocol (RFC977).
+;;;
+
+(defun nntp-open-server (host &optional service)
+ "Open news server on HOST.
+If HOST is nil, use value of environment variable `NNTPSERVER'.
+If optional argument SERVICE is non-nil, open by the service name."
+ (let ((host (or host (getenv "NNTPSERVER")))
+ (status nil))
+ (setq nntp-status-message-string "")
+ (cond ((and host (nntp-open-server-internal host service))
+ (setq status (nntp-wait-for-response "^[23].*\r$"))
+ ;; Do check unexpected close of connection.
+ ;; Suggested by feldmark@hanako.stars.flab.fujitsu.junet.
+ (if status
+ (set-process-sentinel nntp-server-process
+ 'nntp-default-sentinel)
+ ;; We have to close connection here, since function
+ ;; `nntp-server-opened' may return incorrect status.
+ (nntp-close-server-internal)
+ ))
+ ((null host)
+ (setq nntp-status-message-string "NNTP server is not specified."))
+ )
+ status
+ ))
+
+(defun nntp-close-server ()
+ "Close news server."
+ (unwind-protect
+ (progn
+ ;; Un-set default sentinel function before closing connection.
+ (and nntp-server-process
+ (eq 'nntp-default-sentinel
+ (process-sentinel nntp-server-process))
+ (set-process-sentinel nntp-server-process nil))
+ ;; We cannot send QUIT command unless the process is running.
+ (if (nntp-server-opened)
+ (nntp-send-command nil "QUIT"))
+ )
+ (nntp-close-server-internal)
+ ))
+
+(fset 'nntp-request-quit (symbol-function 'nntp-close-server))
+
+(defun nntp-server-opened ()
+ "Return server process status, T or NIL.
+If the stream is opened, return T, otherwise return NIL."
+ (and nntp-server-process
+ (memq (process-status nntp-server-process) '(open run))))
+
+(defun nntp-status-message ()
+ "Return server status response as string."
+ (if (and nntp-status-message-string
+ ;; NNN MESSAGE
+ (string-match "[0-9][0-9][0-9][ \t]+\\([^\r]*\\).*$"
+ nntp-status-message-string))
+ (substring nntp-status-message-string (match-beginning 1) (match-end 1))
+ ;; Empty message if nothing.
+ ""
+ ))
+
+(defun nntp-request-article (id)
+ "Select article by message ID (or number)."
+ (prog1
+ ;; If NEmacs, end of message may look like: "\256\215" (".^M")
+ (nntp-send-command "^\\.\r$" "ARTICLE" id)
+ (nntp-decode-text)
+ ))
+
+(defun nntp-request-body (id)
+ "Select article body by message ID (or number)."
+ (prog1
+ ;; If NEmacs, end of message may look like: "\256\215" (".^M")
+ (nntp-send-command "^\\.\r$" "BODY" id)
+ (nntp-decode-text)
+ ))
+
+(defun nntp-request-head (id)
+ "Select article head by message ID (or number)."
+ (prog1
+ (nntp-send-command "^\\.\r$" "HEAD" id)
+ (nntp-decode-text)
+ ))
+
+(defun nntp-request-stat (id)
+ "Select article by message ID (or number)."
+ (nntp-send-command "^[23].*\r$" "STAT" id))
+
+(defun nntp-request-group (group)
+ "Select news GROUP."
+ ;; 1.2a NNTP's group command is buggy. "^M" (\r) is not appended to
+ ;; end of the status message.
+ (nntp-send-command "^[23].*$" "GROUP" group))
+
+(defun nntp-request-list ()
+ "List valid newsgoups."
+ (prog1
+ (nntp-send-command "^\\.\r$" "LIST")
+ (nntp-decode-text)
+ ))
+
+(defun nntp-request-last ()
+ "Set current article pointer to the previous article
+in the current news group."
+ (nntp-send-command "^[23].*\r$" "LAST"))
+
+(defun nntp-request-next ()
+ "Advance current article pointer."
+ (nntp-send-command "^[23].*\r$" "NEXT"))
+
+(defun nntp-request-post ()
+ "Post a new news in current buffer."
+ (if (nntp-send-command "^[23].*\r$" "POST")
+ (progn
+ (nntp-encode-text)
+ (nntp-send-region-to-server (point-min) (point-max))
+ ;; 1.2a NNTP's post command is buggy. "^M" (\r) is not
+ ;; appended to end of the status message.
+ (nntp-wait-for-response "^[23].*$")
+ )))
+
+(defun nntp-default-sentinel (proc status)
+ "Default sentinel function for NNTP server process."
+ (if (and nntp-server-process
+ (not (nntp-server-opened)))
+ (error "NNTP: Connection closed.")
+ ))
+
+;; Encoding and decoding of NNTP text.
+
+(defun nntp-decode-text ()
+ "Decode text transmitted by NNTP.
+0. Delete status line.
+1. Delete `^M' at end of line.
+2. Delete `.' at end of buffer (end of text mark).
+3. Delete `.' at beginning of line."
+ (save-excursion
+ (set-buffer nntp-server-buffer)
+ ;; Insert newline at end of buffer.
+ (goto-char (point-max))
+ (if (not (bolp))
+ (insert "\n"))
+ ;; Delete status line.
+ (goto-char (point-min))
+ (delete-region (point) (progn (forward-line 1) (point)))
+ ;; Delete `^M' at end of line.
+ ;; (replace-regexp "\r$" "")
+ (while (not (eobp))
+ (end-of-line)
+ (if (= (preceding-char) ?\r)
+ (delete-char -1))
+ (forward-line 1)
+ )
+ ;; Delete `.' at end of buffer (end of text mark).
+ (goto-char (point-max))
+ (forward-line -1) ;(beginning-of-line)
+ (if (looking-at "^\\.$")
+ (delete-region (point) (progn (forward-line 1) (point))))
+ ;; Replace `..' at beginning of line with `.'.
+ (goto-char (point-min))
+ ;; (replace-regexp "^\\.\\." ".")
+ (while (search-forward "\n.." nil t)
+ (delete-char -1))
+ ))
+
+(defun nntp-encode-text ()
+ "Encode text in current buffer for NNTP transmission.
+1. Insert `.' at beginning of line.
+2. Insert `.' at end of buffer (end of text mark)."
+ (save-excursion
+ ;; Insert newline at end of buffer.
+ (goto-char (point-max))
+ (if (not (bolp))
+ (insert "\n"))
+ ;; Replace `.' at beginning of line with `..'.
+ (goto-char (point-min))
+ ;; (replace-regexp "^\\." "..")
+ (while (search-forward "\n." nil t)
+ (insert "."))
+ ;; Insert `.' at end of buffer (end of text mark).
+ (goto-char (point-max))
+ (insert ".\n")
+ ))
+
+\f
+;;;
+;;; Synchronous Communication with NNTP Server.
+;;;
+
+(defun nntp-send-command (response cmd &rest args)
+ "Wait for server RESPONSE after sending CMD and optional ARGS to server."
+ (save-excursion
+ ;; Clear communication buffer.
+ (set-buffer nntp-server-buffer)
+ (erase-buffer)
+ (apply 'nntp-send-strings-to-server cmd args)
+ (if response
+ (nntp-wait-for-response response)
+ t)
+ ))
+
+(defun nntp-wait-for-response (regexp)
+ "Wait for server response which matches REGEXP."
+ (save-excursion
+ (let ((status t)
+ (wait t))
+ (set-buffer nntp-server-buffer)
+ ;; Wait for status response (RFC977).
+ ;; 1xx - Informative message.
+ ;; 2xx - Command ok.
+ ;; 3xx - Command ok so far, send the rest of it.
+ ;; 4xx - Command was correct, but couldn't be performed for some
+ ;; reason.
+ ;; 5xx - Command unimplemented, or incorrect, or a serious
+ ;; program error occurred.
+ (nntp-accept-response)
+ (while wait
+ (goto-char (point-min))
+ (cond ((looking-at "[23]")
+ (setq wait nil))
+ ((looking-at "[45]")
+ (setq status nil)
+ (setq wait nil))
+ (t (nntp-accept-response))
+ ))
+ ;; Save status message.
+ (end-of-line)
+ (setq nntp-status-message-string
+ (buffer-substring (point-min) (point)))
+ (if status
+ (progn
+ (setq wait t)
+ (while wait
+ (goto-char (point-max))
+ (forward-line -1) ;(beginning-of-line)
+ ;;(message (buffer-substring
+ ;; (point)
+ ;; (save-excursion (end-of-line) (point))))
+ (if (looking-at regexp)
+ (setq wait nil)
+ (message "NNTP: Reading...")
+ (nntp-accept-response)
+ (message "")
+ ))
+ ;; Successfully received server response.
+ t
+ ))
+ )))
+
+\f
+;;;
+;;; Low-Level Interface to NNTP Server.
+;;;
+
+(defun nntp-send-strings-to-server (&rest strings)
+ "Send list of STRINGS to news server as command and its arguments."
+ (let ((cmd (car strings))
+ (strings (cdr strings)))
+ ;; Command and each argument must be separeted by one or more spaces.
+ (while strings
+ (setq cmd (concat cmd " " (car strings)))
+ (setq strings (cdr strings)))
+ ;; Command line must be terminated by a CR-LF.
+ (process-send-string nntp-server-process (concat cmd "\n"))
+ ))
+
+(defun nntp-send-region-to-server (begin end)
+ "Send current buffer region (from BEGIN to END) to news server."
+ (save-excursion
+ ;; We have to work in the buffer associated with NNTP server
+ ;; process because of NEmacs hack.
+ (copy-to-buffer nntp-server-buffer begin end)
+ (set-buffer nntp-server-buffer)
+ (setq begin (point-min))
+ (setq end (point-max))
+ ;; `process-send-region' does not work if text to be sent is very
+ ;; large. I don't know maximum size of text sent correctly.
+ (let ((last nil)
+ (size 100)) ;Size of text sent at once.
+ (save-restriction
+ (narrow-to-region begin end)
+ (goto-char begin)
+ (while (not (eobp))
+ ;;(setq last (min end (+ (point) size)))
+ ;; NEmacs gets confused if character at `last' is Kanji.
+ (setq last (save-excursion
+ (goto-char (min end (+ (point) size)))
+ (or (eobp) (forward-char 1)) ;Adjust point
+ (point)))
+ (process-send-region nntp-server-process (point) last)
+ ;; I don't know whether the next codes solve the known
+ ;; problem of communication error of GNU Emacs.
+ (accept-process-output)
+ ;;(sit-for 0)
+ (goto-char last)
+ )))
+ ;; We cannot erase buffer, because reply may be received.
+ (delete-region begin end)
+ ))
+
+(defun nntp-open-server-internal (host &optional service)
+ "Open connection to news server on HOST by SERVICE (default is nntp)."
+ (save-excursion
+ ;; Use TCP/IP stream emulation package if needed.
+ (or (fboundp 'open-network-stream)
+ (require 'tcp))
+ ;; Initialize communication buffer.
+ (setq nntp-server-buffer (get-buffer-create " *nntpd*"))
+ (set-buffer nntp-server-buffer)
+ (buffer-flush-undo (current-buffer))
+ (erase-buffer)
+ (kill-all-local-variables)
+ (setq case-fold-search t) ;Should ignore case.
+ (setq nntp-server-process
+ (open-network-stream "nntpd" (current-buffer)
+ host (or service "nntp")))
+ (setq nntp-server-name host)
+ ;; It is possible to change kanji-fileio-code in this hook.
+ (run-hooks 'nntp-server-hook)
+ ;; Return the server process.
+ nntp-server-process
+ ))
+
+(defun nntp-close-server-internal ()
+ "Close connection to news server."
+ (if nntp-server-process
+ (delete-process nntp-server-process))
+ (if nntp-server-buffer
+ (kill-buffer nntp-server-buffer))
+ (setq nntp-server-buffer nil)
+ (setq nntp-server-process nil))
+
+(defun nntp-accept-response ()
+ "Read response of server.
+It is well-known that the communication speed will be much improved by
+defining this function as macro."
+ ;; To deal with server process exiting before
+ ;; accept-process-output is called.
+ ;; Suggested by Jason Venner <jason@violet.berkeley.edu>.
+ ;; This is a copy of `nntp-default-sentinel'.
+ (or (memq (process-status nntp-server-process) '(open run))
+ (error "NNTP: Connection closed."))
+ (if nntp-buggy-select
+ (progn
+ ;; We cannot use `accept-process-output'.
+ ;; Fujitsu UTS requires messages during sleep-for. I don't know why.
+ (message "NNTP: Reading...")
+ (sleep-for 1)
+ (message ""))
+ (condition-case errorcode
+ (accept-process-output nntp-server-process)
+ (error
+ (cond ((string-equal "select error: Invalid argument" (nth 1 errorcode))
+ ;; Ignore select error.
+ nil
+ )
+ (t
+ (signal (car errorcode) (cdr errorcode))))
+ ))
+ ))
projects / emacs.git / commitdiff