1 ;;; nndir.el --- single directory newsgroup access for Gnus
2 ;; Copyright (C) 1995,96 Free Software Foundation, Inc.
4 ;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
5 ;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
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 2, or (at your option)
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; see the file COPYING. If not, write to the
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
23 ;; Boston, MA 02111-1307, USA.
32 (eval-when-compile (require 'cl))
35 (autoload 'mail-send-and-exit "sendmail"))
37 (defvar nndir-directory nil)
41 (defconst nndir-version "nndir 1.0")
43 (defvar nndir-status-string "")
45 (defvar nndir-nov-is-evil nil
46 "*Non-nil means that nndir will never retrieve NOV headers.")
50 (defvar nndir-current-server nil)
51 (defvar nndir-server-alist nil)
52 (defvar nndir-server-variables
54 '(nndir-directory nil)
55 '(nndir-status-string "")
56 '(nndir-group-alist)))
60 ;;; Interface functions.
63 (defun nndir-retrieve-headers (sequence &optional group server fetch-old)
64 (nndir-execute-nnml-command
65 (` (nnml-retrieve-headers
66 (quote (, sequence)) group (, server) (, fetch-old)))))
68 (defun nndir-open-server (server &optional defs)
69 (nnheader-init-server-buffer)
70 (if (equal server nndir-current-server)
72 (if nndir-current-server
73 (setq nndir-server-alist
74 (cons (list nndir-current-server
75 (nnheader-save-variables nndir-server-variables))
77 (let ((state (assoc server nndir-server-alist)))
80 (nnheader-restore-variables (nth 1 state))
81 (setq nndir-server-alist (delq state nndir-server-alist)))
82 (nnheader-set-init-variables nndir-server-variables defs))
83 (or (assq 'nndir-directory defs)
84 (setq nndir-directory server)))
85 (setq nndir-current-server server)))
87 (defun nndir-close-server (&optional server)
90 (defun nndir-server-opened (&optional server)
91 (and nntp-server-buffer
92 (get-buffer nntp-server-buffer)
94 (equal nndir-current-server server)))
96 (defun nndir-status-message (&optional server)
99 (defun nndir-request-article (id &optional group server buffer)
100 (nndir-execute-nnmh-command
101 (` (nnmh-request-article (, id) group (, server) (, buffer)))))
103 (defun nndir-request-group (group &optional server dont-check)
104 (nndir-execute-nnmh-command
105 (` (nnmh-request-group group "" (, dont-check)))))
107 (defun nndir-request-list (&optional server dir)
108 (nndir-execute-nnmh-command
109 (` (nnmh-request-list nil (, dir)))))
111 (defun nndir-request-newgroups (date &optional server)
112 (nndir-execute-nnmh-command
113 (` (nnmh-request-newgroups (, date) (, server)))))
115 (defun nndir-request-post (&optional server)
116 (mail-send-and-exit nil))
118 (defun nndir-request-expire-articles
119 (articles group &optional server force)
120 (nndir-execute-nnmh-command
121 (` (nnmh-request-expire-articles (quote (, articles)) group
122 (, server) (, force)))))
124 (defun nndir-request-accept-article (group &optional last)
125 (nndir-execute-nnmh-command
126 (` (nnmh-request-accept-article group (, last)))))
128 (defun nndir-close-group (group &optional server)
131 (defun nndir-request-create-group (group &optional server)
132 (if (file-exists-p nndir-directory)
133 (if (file-directory-p nndir-directory)
138 (make-directory nndir-directory t)
143 ;;; Low-Level Interface
145 (defun nndir-execute-nnmh-command (command)
146 (let ((dir (expand-file-name nndir-directory)))
147 (and (string-match "/$" dir)
148 (setq dir (substring dir 0 (match-beginning 0))))
149 (string-match "/[^/]+$" dir)
150 (let ((group (substring dir (1+ (match-beginning 0))))
151 (nnmh-directory (substring dir 0 (1+ (match-beginning 0))))
152 (nnmh-get-new-mail nil))
155 (defun nndir-execute-nnml-command (command)
156 (let ((dir (expand-file-name nndir-directory)))
157 (and (string-match "/$" dir)
158 (setq dir (substring dir 0 (match-beginning 0))))
159 (string-match "/[^/]+$" dir)
160 (let ((group (substring dir (1+ (match-beginning 0))))
161 (nnml-directory (substring dir 0 (1+ (match-beginning 0))))
162 (nnml-nov-is-evil nndir-nov-is-evil)
163 (nnml-get-new-mail nil))
168 ;;; nndir.el ends here