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