[bpt/emacs.git] / lisp / mhspool.el

;;; 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
    ))
Commit	Line	Data
05328297	1	;;; MH folder access using NNTP for GNU Emacs
	2	;; Copyright (C) 1988, 1989 Fujitsu Laboratories LTD.
	3	;; Copyright (C) 1988, 1989, 1990 Masanobu UMEDA
	4	;; $Header: mhspool.el,v 1.5 90/03/23 13:25:23 umerin Locked $
	5
	6	;; This file is part of GNU Emacs.
	7
	8	;; GNU Emacs is distributed in the hope that it will be useful,
	9	;; but WITHOUT ANY WARRANTY. No author or distributor
	10	;; accepts responsibility to anyone for the consequences of using it
	11	;; or for whether it serves any particular purpose or works at all,
	12	;; unless he says so in writing. Refer to the GNU Emacs General Public
	13	;; License for full details.
	14
	15	;; Everyone is granted permission to copy, modify and redistribute
	16	;; GNU Emacs, but only under the conditions described in the
	17	;; GNU Emacs General Public License. A copy of this license is
	18	;; supposed to have been given to you along with GNU Emacs so you
	19	;; can know your rights and responsibilities. It should be in a
	20	;; file named COPYING. Among other things, the copyright notice
	21	;; and this notice must be preserved on all copies.
	22
	23	(provide 'mhspool)
	24	(require 'nntp)
	25
	26	;; This package enables you to read mail or articles in MH folders, or
	27	;; articles saved by GNUS. In any case, the file names of mail or
	28	;; articles must consist of only numeric letters.
	29
	30	;; Before using this package, you have to create a server specific
	31	;; startup file according to the directory which you want to read. For
	32	;; example, if you want to read mail under the directory named
	33	;; `~/Mail', the file must be a file named `.newsrc-:Mail'. (There is
	34	;; no way to specify hierarchical directory now.) In this case, the
	35	;; name of the NNTP server passed to GNUS must be `:Mail'.
	36
	37	(defvar mhspool-list-directory-switches '("-R")
	38	"*Switches for nntp-request-list to pass to `ls' for gettting file lists.
	39	One entry should appear on one line. You may need to add `-1' option.")
	40
	41	\f
	42
	43	(defconst mhspool-version "MHSPOOL 1.5"
	44	"Version numbers of this version of MHSPOOL.")
	45
	46	(defvar mhspool-spool-directory "~/Mail"
	47	"Private mail directory.")
	48
	49	(defvar mhspool-current-directory nil
	50	"Current news group directory.")
	51
	52	;;;
	53	;;; Replacement of Extended Command for retrieving many headers.
	54	;;;
	55
	56	(defun mhspool-retrieve-headers (sequence)
	57	"Return list of article headers specified by SEQUENCE of article id.
	58	The format of list is
	59	`([NUMBER SUBJECT FROM XREF LINES DATE MESSAGE-ID REFERENCES] ...)'.
	60	Reader macros for the vector are defined as `nntp-header-FIELD'.
	61	Writer macros for the vector are defined as `nntp-set-header-FIELD'.
	62	News group must be selected before calling me."
	63	(save-excursion
	64	(set-buffer nntp-server-buffer)
65	;;(erase-buffer)
66	(let ((file nil)
67	(number (length sequence))
68	(count 0)
69	(headers nil) ;Result list.
70	(article 0)
71	(subject nil)
72	(message-id nil)
73	(from nil)
74	(xref nil)
75	(lines 0)
76	(date nil)
77	(references nil))
78	(while sequence
79	;;(nntp-send-strings-to-server "HEAD" (car sequence))
80	(setq article (car sequence))
81	(setq file
82	(concat mhspool-current-directory (prin1-to-string article)))
83	(if (and (file-exists-p file)
84	(not (file-directory-p file)))
85	(progn
86	(erase-buffer)
87	(insert-file-contents file)
88	;; Make message body invisible.
89	(goto-char (point-min))
90	(search-forward "\n\n" nil 'move)
91	(narrow-to-region (point-min) (point))
92	;; Fold continuation lines.
93	(goto-char (point-min))
94	(while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t)
95	(replace-match " " t t))
96	;; Make it possible to search for `\nFIELD'.
97	(goto-char (point-min))
98	(insert "\n")
99	;; Extract From:
100	(goto-char (point-min))
101	(if (search-forward "\nFrom: " nil t)
102	(setq from (buffer-substring
103	(point)
104	(save-excursion (end-of-line) (point))))
105	(setq from "(Unknown User)"))
106	;; Extract Subject:
107	(goto-char (point-min))
108	(if (search-forward "\nSubject: " nil t)
109	(setq subject (buffer-substring
110	(point)
111	(save-excursion (end-of-line) (point))))
112	(setq subject "(None)"))
113	;; Extract Message-ID:
114	(goto-char (point-min))
115	(if (search-forward "\nMessage-ID: " nil t)
116	(setq message-id (buffer-substring
117	(point)
118	(save-excursion (end-of-line) (point))))
119	(setq message-id nil))
120	;; Extract Date:
121	(goto-char (point-min))
122	(if (search-forward "\nDate: " nil t)
123	(setq date (buffer-substring
124	(point)
125	(save-excursion (end-of-line) (point))))
126	(setq date nil))
127	;; Extract Lines:
128	(goto-char (point-min))
129	(if (search-forward "\nLines: " nil t)
130	(setq lines (string-to-int
131	(buffer-substring
132	(point)
133	(save-excursion (end-of-line) (point)))))
134	(setq lines 0))
135	;; Extract Xref:
136	(goto-char (point-min))
137	(if (search-forward "\nXref: " nil t)
138	(setq xref (buffer-substring
139	(point)
140	(save-excursion (end-of-line) (point))))
141	(setq xref nil))
142	;; Extract References:
143	;; If no References: field, use In-Reply-To: field instead.
144	;; Suggested by tanaka@flab.fujitsu.co.jp (Hiroshi TANAKA).
145	(goto-char (point-min))
146	(if (or (search-forward "\nReferences: " nil t)
147	(search-forward "\nIn-Reply-To: " nil t))
148	(setq references (buffer-substring
149	(point)
150	(save-excursion (end-of-line) (point))))
151	(setq references nil))
152	(setq headers
153	(cons (vector article subject from
154	xref lines date
155	message-id references) headers))
156	))
157	(setq sequence (cdr sequence))
158	(setq count (1+ count))
159	(and (numberp nntp-large-newsgroup)
160	(> number nntp-large-newsgroup)
161	(zerop (% count 20))
162	(message "MHSPOOL: %d%% of headers received."
163	(/ (* count 100) number)))
164	)
165	(and (numberp nntp-large-newsgroup)
166	(> number nntp-large-newsgroup)
167	(message "MHSPOOL: 100%% of headers received."))
168	(nreverse headers)
169	)))
170
171	\f
172	;;;
173	;;; Replacement of NNTP Raw Interface.
174	;;;
175
176	(defun mhspool-open-server (host &optional service)
177	"Open news server on HOST.
178	If HOST is nil, use value of environment variable `NNTPSERVER'.
179	If optional argument SERVICE is non-nil, open by the service name."
180	(let ((host (or host (getenv "NNTPSERVER")))
181	(status nil))
182	;; Get directory name from HOST name.
183	(if (string-match ":\\(.+\\)$" host)
184	(progn
185	(setq mhspool-spool-directory
186	(file-name-as-directory
187	(expand-file-name
188	(substring host (match-beginning 1) (match-end 1))
189	(expand-file-name "~/" nil))))
190	(setq host (system-name)))
191	(setq mhspool-spool-directory nil))
192	(setq nntp-status-message-string "")
193	(cond ((and (stringp host)
194	(stringp mhspool-spool-directory)
195	(file-directory-p mhspool-spool-directory)
196	(string-equal host (system-name)))
197	(setq status (mhspool-open-server-internal host service)))
198	((string-equal host (system-name))
199	(setq nntp-status-message-string
200	(format "No such directory: %s. Goodbye."
201	mhspool-spool-directory)))
202	((null host)
203	(setq nntp-status-message-string "NNTP server is not specified."))
204	(t
205	(setq nntp-status-message-string
206	(format "MHSPOOL: cannot talk to %s." host)))
207	)
208	status
209	))
210
211	(defun mhspool-close-server ()
212	"Close news server."
213	(mhspool-close-server-internal))
214
215	(fset 'mhspool-request-quit (symbol-function 'mhspool-close-server))
216
217	(defun mhspool-server-opened ()
218	"Return server process status, T or NIL.
219	If the stream is opened, return T, otherwise return NIL."
220	(and nntp-server-buffer
221	(get-buffer nntp-server-buffer)))
222
223	(defun mhspool-status-message ()
224	"Return server status response as string."
225	nntp-status-message-string
226	)
227
228	(defun mhspool-request-article (id)
229	"Select article by message ID (or number)."
230	(let ((file (concat mhspool-current-directory (prin1-to-string id))))
231	(if (and (stringp file)
232	(file-exists-p file)
233	(not (file-directory-p file)))
234	(save-excursion
235	(mhspool-find-file file)))
236	))
237
238	(defun mhspool-request-body (id)
239	"Select article body by message ID (or number)."
240	(if (mhspool-request-article id)
241	(save-excursion
242	(set-buffer nntp-server-buffer)
243	(goto-char (point-min))
244	(if (search-forward "\n\n" nil t)
245	(delete-region (point-min) (point)))
246	t
247	)
248	))
249
250	(defun mhspool-request-head (id)
251	"Select article head by message ID (or number)."
252	(if (mhspool-request-article id)
253	(save-excursion
254	(set-buffer nntp-server-buffer)
255	(goto-char (point-min))
256	(if (search-forward "\n\n" nil t)
257	(delete-region (1- (point)) (point-max)))
258	t
259	)
260	))
261
262	(defun mhspool-request-stat (id)
263	"Select article by message ID (or number)."
264	(error "MHSPOOL: STAT is not implemented."))
265
266	(defun mhspool-request-group (group)
267	"Select news GROUP."
268	(cond ((file-directory-p
269	(mhspool-article-pathname group))
270	;; Mail/NEWS.GROUP/N
271	(setq mhspool-current-directory
272	(mhspool-article-pathname group)))
273	((file-directory-p
274	(mhspool-article-pathname
275	(mhspool-replace-chars-in-string group ?. ?/)))
276	;; Mail/NEWS/GROUP/N
277	(setq mhspool-current-directory
278	(mhspool-article-pathname
279	(mhspool-replace-chars-in-string group ?. ?/))))
280	))
281
282	(defun mhspool-request-list ()
283	"List valid newsgoups."
284	(save-excursion
285	(let* ((newsgroup nil)
286	(articles nil)
287	(directory (file-name-as-directory
288	(expand-file-name mhspool-spool-directory nil)))
289	(folder-regexp (concat "^" (regexp-quote directory) "\\(.+\\):$"))
290	(buffer (get-buffer-create " GNUS file listing")))
291	(set-buffer nntp-server-buffer)
292	(erase-buffer)
293	(set-buffer buffer)
294	(erase-buffer)
295	(apply 'call-process
296	"ls" nil t nil
297	(append mhspool-list-directory-switches (list directory)))
298	(goto-char (point-min))
299	(while (re-search-forward folder-regexp nil t)
300	(setq newsgroup
301	(mhspool-replace-chars-in-string
302	(buffer-substring (match-beginning 1) (match-end 1)) ?/ ?.))
303	(setq articles nil)
304	(forward-line 1) ;(beginning-of-line)
305	;; Thank nobu@flab.fujitsu.junet for his bug fixes.
306	(while (and (not (eobp))
307	(not (looking-at "^$")))
308	(if (looking-at "^[0-9]+$")
309	(setq articles
310	(cons (string-to-int
311	(buffer-substring
312	(match-beginning 0) (match-end 0)))
313	articles)))
314	(forward-line 1))
315	(if articles
316	(princ (format "%s %d %d n\n" newsgroup
317	(apply (function max) articles)
318	(apply (function min) articles))
319	nntp-server-buffer))
320	)
321	(kill-buffer buffer)
322	(set-buffer nntp-server-buffer)
323	(buffer-size)
324	)))
325
326	(defun mhspool-request-last ()
327	"Set current article pointer to the previous article
328	in the current news group."
329	(error "MHSPOOL: LAST is not implemented."))
330
331	(defun mhspool-request-next ()
332	"Advance current article pointer."
333	(error "MHSPOOL: NEXT is not implemented."))
334
335	(defun mhspool-request-post ()
336	"Post a new news in current buffer."
337	(setq nntp-status-message-string "MHSPOOL: what do you mean post?")
338	nil
339	)
340
341	\f
342	;;;
343	;;; Replacement of Low-Level Interface to NNTP Server.
344	;;;
345
346	(defun mhspool-open-server-internal (host &optional service)
347	"Open connection to news server on HOST by SERVICE (default is nntp)."
348	(save-excursion
349	(if (not (string-equal host (system-name)))
350	(error "MHSPOOL: cannot talk to %s." host))
351	;; Initialize communication buffer.
352	(setq nntp-server-buffer (get-buffer-create " nntpd"))
353	(set-buffer nntp-server-buffer)
354	(buffer-flush-undo (current-buffer))
355	(erase-buffer)
356	(kill-all-local-variables)
357	(setq case-fold-search t) ;Should ignore case.
358	(setq nntp-server-process nil)
359	(setq nntp-server-name host)
360	;; It is possible to change kanji-fileio-code in this hook.
361	(run-hooks 'nntp-server-hook)
362	t
363	))
364
365	(defun mhspool-close-server-internal ()
366	"Close connection to news server."
367	(if nntp-server-buffer
368	(kill-buffer nntp-server-buffer))
369	(setq nntp-server-buffer nil)
370	(setq nntp-server-process nil))
371
372	(defun mhspool-find-file (file)
373	"Insert FILE in server buffer safely."
374	(set-buffer nntp-server-buffer)
375	(erase-buffer)
376	(condition-case ()
377	(progn
378	(insert-file-contents file)
379	(goto-char (point-min))
380	;; If there is no body, `^L' appears at end of file. Special
381	;; hack for MH folder.
382	(and (search-forward "\n\n" nil t)
383	(string-equal (buffer-substring (point) (point-max)) "\^L")
384	(delete-char 1))
385	t
386	)
387	(file-error nil)
388	))
389
390	(defun mhspool-article-pathname (group)
391	"Make pathname for GROUP."
392	(concat (file-name-as-directory mhspool-spool-directory) group "/"))
393
394	(defun mhspool-replace-chars-in-string (string from to)
395	"Replace characters in STRING from FROM to TO."
396	(let ((string (substring string 0)) ;Copy string.
397	(len (length string))
398	(idx 0))
399	;; Replace all occurence of FROM with TO.
400	(while (< idx len)
401	(if (= (aref string idx) from)
402	(aset string idx to))
403	(setq idx (1+ idx)))
404	string
405	))