X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fnndir.el;h=736f37c1fa58502bc278a63277a1cb162c315ec9;hb=1fa3b0313c103cb7a9fb24c414fc8ac305dbe790;hp=479db2ab9a170af20ee3eb5c63a3a92bd20efd59;hpb=9da31b2c73efa8807205df69551f7576cc2477bc;p=gnus diff --git a/lisp/nndir.el b/lisp/nndir.el index 479db2ab9..736f37c1f 100644 --- a/lisp/nndir.el +++ b/lisp/nndir.el @@ -1,16 +1,16 @@ ;;; nndir.el --- single directory newsgroup access for Gnus -;; Copyright (C) 1995 Free Software Foundation, Inc. -;; Author: Lars Ingebrigtsen -;; Masanobu UMEDA -;; Keywords: news, mail +;; Copyright (C) 1995-2011 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 +18,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,128 +27,71 @@ (require 'nnheader) (require 'nnmh) (require 'nnml) +(require 'nnoo) +(eval-when-compile (require 'cl)) - - -(defconst nndir-version "nndir 0.0") +(nnoo-declare nndir + nnml nnmh) -(defvar nndir-current-directory nil - "Current news group directory.") +(defvoo nndir-directory nil + "Where nndir will look for groups." + nnml-current-directory nnmh-current-directory) -(defvar nndir-status-string "") - -(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) -;;; 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 "") - (nndir-open-server-internal host service)) - -(defun nndir-close-server (&optional server) - "Close news server." - (nndir-close-server-internal)) - -(defalias 'nndir-request-quit 'nndir-close-server) - -(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))) +(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) -(defun nndir-status-message () - "Return server status response as string." - nndir-status-string) +(defvoo nndir-status-string "" nil nnmh-status-string) +(defconst nndir-version "nndir 1.0") -(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)) - -(fset '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) +;;; Interface functions. - -;;; Low-Level Interface - -(defun nndir-open-server-internal (host &optional service) - "Open connection to news server on HOST by SERVICE." - (save-excursion - ;; Initialize communication buffer. - (setq nntp-server-buffer (get-buffer-create " *nntpd*")) - (set-buffer nntp-server-buffer) - (buffer-disable-undo (current-buffer)) - (erase-buffer) - (kill-all-local-variables) - (setq case-fold-search t) ;Should ignore case. - t)) - -(defun nndir-close-server-internal () - "Close connection to news server." - nil) - -(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)