X-Git-Url: http://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fnndir.el;h=b6de7afa019d40054120a946eb9ea6006c28640e;hp=4000697f428706fb7053f818f9d3b77ed2aaf154;hb=c9a393eeb329a99695566342a9f03b8a30000898;hpb=b7c6ae5d1f771b9c4432782015dda00282947fa2 diff --git a/lisp/nndir.el b/lisp/nndir.el index 4000697f4..b6de7afa0 100644 --- a/lisp/nndir.el +++ b/lisp/nndir.el @@ -1,16 +1,17 @@ ;;; 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, 2001, 2002, 2003, 2004, +;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. + +;; Author: Lars Magne Ingebrigtsen ;; Keywords: news ;; This file is part of GNU Emacs. -;; GNU Emacs is free software; you can redistribute it and/or modify +;; 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. +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of @@ -18,8 +19,7 @@ ;; 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. If not, see . ;;; Commentary: @@ -28,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 0.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) + (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)