X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fnneething.el;h=2c6fb78adea64413862c6b86eed0c16499512f86;hb=ab854e37244a9b2a2f43d5a4e645fcd1dc8f147a;hp=828d122726bec0a85092db131ba6bf2ccdae24fb;hpb=8f23fa8532a7a28694825cea0fe3e6140b4eaa08;p=elisp%2Fgnus.git- diff --git a/lisp/nneething.el b/lisp/nneething.el index 828d122..2c6fb78 100644 --- a/lisp/nneething.el +++ b/lisp/nneething.el @@ -1,7 +1,7 @@ ;;; nneething.el --- arbitrary file access for Gnus -;; Copyright (C) 1995,96,97,98 Free Software Foundation, Inc. +;; Copyright (C) 1995,96,97,98,99 Free Software Foundation, Inc. -;; Author: Lars Magne Ingebrigtsen +;; Author: Lars Magne Ingebrigtsen ;; Masanobu UMEDA ;; Keywords: news, mail @@ -45,6 +45,11 @@ "Regexp saying what files to exclude from the group. If this variable is nil, no files will be excluded.") +(defvoo nneething-include-files nil + "Regexp saying what files to include in the group. +If this variable is non-nil, only files matching this regexp will be +included.") + ;;; Internal variables. @@ -64,12 +69,10 @@ If this variable is nil, no files will be excluded.") (defvoo nneething-map nil) (defvoo nneething-read-only nil) (defvoo nneething-active nil) -(defvoo nneething-directory nil) +(defvoo nneething-address nil) -(autoload 'gnus-encode-coding-string "gnus-ems") - ;;; Interface functions. (nnoo-define-basics nneething) @@ -103,11 +106,11 @@ If this variable is nil, no files will be excluded.") (and large (zerop (% count 20)) - (message "nneething: Receiving headers... %d%%" + (nnheader-message 5 "nneething: Receiving headers... %d%%" (/ (* count 100) number)))) (when large - (message "nneething: Receiving headers...done")) + (nnheader-message 5 "nneething: Receiving headers...done")) (nnheader-fold-continuation-lines) 'headers)))) @@ -124,7 +127,8 @@ If this variable is nil, no files will be excluded.") (nnmail-find-file file) ; Insert the file in the nntp buf. (unless (nnheader-article-p) ; Either it's a real article... (goto-char (point-min)) - (nneething-make-head file (current-buffer)) ; ... or we fake some headers. + (nneething-make-head + file (current-buffer)) ; ... or we fake some headers. (insert "\n")) t)))) @@ -158,8 +162,8 @@ If this variable is nil, no files will be excluded.") (nnheader-init-server-buffer) (if (nneething-server-opened server) t - (unless (assq 'nneething-directory defs) - (setq defs (append defs (list (list 'nneething-directory server))))) + (unless (assq 'nneething-address defs) + (setq defs (append defs (list (list 'nneething-address server))))) (nnoo-change-server 'nneething server defs))) @@ -185,9 +189,9 @@ If this variable is nil, no files will be excluded.") (defun nneething-create-mapping () ;; Read nneething-active and nneething-map. - (when (file-exists-p nneething-directory) + (when (file-exists-p nneething-address) (let ((map-file (nneething-map-file)) - (files (directory-files nneething-directory)) + (files (directory-files nneething-address)) touched map-files) (when (file-exists-p map-file) (ignore-errors @@ -213,6 +217,16 @@ If this variable is nil, no files will be excluded.") (setq files (cdr files))) (setq prev f)) (setq f (cdr f))))) + ;; Remove files not matching the inclusion regexp. + (when nneething-include-files + (let ((f files) + prev) + (while f + (if (not (string-match nneething-include-files (car f))) + (if prev (setcdr prev (cdr f)) + (setq files (cdr files))) + (setq prev f)) + (setq f (cdr f))))) ;; Remove deleted files from the map. (let ((map nneething-map) prev) @@ -243,7 +257,7 @@ If this variable is nil, no files will be excluded.") (setq files (cdr files))) (when (and touched (not nneething-read-only)) - (nnheader-temp-write map-file + (with-temp-file map-file (insert "(setq nneething-map '") (gnus-prin1 nneething-map) (insert ")\n(setq nneething-active '") @@ -302,7 +316,8 @@ If this variable is nil, no files will be excluded.") (substring file (match-beginning 1) (match-end 1)) - (when (string-match "/\\(users\\|home\\)/\\([^/]+\\)/" file) + (when (string-match + "/\\(users\\|home\\)/\\([^/]+\\)/" file) (setq login (substring file (match-beginning 2) (match-end 2)) @@ -316,7 +331,7 @@ If this variable is nil, no files will be excluded.") (save-excursion (set-buffer (get-buffer-create nneething-work-buffer)) (setq case-fold-search nil) - (buffer-disable-undo (current-buffer)) + (buffer-disable-undo) (erase-buffer) (cond ((not (file-exists-p file)) @@ -344,10 +359,13 @@ If this variable is nil, no files will be excluded.") (defun nneething-file-name (article) "Return the file name of ARTICLE." - (concat (file-name-as-directory nneething-directory) - (if (numberp article) - (cadr (assq article nneething-map)) - article))) + (let ((dir (file-name-as-directory nneething-address)) + fname) + (if (numberp article) + (if (setq fname (cadr (assq article nneething-map))) + (concat dir fname) + (make-temp-name (concat dir "nneething"))) + (concat dir article)))) (provide 'nneething)