Mercurial > emacs
annotate lisp/nneething.el @ 19897:d9bb216aa23f
(strokes-click-command): Doc fix.
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Fri, 12 Sep 1997 22:41:34 +0000 |
parents | 8d8bf85d356a |
children |
rev | line source |
---|---|
13401 | 1 ;;; nneething.el --- random file access for Gnus |
15511 | 2 ;; Copyright (C) 1995,96 Free Software Foundation, Inc. |
13401 | 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 | |
14169 | 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. | |
13401 | 24 |
25 ;;; Commentary: | |
26 | |
27 ;; Based on nnspool.el by Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>. | |
28 ;; For an overview of what the interface functions do, please see the | |
29 ;; Gnus sources. | |
30 | |
31 ;;; Code: | |
32 | |
33 (require 'nnheader) | |
34 (require 'nnmail) | |
15511 | 35 (require 'nnoo) |
36 (eval-when-compile (require 'cl)) | |
13401 | 37 |
15511 | 38 (nnoo-declare nneething) |
13401 | 39 |
15511 | 40 (defvoo nneething-map-file-directory "~/.nneething/" |
41 "*Where nneething stores the map files.") | |
13401 | 42 |
15511 | 43 (defvoo nneething-map-file ".nneething" |
44 "*Name of the map files.") | |
45 | |
46 (defvoo nneething-exclude-files nil | |
47 "*Regexp saying what files to exclude from the group. | |
48 If this variable is nil, no files will be excluded.") | |
13401 | 49 |
50 | |
51 | |
15511 | 52 ;;; Internal variables. |
53 | |
13401 | 54 (defconst nneething-version "nneething 1.0" |
55 "nneething version.") | |
56 | |
15511 | 57 (defvoo nneething-current-directory nil |
13401 | 58 "Current news group directory.") |
59 | |
15511 | 60 (defvoo nneething-status-string "") |
61 (defvoo nneething-group-alist nil) | |
13401 | 62 |
15511 | 63 (defvoo nneething-message-id-number 0) |
64 (defvoo nneething-work-buffer " *nneething work*") | |
13401 | 65 |
15511 | 66 (defvoo nneething-directory nil) |
67 (defvoo nneething-group nil) | |
68 (defvoo nneething-map nil) | |
69 (defvoo nneething-read-only nil) | |
70 (defvoo nneething-active nil) | |
13401 | 71 |
72 | |
73 | |
74 ;;; Interface functions. | |
75 | |
15511 | 76 (nnoo-define-basics nneething) |
77 | |
78 (deffoo nneething-retrieve-headers (articles &optional group server fetch-old) | |
79 (nneething-possibly-change-directory group) | |
13401 | 80 |
81 (save-excursion | |
82 (set-buffer nntp-server-buffer) | |
83 (erase-buffer) | |
15511 | 84 (let* ((number (length articles)) |
13401 | 85 (count 0) |
86 (large (and (numberp nnmail-large-newsgroup) | |
87 (> number nnmail-large-newsgroup))) | |
88 article file) | |
89 | |
15511 | 90 (if (stringp (car articles)) |
13401 | 91 'headers |
92 | |
15511 | 93 (while (setq article (pop articles)) |
13401 | 94 (setq file (nneething-file-name article)) |
95 | |
15511 | 96 (when (and (file-exists-p file) |
97 (or (file-directory-p file) | |
15559
8d8bf85d356a
Synched with Gnus 5.2.31.
Lars Magne Ingebrigtsen <larsi@gnus.org>
parents:
15511
diff
changeset
|
98 (not (zerop (nnheader-file-size file))))) |
15511 | 99 (insert (format "221 %d Article retrieved.\n" article)) |
100 (nneething-insert-head file) | |
101 (insert ".\n")) | |
13401 | 102 |
15511 | 103 (incf count) |
13401 | 104 |
105 (and large | |
106 (zerop (% count 20)) | |
107 (message "nneething: Receiving headers... %d%%" | |
108 (/ (* count 100) number)))) | |
109 | |
15511 | 110 (when large |
111 (message "nneething: Receiving headers...done")) | |
13401 | 112 |
15511 | 113 (nnheader-fold-continuation-lines) |
13401 | 114 'headers)))) |
115 | |
15511 | 116 (deffoo nneething-request-article (id &optional group server buffer) |
117 (nneething-possibly-change-directory group) | |
118 (let ((file (unless (stringp id) (nneething-file-name id))) | |
13401 | 119 (nntp-server-buffer (or buffer nntp-server-buffer))) |
120 (and (stringp file) ; We did not request by Message-ID. | |
121 (file-exists-p file) ; The file exists. | |
122 (not (file-directory-p file)) ; It's not a dir. | |
123 (save-excursion | |
124 (nnmail-find-file file) ; Insert the file in the nntp buf. | |
125 (or (nnheader-article-p) ; Either it's a real article... | |
126 (progn | |
127 (goto-char (point-min)) | |
15511 | 128 (nneething-make-head file (current-buffer)) ; ... or we fake some headers. |
13401 | 129 (insert "\n"))) |
130 t)))) | |
131 | |
15511 | 132 (deffoo nneething-request-group (group &optional dir dont-check) |
13401 | 133 (nneething-possibly-change-directory group dir) |
15511 | 134 (unless dont-check |
135 (nneething-create-mapping) | |
13401 | 136 (if (> (car nneething-active) (cdr nneething-active)) |
15511 | 137 (nnheader-insert "211 0 1 0 %s\n" group) |
138 (nnheader-insert | |
139 "211 %d %d %d %s\n" | |
140 (- (1+ (cdr nneething-active)) (car nneething-active)) | |
141 (car nneething-active) (cdr nneething-active) | |
142 group))) | |
143 t) | |
13401 | 144 |
15511 | 145 (deffoo nneething-request-list (&optional server dir) |
146 (nnheader-report 'nneething "LIST is not implemented.")) | |
147 | |
148 (deffoo nneething-request-newgroups (date &optional server) | |
149 (nnheader-report 'nneething "NEWSGROUPS is not implemented.")) | |
13401 | 150 |
15511 | 151 (deffoo nneething-request-type (group &optional article) |
152 'unknown) | |
13401 | 153 |
15511 | 154 (deffoo nneething-close-group (group &optional server) |
155 (setq nneething-current-directory nil) | |
13401 | 156 t) |
157 | |
158 | |
159 ;;; Internal functions. | |
160 | |
161 (defun nneething-possibly-change-directory (group &optional dir) | |
15511 | 162 (when group |
13401 | 163 (if (and nneething-group |
164 (string= group nneething-group)) | |
165 t | |
166 (let (entry) | |
167 (if (setq entry (assoc group nneething-group-alist)) | |
168 (progn | |
169 (setq nneething-group group) | |
170 (setq nneething-directory (nth 1 entry)) | |
171 (setq nneething-map (nth 2 entry)) | |
172 (setq nneething-active (nth 3 entry))) | |
173 (setq nneething-group group) | |
174 (setq nneething-directory dir) | |
175 (setq nneething-map nil) | |
176 (setq nneething-active (cons 1 0)) | |
177 (nneething-create-mapping) | |
15511 | 178 (push (list group dir nneething-map nneething-active) |
179 nneething-group-alist)))))) | |
13401 | 180 |
181 (defun nneething-map-file () | |
14040 | 182 ;; We make sure that the .nneething directory exists. |
15511 | 183 (unless (file-exists-p nneething-map-file-directory) |
184 (make-directory nneething-map-file-directory 'parents)) | |
13401 | 185 ;; We store it in a special directory under the user's home dir. |
186 (concat (file-name-as-directory nneething-map-file-directory) | |
187 nneething-group nneething-map-file)) | |
188 | |
189 (defun nneething-create-mapping () | |
15511 | 190 ;; Read nneething-active and nneething-map. |
13401 | 191 (let ((map-file (nneething-map-file)) |
192 (files (directory-files nneething-directory)) | |
15511 | 193 touched map-files) |
13401 | 194 (if (file-exists-p map-file) |
195 (condition-case nil | |
196 (load map-file nil t t) | |
197 (error nil))) | |
198 (or nneething-active (setq nneething-active (cons 1 0))) | |
15511 | 199 ;; Old nneething had a different map format. |
200 (when (and (cdar nneething-map) | |
201 (atom (cdar nneething-map))) | |
202 (setq nneething-map | |
203 (mapcar (lambda (n) | |
204 (list (cdr n) (car n) | |
205 (nth 5 (file-attributes | |
206 (nneething-file-name (car n)))))) | |
207 nneething-map))) | |
208 ;; Remove files matching the exclusion regexp. | |
209 (when nneething-exclude-files | |
210 (let ((f files) | |
211 prev) | |
212 (while f | |
213 (if (string-match nneething-exclude-files (car f)) | |
214 (if prev (setcdr prev (cdr f)) | |
215 (setq files (cdr files))) | |
216 (setq prev f)) | |
217 (setq f (cdr f))))) | |
218 ;; Remove deleted files from the map. | |
13401 | 219 (let ((map nneething-map) |
220 prev) | |
221 (while map | |
15511 | 222 (if (and (member (cadar map) files) |
223 ;; We also remove files that have changed mod times. | |
224 (equal (nth 5 (file-attributes | |
225 (nneething-file-name (cadar map)))) | |
226 (caddar map))) | |
227 (progn | |
228 (push (cadar map) map-files) | |
229 (setq prev map)) | |
13401 | 230 (setq touched t) |
231 (if prev | |
232 (setcdr prev (cdr map)) | |
233 (setq nneething-map (cdr nneething-map)))) | |
234 (setq map (cdr map)))) | |
235 ;; Find all new files and enter them into the map. | |
236 (while files | |
15511 | 237 (unless (member (car files) map-files) |
238 ;; This file is not in the map, so we enter it. | |
239 (setq touched t) | |
240 (setcdr nneething-active (1+ (cdr nneething-active))) | |
241 (push (list (cdr nneething-active) (car files) | |
242 (nth 5 (file-attributes | |
243 (nneething-file-name (car files))))) | |
244 nneething-map)) | |
13401 | 245 (setq files (cdr files))) |
15511 | 246 (when (and touched |
247 (not nneething-read-only)) | |
13401 | 248 (save-excursion |
15511 | 249 (nnheader-set-temp-buffer " *nneething map*") |
13401 | 250 (insert "(setq nneething-map '" (prin1-to-string nneething-map) ")\n" |
251 "(setq nneething-active '" (prin1-to-string nneething-active) | |
252 ")\n") | |
253 (write-region (point-min) (point-max) map-file nil 'nomesg) | |
254 (kill-buffer (current-buffer)))))) | |
255 | |
15511 | 256 (defun nneething-insert-head (file) |
257 "Insert the head of FILE." | |
258 (when (nneething-get-head file) | |
259 (insert-buffer-substring nneething-work-buffer) | |
260 (goto-char (point-max)))) | |
13401 | 261 |
15511 | 262 (defun nneething-make-head (file &optional buffer) |
263 "Create a head by looking at the file attributes of FILE." | |
13401 | 264 (let ((atts (file-attributes file))) |
15511 | 265 (insert |
266 "Subject: " (file-name-nondirectory file) "\n" | |
267 "Message-ID: <nneething-" | |
268 (int-to-string (incf nneething-message-id-number)) | |
269 "@" (system-name) ">\n" | |
270 (if (equal '(0 0) (nth 5 atts)) "" | |
271 (concat "Date: " (current-time-string (nth 5 atts)) "\n")) | |
272 (or (if buffer | |
273 (save-excursion | |
274 (set-buffer buffer) | |
275 (if (re-search-forward "<[a-zA-Z0-9_]@[-a-zA-Z0-9_]>" 1000 t) | |
276 (concat "From: " (match-string 0) "\n")))) | |
277 (nneething-from-line (nth 2 atts) file)) | |
278 (if (> (string-to-int (int-to-string (nth 7 atts))) 0) | |
279 (concat "Chars: " (int-to-string (nth 7 atts)) "\n") | |
280 "") | |
281 (if buffer | |
282 (save-excursion | |
283 (set-buffer buffer) | |
284 (concat "Lines: " (int-to-string | |
285 (count-lines (point-min) (point-max))) "\n")) | |
286 "") | |
287 ))) | |
13401 | 288 |
15511 | 289 (defun nneething-from-line (uid &optional file) |
290 "Return a From header based of UID." | |
291 (let* ((login (condition-case nil | |
292 (user-login-name uid) | |
293 (error | |
294 (cond ((= uid (user-uid)) (user-login-name)) | |
295 ((zerop uid) "root") | |
296 (t (int-to-string uid)))))) | |
297 (name (condition-case nil | |
298 (user-full-name uid) | |
13401 | 299 (error |
15511 | 300 (cond ((= uid (user-uid)) (user-full-name)) |
301 ((zerop uid) "Ms. Root"))))) | |
302 (host (if (string-match "\\`/[^/@]*@\\([^:/]+\\):" file) | |
303 (prog1 | |
304 (substring file | |
305 (match-beginning 1) | |
306 (match-end 1)) | |
307 (if (string-match "/\\(users\\|home\\)/\\([^/]+\\)/" file) | |
308 (setq login (substring file | |
309 (match-beginning 2) | |
310 (match-end 2)) | |
311 name nil))) | |
312 (system-name)))) | |
313 (concat "From: " login "@" host | |
13401 | 314 (if name (concat " (" name ")") "") "\n"))) |
315 | |
316 (defun nneething-get-head (file) | |
15511 | 317 "Either find the head in FILE or make a head for FILE." |
13401 | 318 (save-excursion |
319 (set-buffer (get-buffer-create nneething-work-buffer)) | |
320 (setq case-fold-search nil) | |
321 (buffer-disable-undo (current-buffer)) | |
322 (erase-buffer) | |
323 (cond | |
324 ((not (file-exists-p file)) | |
325 ;; The file do not exist. | |
326 nil) | |
327 ((or (file-directory-p file) | |
328 (file-symlink-p file)) | |
329 ;; It's a dir, so we fudge a head. | |
330 (nneething-make-head file) t) | |
331 (t | |
332 ;; We examine the file. | |
333 (nnheader-insert-head file) | |
334 (if (nnheader-article-p) | |
335 (delete-region | |
336 (progn | |
337 (goto-char (point-min)) | |
338 (or (and (search-forward "\n\n" nil t) | |
339 (1- (point))) | |
340 (point-max))) | |
341 (point-max)) | |
15511 | 342 (goto-char (point-min)) |
343 (nneething-make-head file (current-buffer)) | |
344 (delete-region (point) (point-max))) | |
13401 | 345 t)))) |
346 | |
347 (defun nneething-file-name (article) | |
15511 | 348 "Return the file name of ARTICLE." |
13401 | 349 (concat (file-name-as-directory nneething-directory) |
15511 | 350 (if (numberp article) |
351 (cadr (assq article nneething-map)) | |
13401 | 352 article))) |
353 | |
354 (provide 'nneething) | |
355 | |
356 ;;; nneething.el ends here |