New version.

1 files changed, 55 insertions, 99 deletions

diff --git a/lisp/nndir.el b/lisp/nndir.el
index 5946754bee0..dd7fa8ade8b 100644
--- a/lisp/nndir.el
+++ b/lisp/nndir.el
@@ -1,9 +1,7 @@
 ;;; nndir.el --- single directory newsgroup access for Gnus
-
-;; Copyright (C) 1995 Free Software Foundation, Inc.
+;; Copyright (C) 1995,96 Free Software Foundation, Inc.
 
 ;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
-;; 	Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
 ;; Keywords: news
 
 ;; This file is part of GNU Emacs.
@@ -30,113 +28,71 @@
 (require 'nnheader)
 (require 'nnmh)
 (require 'nnml)
+(require 'nnoo)
+(eval-when-compile (require 'cl))
 
-(eval-and-compile
-  (autoload 'mail-send-and-exit "sendmail"))
+(nnoo-declare nndir
+  nnml nnmh)
 
-
+(defvoo nndir-directory nil
+  "Where nndir will look for groups."
+  nnml-current-directory nnmh-current-directory)
 
-(defconst nndir-version "nndir 1.0")
+(defvoo nndir-nov-is-evil nil
+  "*Non-nil means that nndir will never retrieve NOV headers."
+  nnml-nov-is-evil)
 
-(defvar nndir-current-directory nil
-  "Current news group directory.")
+
 
-(defvar nndir-status-string "")
+(defvoo nndir-current-group "" nil nnml-current-group nnmh-current-group)
+(defvoo nndir-top-directory nil nil nnml-directory nnmh-directory)
+(defvoo nndir-get-new-mail nil nil nnml-get-new-mail nnmh-get-new-mail)
 
-(defvar nndir-nov-is-evil nil
-  "*Non-nil means that nndir will never retrieve NOV headers.")
+(defvoo nndir-status-string "" nil nnmh-status-string)
+(defconst nndir-version "nndir 1.0")
 
 
 
 ;;; Interface functions.
 
-
-(defun nndir-retrieve-headers (sequence &optional newsgroup server)
-  (nndir-execute-nnml-command
-   '(nnml-retrieve-headers sequence group server) server))
-
-(defun nndir-open-server (host &optional service)
-  "Open nndir backend."
-  (setq nndir-status-string "")
-  (nnheader-init-server-buffer))
-
-(defun nndir-close-server (&optional server)
-  "Close news server."
-  t)
-
-(defun nndir-server-opened (&optional server)
-  "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 nndir-status-message (&optional server)
-  "Return server status response as string."
-  nndir-status-string)
-
-(defun nndir-request-article (id &optional newsgroup server buffer)
-  (nndir-execute-nnmh-command
-   '(nnmh-request-article id group server buffer) server))
-
-(defun nndir-request-group (group &optional server dont-check)
-  "Select news GROUP."
-  (nndir-execute-nnmh-command
-   '(nnmh-request-group group "" dont-check) server))
-
-(defun nndir-request-list (&optional server dir)
-  "Get list of active articles in all newsgroups."
-  (nndir-execute-nnmh-command
-   '(nnmh-request-list nil dir) server))
-
-(defun nndir-request-newgroups (date &optional server)
-  (nndir-execute-nnmh-command
-   '(nnmh-request-newgroups date server) server))
-
-(defun nndir-request-post (&optional server)
-  "Post a new news in current buffer."
-  (mail-send-and-exit nil))
-
-(defalias 'nndir-request-post-buffer 'nnmail-request-post-buffer)
-
-(defun nndir-request-expire-articles (articles newsgroup &optional server force)
-  "Expire all articles in the ARTICLES list in group GROUP."
-  (setq nndir-status-string "nndir: expire not possible")
-  nil)
-
-(defun nndir-close-group (group &optional server)
-  t)
-
-(defun nndir-request-move-article (article group server accept-form)
-  (setq nndir-status-string "nndir: move not possible")
-  nil)
-
-(defun nndir-request-accept-article (group)
-  (setq nndir-status-string "nndir: accept not possible")
-  nil)
-
-
-;;; Low-Level Interface
-
-(defun nndir-execute-nnmh-command (command server)
-  (let ((dir (expand-file-name server)))
-    (and (string-match "/$" dir)
-	 (setq dir (substring dir 0 (match-beginning 0))))
-    (string-match "/[^/]+$" dir)
-    (let ((group (substring dir (1+ (match-beginning 0))))
-	  (nnmh-directory (substring dir 0 (1+ (match-beginning 0))))
-	  (nnmh-get-new-mail nil))
-      (eval command))))
-
-(defun nndir-execute-nnml-command (command server)
-  (let ((dir (expand-file-name server)))
-    (and (string-match "/$" dir)
-	 (setq dir (substring dir 0 (match-beginning 0))))
-    (string-match "/[^/]+$" dir)
-    (let ((group (substring dir (1+ (match-beginning 0))))
-	  (nnml-directory (substring dir 0 (1+ (match-beginning 0))))
-	  (nnml-nov-is-evil nndir-nov-is-evil)
-	  (nnml-get-new-mail nil))
-      (eval command))))
+(nnoo-define-basics nndir)
+
+(deffoo nndir-open-server (server &optional defs)
+  (setq nndir-directory
+	(or (cadr (assq 'nndir-directory defs))
+	    server))
+  (unless (assq 'nndir-directory defs)
+    (push `(nndir-directory ,server) defs))
+  (push `(nndir-current-group
+	  ,(file-name-nondirectory (directory-file-name nndir-directory)))
+	defs)
+  (push `(nndir-top-directory
+	  ,(file-name-directory (directory-file-name nndir-directory)))
+	defs)
+  (nnoo-change-server 'nndir server defs)
+  (let (err)
+    (cond 
+     ((not (condition-case arg
+	       (file-exists-p nndir-directory)
+	     (ftp-error (setq err (format "%s" arg)))))
+      (nndir-close-server)
+      (nnheader-report 
+       'nndir (or err "No such file or directory: %s" nndir-directory)))
+     ((not (file-directory-p (file-truename nndir-directory)))
+      (nndir-close-server)
+      (nnheader-report 'nndir "Not a directory: %s" nndir-directory))
+     (t
+      (nnheader-report 'nndir "Opened server %s using directory %s"
+		       server nndir-directory)
+      t))))
+
+(nnoo-map-functions nndir
+  (nnml-retrieve-headers 0 nndir-current-group 0 0)
+  (nnmh-request-article 0 nndir-current-group 0 0)
+  (nnmh-request-group nndir-current-group 0 0)
+  (nnmh-close-group nndir-current-group 0)
+  (nnmh-request-list (nnoo-current-server 'nndir) nndir-directory)
+  (nnmh-request-newsgroups (nnoo-current-server 'nndir) nndir-directory))
 
 (provide 'nndir)