Commit | Line | Data |
---|---|---|
41487370 | 1 | ;;; nneething.el --- random file access for Gnus |
b578f267 | 2 | |
41487370 LMI |
3 | ;; Copyright (C) 1995 Free Software Foundation, Inc. |
4 | ||
5 | ;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no> | |
6 | ;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet> | |
7 | ;; Keywords: news, mail | |
8 | ||
9 | ;; This file is part of GNU Emacs. | |
10 | ||
11 | ;; GNU Emacs is free software; you can redistribute it and/or modify | |
12 | ;; it under the terms of the GNU General Public License as published by | |
13 | ;; the Free Software Foundation; either version 2, or (at your option) | |
14 | ;; any later version. | |
15 | ||
16 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
17 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
18 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
19 | ;; GNU General Public License for more details. | |
20 | ||
21 | ;; You should have received a copy of the GNU General Public License | |
b578f267 EN |
22 | ;; along with GNU Emacs; see the file COPYING. If not, write to the |
23 | ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
24 | ;; Boston, MA 02111-1307, USA. | |
41487370 LMI |
25 | |
26 | ;;; Commentary: | |
27 | ||
28 | ;; Based on nnspool.el by Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>. | |
29 | ;; For an overview of what the interface functions do, please see the | |
30 | ;; Gnus sources. | |
31 | ||
32 | ;;; Code: | |
33 | ||
34 | (require 'nnheader) | |
35 | (require 'nnmail) | |
36 | ||
37 | (defvar nneething-map-file-directory "~/.nneething/" | |
38 | "*Map files directory.") | |
39 | ||
40 | (defvar nneething-exclude-files "~$" | |
41 | "*Regexp saying what files to exclude from the group.") | |
42 | ||
43 | (defvar nneething-map-file ".nneething" | |
44 | "*Name of map files.") | |
45 | ||
46 | \f | |
47 | ||
48 | (defconst nneething-version "nneething 1.0" | |
49 | "nneething version.") | |
50 | ||
51 | (defvar nneething-current-directory nil | |
52 | "Current news group directory.") | |
53 | ||
54 | (defvar nneething-status-string "") | |
55 | (defvar nneething-group-alist nil) | |
56 | ||
57 | \f | |
58 | ||
59 | (defvar nneething-directory nil) | |
60 | (defvar nneething-group nil) | |
61 | (defvar nneething-map nil) | |
62 | (defvar nneething-read-only nil) | |
63 | (defvar nneething-active nil) | |
64 | (defvar nneething-server-variables | |
65 | (list | |
66 | (list 'nneething-directory nneething-directory) | |
67 | '(nneething-current-directory nil) | |
68 | '(nneething-status-string "") | |
69 | '(nneething-group-alist))) | |
70 | ||
71 | \f | |
72 | ||
73 | ;;; Interface functions. | |
74 | ||
75 | (defun nneething-retrieve-headers (sequence &optional newsgroup server) | |
76 | (nneething-possibly-change-directory newsgroup) | |
77 | ||
78 | (save-excursion | |
79 | (set-buffer nntp-server-buffer) | |
80 | (erase-buffer) | |
81 | (let* ((number (length sequence)) | |
82 | (count 0) | |
83 | (large (and (numberp nnmail-large-newsgroup) | |
84 | (> number nnmail-large-newsgroup))) | |
85 | article file) | |
86 | ||
87 | (if (stringp (car sequence)) | |
88 | 'headers | |
89 | ||
90 | (while sequence | |
91 | (setq article (car sequence)) | |
92 | (setq file (nneething-file-name article)) | |
93 | ||
94 | (if (and (file-exists-p file) | |
95 | (not (zerop (nth 7 (file-attributes file))))) | |
96 | (progn | |
97 | (insert (format "221 %d Article retrieved.\n" article)) | |
98 | (nneething-insert-head file) | |
99 | (insert ".\n"))) | |
100 | ||
101 | (setq sequence (cdr sequence) | |
102 | count (1+ count)) | |
103 | ||
104 | (and large | |
105 | (zerop (% count 20)) | |
106 | (message "nneething: Receiving headers... %d%%" | |
107 | (/ (* count 100) number)))) | |
108 | ||
109 | (and large (message "nneething: Receiving headers...done")) | |
110 | ||
111 | ;; Fold continuation lines. | |
112 | (goto-char (point-min)) | |
113 | (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t) | |
114 | (replace-match " " t t)) | |
115 | 'headers)))) | |
116 | ||
117 | (defun nneething-open-server (server &optional defs) | |
118 | (setq nneething-status-string "") | |
119 | (nnheader-init-server-buffer)) | |
120 | ||
121 | (defun nneething-close-server (&optional server) | |
122 | t) | |
123 | ||
124 | (defun nneething-server-opened (&optional server) | |
125 | t) | |
126 | ||
127 | (defun nneething-status-message (&optional server) | |
128 | nneething-status-string) | |
129 | ||
130 | (defun nneething-request-article (id &optional newsgroup server buffer) | |
131 | (nneething-possibly-change-directory newsgroup) | |
132 | (let ((file (if (stringp id) nil (nneething-file-name id))) | |
133 | (nntp-server-buffer (or buffer nntp-server-buffer))) | |
134 | (and (stringp file) ; We did not request by Message-ID. | |
135 | (file-exists-p file) ; The file exists. | |
136 | (not (file-directory-p file)) ; It's not a dir. | |
137 | (save-excursion | |
138 | (nnmail-find-file file) ; Insert the file in the nntp buf. | |
139 | (or (nnheader-article-p) ; Either it's a real article... | |
140 | (progn | |
141 | (goto-char (point-min)) | |
142 | (nneething-make-head file) ; ... or we fake some headers. | |
143 | (insert "\n"))) | |
144 | t)))) | |
145 | ||
146 | (defun nneething-request-group (group &optional dir dont-check) | |
147 | (nneething-possibly-change-directory group dir) | |
148 | (or dont-check (nneething-create-mapping)) | |
149 | (save-excursion | |
150 | (set-buffer nntp-server-buffer) | |
151 | (erase-buffer) | |
152 | (if (> (car nneething-active) (cdr nneething-active)) | |
153 | (insert (format "211 0 1 0 %s\n" group)) | |
154 | (insert (format "211 %d %d %d %s\n" | |
155 | (- (1+ (cdr nneething-active)) (car nneething-active)) | |
156 | (car nneething-active) (cdr nneething-active) | |
157 | group))) | |
158 | t)) | |
159 | ||
160 | (defun nneething-request-list (&optional server dir) | |
161 | (save-excursion | |
162 | (set-buffer nntp-server-buffer) | |
163 | (erase-buffer)) | |
164 | nil) | |
165 | ||
166 | (defun nneething-request-newgroups (date &optional server) | |
167 | (save-excursion | |
168 | (set-buffer nntp-server-buffer) | |
169 | (erase-buffer)) | |
170 | nil) | |
171 | ||
172 | (defun nneething-request-post (&optional server) | |
173 | (mail-send-and-exit nil)) | |
174 | ||
175 | (defalias 'nneething-request-post-buffer 'nnmail-request-post-buffer) | |
176 | ||
177 | (defun nneething-close-group (group &optional server) | |
178 | t) | |
179 | ||
180 | \f | |
181 | ;;; Internal functions. | |
182 | ||
183 | (defun nneething-possibly-change-directory (group &optional dir) | |
184 | (if (not group) | |
185 | () | |
186 | (if (and nneething-group | |
187 | (string= group nneething-group)) | |
188 | t | |
189 | (let (entry) | |
190 | (if (setq entry (assoc group nneething-group-alist)) | |
191 | (progn | |
192 | (setq nneething-group group) | |
193 | (setq nneething-directory (nth 1 entry)) | |
194 | (setq nneething-map (nth 2 entry)) | |
195 | (setq nneething-active (nth 3 entry))) | |
196 | (setq nneething-group group) | |
197 | (setq nneething-directory dir) | |
198 | (setq nneething-map nil) | |
199 | (setq nneething-active (cons 1 0)) | |
200 | (nneething-create-mapping) | |
201 | (setq nneething-group-alist | |
202 | (cons (list group dir nneething-map nneething-active) | |
203 | nneething-group-alist))))))) | |
204 | ||
205 | (defun nneething-map-file () | |
a7acbbe4 | 206 | ;; We make sure that the .nneething directory exists. |
41487370 LMI |
207 | (make-directory nneething-map-file-directory 'parents) |
208 | ;; We store it in a special directory under the user's home dir. | |
209 | (concat (file-name-as-directory nneething-map-file-directory) | |
210 | nneething-group nneething-map-file)) | |
211 | ||
212 | (defun nneething-create-mapping () | |
213 | ;; Read nneething-active and nneething-map | |
214 | (let ((map-file (nneething-map-file)) | |
215 | (files (directory-files nneething-directory)) | |
216 | touched) | |
217 | (if (file-exists-p map-file) | |
218 | (condition-case nil | |
219 | (load map-file nil t t) | |
220 | (error nil))) | |
221 | (or nneething-active (setq nneething-active (cons 1 0))) | |
222 | ;; Remove files matching that regexp. | |
223 | (let ((f files) | |
224 | prev) | |
225 | (while f | |
226 | (if (string-match nneething-exclude-files (car f)) | |
227 | (if prev (setcdr prev (cdr f)) | |
228 | (setq files (cdr files))) | |
229 | (setq prev f)) | |
230 | (setq f (cdr f)))) | |
231 | ;; Remove files that have disappeared from the map. | |
232 | (let ((map nneething-map) | |
233 | prev) | |
234 | (while map | |
235 | (if (member (car (car map)) files) | |
236 | (setq prev map) | |
237 | (setq touched t) | |
238 | (if prev | |
239 | (setcdr prev (cdr map)) | |
240 | (setq nneething-map (cdr nneething-map)))) | |
241 | (setq map (cdr map)))) | |
242 | ;; Find all new files and enter them into the map. | |
243 | (while files | |
244 | (or (assoc (car files) nneething-map) ; If already in the map, ignore. | |
245 | (progn | |
246 | (setq touched t) | |
247 | (setcdr nneething-active (1+ (cdr nneething-active))) | |
248 | (setq nneething-map | |
249 | (cons (cons (car files) (cdr nneething-active)) nneething-map)))) | |
250 | (setq files (cdr files))) | |
251 | (if (or (not touched) nneething-read-only) | |
252 | () | |
253 | (save-excursion | |
254 | (set-buffer (get-buffer-create " *nneething map*")) | |
255 | (buffer-disable-undo (current-buffer)) | |
256 | (erase-buffer) | |
257 | (insert "(setq nneething-map '" (prin1-to-string nneething-map) ")\n" | |
258 | "(setq nneething-active '" (prin1-to-string nneething-active) | |
259 | ")\n") | |
260 | (write-region (point-min) (point-max) map-file nil 'nomesg) | |
261 | (kill-buffer (current-buffer)))))) | |
262 | ||
263 | (defvar nneething-message-id-number 0) | |
264 | (defvar nneething-work-buffer " *nneething work*") | |
265 | ||
266 | (defun nneething-insert-head (file) | |
267 | (and (nneething-get-head file) | |
268 | (insert-buffer-substring nneething-work-buffer))) | |
269 | ||
270 | (defun nneething-make-head (file) | |
271 | (let ((atts (file-attributes file))) | |
272 | (insert "Subject: " (file-name-nondirectory file) "\n" | |
273 | "Message-ID: <nneething-" | |
274 | (int-to-string | |
275 | (setq nneething-message-id-number | |
276 | (1+ nneething-message-id-number))) | |
277 | "@" (system-name) ">\n" | |
278 | "Date: " (current-time-string (nth 5 atts)) "\n" | |
279 | (nneething-from-line (nth 2 atts)) | |
280 | "Chars: " (int-to-string (nth 7 atts)) "\n"))) | |
281 | ||
282 | (defun nneething-from-line (uid) | |
283 | (let ((login (condition-case nil | |
284 | (user-login-name uid) | |
285 | (error | |
286 | (cond ((= uid (user-uid)) (user-login-name)) | |
287 | ((zerop uid) "root") | |
288 | (t (int-to-string uid)))))) | |
289 | (name (condition-case nil | |
290 | (user-full-name uid) | |
291 | (error | |
292 | (cond ((= uid (user-uid)) (user-full-name)) | |
293 | ((zerop uid) "Ms. Root")))))) | |
294 | (concat "From: " login "@" (system-name) | |
295 | (if name (concat " (" name ")") "") "\n"))) | |
296 | ||
297 | (defun nneething-get-head (file) | |
298 | (save-excursion | |
299 | (set-buffer (get-buffer-create nneething-work-buffer)) | |
300 | (setq case-fold-search nil) | |
301 | (buffer-disable-undo (current-buffer)) | |
302 | (erase-buffer) | |
303 | (cond | |
304 | ((not (file-exists-p file)) | |
305 | ;; The file do not exist. | |
306 | nil) | |
307 | ((or (file-directory-p file) | |
308 | (file-symlink-p file)) | |
309 | ;; It's a dir, so we fudge a head. | |
310 | (nneething-make-head file) t) | |
311 | (t | |
312 | ;; We examine the file. | |
313 | (nnheader-insert-head file) | |
314 | (if (nnheader-article-p) | |
315 | (delete-region | |
316 | (progn | |
317 | (goto-char (point-min)) | |
318 | (or (and (search-forward "\n\n" nil t) | |
319 | (1- (point))) | |
320 | (point-max))) | |
321 | (point-max)) | |
322 | (erase-buffer) | |
323 | (nneething-make-head file)) | |
324 | t)))) | |
325 | ||
326 | (defun nneething-number-to-file (number) | |
327 | (car (rassq number nneething-map))) | |
328 | ||
329 | (defun nneething-file-name (article) | |
330 | (concat (file-name-as-directory nneething-directory) | |
331 | (if (numberp article) (nneething-number-to-file article) | |
332 | article))) | |
333 | ||
334 | (provide 'nneething) | |
335 | ||
336 | ;;; nneething.el ends here |