comparison lisp/gnus/nneething.el @ 16:0293115a14e9 r19-15b91

Import from CVS: tag r19-15b91
author cvs
date Mon, 13 Aug 2007 08:49:20 +0200
parents ac2d302a0011
children ec9a17fef872
comparison
equal deleted inserted replaced
15:ad457d5f7d04 16:0293115a14e9
1 ;;; nneething.el --- random file access for Gnus 1 ;;; nneething.el --- random file access for Gnus
2 ;; Copyright (C) 1995,96 Free Software Foundation, Inc. 2 ;; Copyright (C) 1995,96,97 Free Software Foundation, Inc.
3 3
4 ;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no> 4 ;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
5 ;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet> 5 ;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
6 ;; Keywords: news, mail 6 ;; Keywords: news, mail
7 7
31 ;;; Code: 31 ;;; Code:
32 32
33 (require 'nnheader) 33 (require 'nnheader)
34 (require 'nnmail) 34 (require 'nnmail)
35 (require 'nnoo) 35 (require 'nnoo)
36 (eval-when-compile (require 'cl)) 36 (require 'gnus-util)
37 (require 'cl)
37 38
38 (nnoo-declare nneething) 39 (nnoo-declare nneething)
39 40
40 (defvoo nneething-map-file-directory "~/.nneething/" 41 (defvoo nneething-map-file-directory "~/.nneething/"
41 "*Where nneething stores the map files.") 42 "*Where nneething stores the map files.")
113 (nnheader-fold-continuation-lines) 114 (nnheader-fold-continuation-lines)
114 'headers)))) 115 'headers))))
115 116
116 (deffoo nneething-request-article (id &optional group server buffer) 117 (deffoo nneething-request-article (id &optional group server buffer)
117 (nneething-possibly-change-directory group) 118 (nneething-possibly-change-directory group)
118 (let ((file (unless (stringp id) (nneething-file-name id))) 119 (let ((file (unless (stringp id)
120 (nneething-file-name id)))
119 (nntp-server-buffer (or buffer nntp-server-buffer))) 121 (nntp-server-buffer (or buffer nntp-server-buffer)))
120 (and (stringp file) ; We did not request by Message-ID. 122 (and (stringp file) ; We did not request by Message-ID.
121 (file-exists-p file) ; The file exists. 123 (file-exists-p file) ; The file exists.
122 (not (file-directory-p file)) ; It's not a dir. 124 (not (file-directory-p file)) ; It's not a dir.
123 (save-excursion 125 (save-excursion
124 (nnmail-find-file file) ; Insert the file in the nntp buf. 126 (nnmail-find-file file) ; Insert the file in the nntp buf.
125 (or (nnheader-article-p) ; Either it's a real article... 127 (unless (nnheader-article-p) ; Either it's a real article...
126 (progn 128 (goto-char (point-min))
127 (goto-char (point-min)) 129 (nneething-make-head file (current-buffer)) ; ... or we fake some headers.
128 (nneething-make-head file (current-buffer)) ; ... or we fake some headers. 130 (insert "\n"))
129 (insert "\n")))
130 t)))) 131 t))))
131 132
132 (deffoo nneething-request-group (group &optional dir dont-check) 133 (deffoo nneething-request-group (group &optional dir dont-check)
133 (nneething-possibly-change-directory group dir) 134 (nneething-possibly-change-directory group dir)
134 (unless dont-check 135 (unless dont-check
178 (push (list group dir nneething-map nneething-active) 179 (push (list group dir nneething-map nneething-active)
179 nneething-group-alist)))))) 180 nneething-group-alist))))))
180 181
181 (defun nneething-map-file () 182 (defun nneething-map-file ()
182 ;; We make sure that the .nneething directory exists. 183 ;; We make sure that the .nneething directory exists.
183 (unless (file-exists-p nneething-map-file-directory) 184 (gnus-make-directory nneething-map-file-directory)
184 (make-directory nneething-map-file-directory 'parents))
185 ;; We store it in a special directory under the user's home dir. 185 ;; We store it in a special directory under the user's home dir.
186 (concat (file-name-as-directory nneething-map-file-directory) 186 (concat (file-name-as-directory nneething-map-file-directory)
187 nneething-group nneething-map-file)) 187 nneething-group nneething-map-file))
188 188
189 (defun nneething-create-mapping () 189 (defun nneething-create-mapping ()
190 ;; Read nneething-active and nneething-map. 190 ;; Read nneething-active and nneething-map.
191 (let ((map-file (nneething-map-file)) 191 (let ((map-file (nneething-map-file))
192 (files (directory-files nneething-directory)) 192 (files (directory-files nneething-directory))
193 touched map-files) 193 touched map-files)
194 (if (file-exists-p map-file) 194 (when (file-exists-p map-file)
195 (condition-case nil 195 (ignore-errors
196 (load map-file nil t t) 196 (load map-file nil t t)))
197 (error nil))) 197 (unless nneething-active
198 (or nneething-active (setq nneething-active (cons 1 0))) 198 (setq nneething-active (cons 1 0)))
199 ;; Old nneething had a different map format. 199 ;; Old nneething had a different map format.
200 (when (and (cdar nneething-map) 200 (when (and (cdar nneething-map)
201 (atom (cdar nneething-map))) 201 (atom (cdar nneething-map)))
202 (setq nneething-map 202 (setq nneething-map
203 (mapcar (lambda (n) 203 (mapcar (lambda (n)
204 (list (cdr n) (car n) 204 (list (cdr n) (car n)
205 (nth 5 (file-attributes 205 (nth 5 (file-attributes
206 (nneething-file-name (car n)))))) 206 (nneething-file-name (car n))))))
207 nneething-map))) 207 nneething-map)))
208 ;; Remove files matching the exclusion regexp. 208 ;; Remove files matching the exclusion regexp.
209 (when nneething-exclude-files 209 (when nneething-exclude-files
232 (setcdr prev (cdr map)) 232 (setcdr prev (cdr map))
233 (setq nneething-map (cdr nneething-map)))) 233 (setq nneething-map (cdr nneething-map))))
234 (setq map (cdr map)))) 234 (setq map (cdr map))))
235 ;; Find all new files and enter them into the map. 235 ;; Find all new files and enter them into the map.
236 (while files 236 (while files
237 (unless (member (car files) map-files) 237 (unless (member (car files) map-files)
238 ;; This file is not in the map, so we enter it. 238 ;; This file is not in the map, so we enter it.
239 (setq touched t) 239 (setq touched t)
240 (setcdr nneething-active (1+ (cdr nneething-active))) 240 (setcdr nneething-active (1+ (cdr nneething-active)))
241 (push (list (cdr nneething-active) (car files) 241 (push (list (cdr nneething-active) (car files)
242 (nth 5 (file-attributes 242 (nth 5 (file-attributes
243 (nneething-file-name (car files))))) 243 (nneething-file-name (car files)))))
244 nneething-map)) 244 nneething-map))
245 (setq files (cdr files))) 245 (setq files (cdr files)))
246 (when (and touched 246 (when (and touched
247 (not nneething-read-only)) 247 (not nneething-read-only))
248 (save-excursion 248 (nnheader-temp-write map-file
249 (nnheader-set-temp-buffer " *nneething map*") 249 (insert "(setq nneething-map '")
250 (insert "(setq nneething-map '" (prin1-to-string nneething-map) ")\n" 250 (gnus-prin1 nneething-map)
251 "(setq nneething-active '" (prin1-to-string nneething-active) 251 (insert ")\n(setq nneething-active '")
252 ")\n") 252 (gnus-prin1 nneething-active)
253 (write-region (point-min) (point-max) map-file nil 'nomesg) 253 (insert ")\n")))))
254 (kill-buffer (current-buffer))))))
255 254
256 (defun nneething-insert-head (file) 255 (defun nneething-insert-head (file)
257 "Insert the head of FILE." 256 "Insert the head of FILE."
258 (when (nneething-get-head file) 257 (when (nneething-get-head file)
259 (insert-buffer-substring nneething-work-buffer) 258 (insert-buffer-substring nneething-work-buffer)
267 "Message-ID: <nneething-" 266 "Message-ID: <nneething-"
268 (int-to-string (incf nneething-message-id-number)) 267 (int-to-string (incf nneething-message-id-number))
269 "@" (system-name) ">\n" 268 "@" (system-name) ">\n"
270 (if (equal '(0 0) (nth 5 atts)) "" 269 (if (equal '(0 0) (nth 5 atts)) ""
271 (concat "Date: " (current-time-string (nth 5 atts)) "\n")) 270 (concat "Date: " (current-time-string (nth 5 atts)) "\n"))
272 (or (if buffer 271 (or (when buffer
273 (save-excursion 272 (save-excursion
274 (set-buffer buffer) 273 (set-buffer buffer)
275 (if (re-search-forward "<[a-zA-Z0-9_]@[-a-zA-Z0-9_]>" 1000 t) 274 (when (re-search-forward "<[a-zA-Z0-9_]@[-a-zA-Z0-9_]>" 1000 t)
276 (concat "From: " (match-string 0) "\n")))) 275 (concat "From: " (match-string 0) "\n"))))
277 (nneething-from-line (nth 2 atts) file)) 276 (nneething-from-line (nth 2 atts) file))
278 (if (> (string-to-int (int-to-string (nth 7 atts))) 0) 277 (if (> (string-to-int (int-to-string (nth 7 atts))) 0)
279 (concat "Chars: " (int-to-string (nth 7 atts)) "\n") 278 (concat "Chars: " (int-to-string (nth 7 atts)) "\n")
280 "") 279 "")
281 (if buffer 280 (if buffer
282 (save-excursion 281 (save-excursion
283 (set-buffer buffer) 282 (set-buffer buffer)
284 (concat "Lines: " (int-to-string 283 (concat "Lines: " (int-to-string
285 (count-lines (point-min) (point-max))) "\n")) 284 (count-lines (point-min) (point-max)))
285 "\n"))
286 "") 286 "")
287 ))) 287 )))
288 288
289 (defun nneething-from-line (uid &optional file) 289 (defun nneething-from-line (uid &optional file)
290 "Return a From header based of UID." 290 "Return a From header based of UID."
300 (cond ((= uid (user-uid)) (user-full-name)) 300 (cond ((= uid (user-uid)) (user-full-name))
301 ((zerop uid) "Ms. Root"))))) 301 ((zerop uid) "Ms. Root")))))
302 (host (if (string-match "\\`/[^/@]*@\\([^:/]+\\):" file) 302 (host (if (string-match "\\`/[^/@]*@\\([^:/]+\\):" file)
303 (prog1 303 (prog1
304 (substring file 304 (substring file
305 (match-beginning 1) 305 (match-beginning 1)
306 (match-end 1)) 306 (match-end 1))
307 (if (string-match "/\\(users\\|home\\)/\\([^/]+\\)/" file) 307 (when (string-match "/\\(users\\|home\\)/\\([^/]+\\)/" file)
308 (setq login (substring file 308 (setq login (substring file
309 (match-beginning 2) 309 (match-beginning 2)
310 (match-end 2)) 310 (match-end 2))
311 name nil))) 311 name nil)))
312 (system-name)))) 312 (system-name))))
313 (concat "From: " login "@" host 313 (concat "From: " login "@" host
314 (if name (concat " (" name ")") "") "\n"))) 314 (if name (concat " (" name ")") "") "\n")))
315 315
316 (defun nneething-get-head (file) 316 (defun nneething-get-head (file)