Merge from emacs-24; up to 2012-12-11T09:51:12Z!dmantipov@yandex.ru
[emacs.git] / lisp / gnus / nndir.el
blobb99a0c37d2e79e818c8ab354521a12a8bc171161
1 ;;; nndir.el --- single directory newsgroup access for Gnus
3 ;; Copyright (C) 1995-2013 Free Software Foundation, Inc.
5 ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
6 ;; Keywords: news
8 ;; This file is part of GNU Emacs.
10 ;; GNU Emacs is free software: you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation, either version 3 of the License, or
13 ;; (at your option) any later version.
15 ;; GNU Emacs is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
23 ;;; Commentary:
25 ;;; Code:
27 (require 'nnheader)
28 (require 'nnmh)
29 (require 'nnml)
30 (require 'nnoo)
31 (eval-when-compile (require 'cl))
33 (nnoo-declare nndir
34 nnml nnmh)
36 (defvoo nndir-directory nil
37 "Where nndir will look for groups."
38 nnml-current-directory nnmh-current-directory)
40 (defvoo nndir-nov-is-evil nil
41 "*Non-nil means that nndir will never retrieve NOV headers."
42 nnml-nov-is-evil)
46 (defvoo nndir-current-group "" nil nnml-current-group nnmh-current-group)
47 (defvoo nndir-top-directory nil nil nnml-directory nnmh-directory)
48 (defvoo nndir-get-new-mail nil nil nnml-get-new-mail nnmh-get-new-mail)
50 (defvoo nndir-status-string "" nil nnmh-status-string)
51 (defconst nndir-version "nndir 1.0")
55 ;;; Interface functions.
57 (nnoo-define-basics nndir)
59 (deffoo nndir-open-server (server &optional defs)
60 (setq nndir-directory
61 (or (cadr (assq 'nndir-directory defs))
62 server))
63 (unless (assq 'nndir-directory defs)
64 (push `(nndir-directory ,server) defs))
65 (push `(nndir-current-group
66 ,(file-name-nondirectory (directory-file-name nndir-directory)))
67 defs)
68 (push `(nndir-top-directory
69 ,(file-name-directory (directory-file-name nndir-directory)))
70 defs)
71 (nnoo-change-server 'nndir server defs)
72 (let (err)
73 (cond
74 ((not (condition-case arg
75 (file-exists-p nndir-directory)
76 (ftp-error (setq err (format "%s" arg)))))
77 (nndir-close-server)
78 (nnheader-report
79 'nndir (or err "No such file or directory: %s" nndir-directory)))
80 ((not (file-directory-p (file-truename nndir-directory)))
81 (nndir-close-server)
82 (nnheader-report 'nndir "Not a directory: %s" nndir-directory))
84 (nnheader-report 'nndir "Opened server %s using directory %s"
85 server nndir-directory)
86 t))))
88 (nnoo-map-functions nndir
89 (nnml-retrieve-headers 0 nndir-current-group 0 0)
90 (nnml-request-article 0 nndir-current-group 0 0)
91 (nnmh-request-group nndir-current-group 0 0)
92 (nnml-close-group nndir-current-group 0)
93 (nnml-request-list (nnoo-current-server 'nndir) nndir-directory)
94 (nnml-request-newsgroups (nnoo-current-server 'nndir) nndir-directory))
96 (provide 'nndir)
98 ;;; nndir.el ends here