X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/067ffa38a5d8f117efb94afa8a2edba3d832ee1a..c11b3a3f65c66040b39cb22f7985f062e3b94069:/lisp/mhspool.el diff --git a/lisp/mhspool.el b/lisp/mhspool.el index 81704e54be..b81823938f 100644 --- a/lisp/mhspool.el +++ b/lisp/mhspool.el @@ -1,7 +1,6 @@ ;;; mhspool.el --- MH folder access using NNTP for GNU Emacs -;; Copyright (C) 1988, 1989 Fujitsu Laboratories LTD. -;; Copyright (C) 1988, 1989, 1990 Masanobu UMEDA +;; Copyright (C) 1988, 1989, 1990, 1993 Free Software Foundation, Inc. ;; Author: Masanobu UMEDA ;; Maintainer: FSF @@ -9,22 +8,21 @@ ;; This file is part of GNU Emacs. +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + ;; 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. - -;; Commentary: +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to +;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +;;; Commentary: ;; 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 @@ -37,17 +35,26 @@ ;; no way to specify hierarchical directory now.) In this case, the ;; name of the NNTP server passed to GNUS must be `:Mail'. -;; Code: +;;; Code: (require 'nntp) +(defvar mhspool-list-folders-method + (function mhspool-list-folders-using-sh) + "*Function to list files in folders. +The function should accept a directory as its argument, and fill the +current buffer with file and directory names. The output format must +be the same as that of 'ls -R1'. Two functions +mhspool-list-folders-using-ls and mhspool-list-folders-using-sh are +provided now. I suppose the later is faster.") + (defvar mhspool-list-directory-switches '("-R") - "*Switches for `nntp-request-list' to pass to `ls' for gettting file lists. + "*Switches for mhspool-list-folders-using-ls to pass to `ls' for getting file lists. One entry should appear on one line. You may need to add `-1' option.") -(defconst mhspool-version "MHSPOOL 1.5" +(defconst mhspool-version "MHSPOOL 1.8" "Version numbers of this version of MHSPOOL.") (defvar mhspool-spool-directory "~/Mail" @@ -64,9 +71,10 @@ One entry should appear on one line. You may need to add `-1' option.") "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] ...)'. +If there is no References: field, In-Reply-To: field is used instead. 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." +Newsgroup must be selected before calling this." (save-excursion (set-buffer nntp-server-buffer) ;;(erase-buffer) @@ -138,7 +146,12 @@ News group must be selected before calling me." (buffer-substring (point) (save-excursion (end-of-line) (point))))) - (setq lines 0)) + ;; Count lines since there is no lines field in most cases. + (setq lines + (save-restriction + (goto-char (point-max)) + (widen) + (count-lines (point) (point-max))))) ;; Extract Xref: (goto-char (point-min)) (if (search-forward "\nXref: " nil t) @@ -156,22 +169,25 @@ News group must be selected before calling me." (point) (save-excursion (end-of-line) (point)))) (setq references nil)) - (setq headers - (cons (vector article subject from - xref lines date - message-id references) headers)) + ;; Collect valid article only. + (and article + message-id + (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." + (message "MHSPOOL: Receiving headers... %d%%" (/ (* count 100) number))) ) (and (numberp nntp-large-newsgroup) (> number nntp-large-newsgroup) - (message "MHSPOOL: 100%% of headers received.")) + (message "MHSPOOL: Receiving headers... done")) (nreverse headers) ))) @@ -196,20 +212,20 @@ If optional argument SERVICE is non-nil, open by the service name." (expand-file-name "~/" nil)))) (setq host (system-name))) (setq mhspool-spool-directory nil)) - (setq nntp-status-message-string "") + (setq nntp-status-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 + (setq nntp-status-string (format "No such directory: %s. Goodbye." mhspool-spool-directory))) ((null host) - (setq nntp-status-message-string "NNTP server is not specified.")) + (setq nntp-status-string "NNTP server is not specified.")) (t - (setq nntp-status-message-string + (setq nntp-status-string (format "MHSPOOL: cannot talk to %s." host))) ) status @@ -229,7 +245,7 @@ If the stream is opened, return T, otherwise return NIL." (defun mhspool-status-message () "Return server status response as string." - nntp-status-message-string + nntp-status-string ) (defun mhspool-request-article (id) @@ -268,7 +284,9 @@ If the stream is opened, return T, otherwise return NIL." (defun mhspool-request-stat (id) "Select article by message ID (or number)." - (error "MHSPOOL: STAT is not implemented.")) + (setq nntp-status-string "MHSPOOL: STAT is not implemented.") + nil + ) (defun mhspool-request-group (group) "Select news GROUP." @@ -287,21 +305,22 @@ If the stream is opened, return T, otherwise return NIL." )) (defun mhspool-request-list () - "List valid newsgoups." + "List active 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*"))) + (buffer (get-buffer-create " *MHSPOOL File List*"))) (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))) +;; (apply 'call-process +;; "ls" nil t nil +;; (append mhspool-list-directory-switches (list directory))) + (funcall mhspool-list-folders-method directory) (goto-char (point-min)) (while (re-search-forward folder-regexp nil t) (setq newsgroup @@ -330,17 +349,34 @@ If the stream is opened, return T, otherwise return NIL." (buffer-size) ))) +(defun mhspool-request-list-newsgroups () + "List newsgoups (defined in NNTP2)." + (setq nntp-status-string "MHSPOOL: LIST NEWSGROUPS is not implemented.") + nil + ) + +(defun mhspool-request-list-distributions () + "List distributions (defined in NNTP2)." + (setq nntp-status-string "MHSPOOL: LIST DISTRIBUTIONS is not implemented.") + nil + ) + (defun mhspool-request-last () - "Set current article pointer to the previous article in the current newsgroup." - (error "MHSPOOL: LAST is not implemented.")) + "Set current article pointer to the previous article +in the current news group." + (setq nntp-status-string "MHSPOOL: LAST is not implemented.") + nil + ) (defun mhspool-request-next () "Advance current article pointer." - (error "MHSPOOL: NEXT is not implemented.")) + (setq nntp-status-string "MHSPOOL: NEXT is not implemented.") + nil + ) (defun mhspool-request-post () "Post a new news in current buffer." - (setq nntp-status-message-string "MHSPOOL: what do you mean post?") + (setq nntp-status-string "MHSPOOL: POST: what do you mean?") nil ) @@ -402,7 +438,7 @@ If the stream is opened, return T, otherwise return NIL." (let ((string (substring string 0)) ;Copy string. (len (length string)) (idx 0)) - ;; Replace all occurence of FROM with TO. + ;; Replace all occurrences of FROM with TO. (while (< idx len) (if (= (aref string idx) from) (aset string idx to)) @@ -410,6 +446,45 @@ If the stream is opened, return T, otherwise return NIL." string )) + +;; Methods for listing files in folders. + +(defun mhspool-list-folders-using-ls (directory) + "List files in folders under DIRECTORY using 'ls'." + (apply 'call-process + "ls" nil t nil + (append mhspool-list-directory-switches (list directory)))) + +;; Basic ideas by tanaka@flab.fujitsu.co.jp (Hiroshi TANAKA) + +(defun mhspool-list-folders-using-sh (directory) + "List files in folders under DIRECTORY using '/bin/sh'." + (let ((buffer (current-buffer)) + (script (get-buffer-create " *MHSPOOL Shell Script Buffer*"))) + (save-excursion + (save-restriction + (set-buffer script) + (erase-buffer) + ;; /bin/sh script which does 'ls -R'. + (insert + "PS2= + ffind() { + cd $1; echo $1: + ls -1 + echo + for j in `echo *[a-zA-Z]*` + do + if [ -d $1/$j ]; then + ffind $1/$j + fi + done + } + cd " directory "; ffind `pwd`; exit 0\n") + (call-process-region (point-min) (point-max) "sh" nil buffer nil) + )) + (kill-buffer script) + )) + (provide 'mhspool) ;;; mhspool.el ends here