X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fnndir.el;h=f1a6635c69e79c6cade5f102798dc9582f064ce6;hb=8a2e97cacfe486f6049fa39cfd8b3ea9f590adca;hp=4c99f143a2bc27f0137574e612506afcc6bb6811;hpb=b72ae90fdd16cc4ca2aef1f7d27fec67afb27fc3;p=gnus diff --git a/lisp/nndir.el b/lisp/nndir.el index 4c99f143a..f1a6635c6 100644 --- a/lisp/nndir.el +++ b/lisp/nndir.el @@ -1,8 +1,9 @@ ;;; nndir.el --- single directory newsgroup access for Gnus -;; Copyright (C) 1995 Free Software Foundation, Inc. -;; Author: Lars Magne Ingebrigtsen -;; Masanobu UMEDA +;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000 +;; Free Software Foundation, Inc. + +;; Author: Lars Magne Ingebrigtsen ;; Keywords: news ;; This file is part of GNU Emacs. @@ -18,8 +19,9 @@ ;; 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. +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. ;;; Commentary: @@ -28,140 +30,71 @@ (require 'nnheader) (require 'nnmh) (require 'nnml) +(require 'nnoo) +(eval-when-compile (require 'cl)) -(eval-and-compile - (autoload 'mail-send-and-exit "sendmail")) - -(defvar nndir-directory nil) - - - -(defconst nndir-version "nndir 1.0") +(nnoo-declare nndir + nnml nnmh) -(defvar nndir-status-string "") +(defvoo nndir-directory nil + "Where nndir will look for groups." + nnml-current-directory nnmh-current-directory) -(defvar nndir-nov-is-evil nil - "*Non-nil means that nndir will never retrieve NOV headers.") +(defvoo nndir-nov-is-evil nil + "*Non-nil means that nndir will never retrieve NOV headers." + nnml-nov-is-evil) -(defvar nndir-current-server nil) -(defvar nndir-server-alist nil) -(defvar nndir-server-variables - (list - '(nndir-directory nil) - '(nndir-status-string "") - '(nndir-group-alist))) +(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) + +(defvoo nndir-status-string "" nil nnmh-status-string) +(defconst nndir-version "nndir 1.0") ;;; Interface functions. - -(defun nndir-retrieve-headers (sequence &optional group server fetch-old) - (nndir-execute-nnml-command - (` (nnml-retrieve-headers - (quote (, sequence)) (, group) (, server) (, fetch-old))))) - -(defun nndir-open-server (server &optional defs) - (nnheader-init-server-buffer) - (if (equal server nndir-current-server) - t - (if nndir-current-server - (setq nndir-server-alist - (cons (list nndir-current-server - (nnheader-save-variables nndir-server-variables)) - nndir-server-alist))) - (let ((state (assoc server nndir-server-alist))) - (if state - (progn - (nnheader-restore-variables (nth 1 state)) - (setq nndir-server-alist (delq state nndir-server-alist))) - (nnheader-set-init-variables nndir-server-variables defs)) - (or (assq 'nndir-directory defs) - (setq nndir-directory server))) - (setq nndir-current-server server))) - -(defun nndir-close-server (&optional server) - t) - -(defun nndir-server-opened (&optional server) - (and nntp-server-buffer - (get-buffer nntp-server-buffer) - nndir-current-server - (equal nndir-current-server server))) - -(defun nndir-status-message (&optional server) - nndir-status-string) - -(defun nndir-request-article (id &optional group server buffer) - (nndir-execute-nnmh-command - (` (nnmh-request-article (, id) (, group) (, server) (, buffer))))) - -(defun nndir-request-group (group &optional server dont-check) - (nndir-execute-nnmh-command - (` (nnmh-request-group (, group) "" (, dont-check))))) - -(defun nndir-request-list (&optional server dir) - (nndir-execute-nnmh-command - (` (nnmh-request-list nil (, dir))))) - -(defun nndir-request-newgroups (date &optional server) - (nndir-execute-nnmh-command - (` (nnmh-request-newgroups (, date) (, server))))) - -(defun nndir-request-post (&optional server) - (mail-send-and-exit nil)) - -(defalias 'nndir-request-post-buffer 'nnmail-request-post-buffer) - -(defun nndir-request-expire-articles - (articles group &optional server force) - (nndir-execute-nnmh-command - (` (nnmh-request-expire-articles (, articles) (, group) - (, server) (, force))))) - -(defun nndir-request-accept-article (group &optional last) - (nndir-execute-nnmh-command - (` (nnmh-request-accept-article (, group) (, last))))) - -(defun nndir-close-group (group &optional server) - t) - -(defun nndir-request-create-group (group &optional server) - (if (file-exists-p nndir-directory) - (if (file-directory-p nndir-directory) - t - nil) - (condition-case () - (progn - (make-directory nndir-directory t) - t) - (file-error nil)))) - - -;;; Low-Level Interface - -(defun nndir-execute-nnmh-command (command) - (let ((dir (expand-file-name nndir-directory))) - (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) - (let ((dir (expand-file-name nndir-directory))) - (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) + (nnml-request-article 0 nndir-current-group 0 0) + (nnmh-request-group nndir-current-group 0 0) + (nnml-close-group nndir-current-group 0) + (nnml-request-list (nnoo-current-server 'nndir) nndir-directory) + (nnml-request-newsgroups (nnoo-current-server 'nndir) nndir-directory)) (provide 'nndir)