-;;; nneething.el --- random file access for Gnus
-;; Copyright (C) 1995,96 Free Software Foundation, Inc.
+;;; nneething.el --- arbitrary file access for Gnus
+;; Copyright (C) 1995,96,97,98,99 Free Software Foundation, Inc.
-;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
+;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
;; Keywords: news, mail
;;; Commentary:
-;; Based on nnspool.el by Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>.
-;; For an overview of what the interface functions do, please see the
-;; Gnus sources.
-
;;; Code:
+(eval-when-compile (require 'cl))
+
(require 'nnheader)
(require 'nnmail)
(require 'nnoo)
-(eval-when-compile (require 'cl))
+(require 'gnus-util)
(nnoo-declare nneething)
(defvoo nneething-map-file-directory "~/.nneething/"
- "*Where nneething stores the map files.")
+ "Where nneething stores the map files.")
(defvoo nneething-map-file ".nneething"
- "*Name of the map files.")
+ "Name of the map files.")
(defvoo nneething-exclude-files nil
- "*Regexp saying what files to exclude from the group.
+ "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.")
+
\f
-;;; Internal variables.
+;;; Internal variables.
(defconst nneething-version "nneething 1.0"
"nneething version.")
"Current news group directory.")
(defvoo nneething-status-string "")
-(defvoo nneething-group-alist nil)
(defvoo nneething-message-id-number 0)
(defvoo nneething-work-buffer " *nneething work*")
-(defvoo nneething-directory nil)
(defvoo nneething-group nil)
(defvoo nneething-map nil)
(defvoo nneething-read-only nil)
(defvoo nneething-active nil)
+(defvoo nneething-address nil)
\f
(when (and (file-exists-p file)
(or (file-directory-p file)
- (not (zerop (nth 7 (file-attributes file))))))
+ (not (zerop (nnheader-file-size file)))))
(insert (format "221 %d Article retrieved.\n" article))
(nneething-insert-head file)
(insert ".\n"))
(and large
(zerop (% count 20))
- (message "nneething: Receiving headers... %d%%"
- (/ (* count 100) number))))
+ (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))))
(deffoo nneething-request-article (id &optional group server buffer)
(nneething-possibly-change-directory group)
- (let ((file (unless (stringp id) (nneething-file-name id)))
+ (let ((file (unless (stringp id)
+ (nneething-file-name id)))
(nntp-server-buffer (or buffer nntp-server-buffer)))
(and (stringp file) ; We did not request by Message-ID.
(file-exists-p file) ; The file exists.
(not (file-directory-p file)) ; It's not a dir.
(save-excursion
(nnmail-find-file file) ; Insert the file in the nntp buf.
- (or (nnheader-article-p) ; Either it's a real article...
- (progn
- (goto-char (point-min))
- (nneething-make-head file (current-buffer)) ; ... or we fake some headers.
- (insert "\n")))
+ (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.
+ (insert "\n"))
t))))
-(deffoo nneething-request-group (group &optional dir dont-check)
- (nneething-possibly-change-directory group dir)
+(deffoo nneething-request-group (group &optional server dont-check)
+ (nneething-possibly-change-directory group server)
(unless dont-check
(nneething-create-mapping)
(if (> (car nneething-active) (cdr nneething-active))
(nnheader-insert "211 0 1 0 %s\n" group)
(nnheader-insert
- "211 %d %d %d %s\n"
+ "211 %d %d %d %s\n"
(- (1+ (cdr nneething-active)) (car nneething-active))
(car nneething-active) (cdr nneething-active)
group)))
(setq nneething-current-directory nil)
t)
+(deffoo nneething-open-server (server &optional defs)
+ (nnheader-init-server-buffer)
+ (if (nneething-server-opened server)
+ t
+ (unless (assq 'nneething-address defs)
+ (setq defs (append defs (list (list 'nneething-address server)))))
+ (nnoo-change-server 'nneething server defs)))
+
\f
;;; Internal functions.
-(defun nneething-possibly-change-directory (group &optional dir)
- (when group
- (if (and nneething-group
- (string= group nneething-group))
- t
- (let (entry)
- (if (setq entry (assoc group nneething-group-alist))
- (progn
- (setq nneething-group group)
- (setq nneething-directory (nth 1 entry))
- (setq nneething-map (nth 2 entry))
- (setq nneething-active (nth 3 entry)))
- (setq nneething-group group)
- (setq nneething-directory dir)
- (setq nneething-map nil)
- (setq nneething-active (cons 1 0))
- (nneething-create-mapping)
- (push (list group dir nneething-map nneething-active)
- nneething-group-alist))))))
+(defun nneething-possibly-change-directory (group &optional server)
+ (when (and server
+ (not (nneething-server-opened server)))
+ (nneething-open-server server))
+ (when (and group
+ (not (equal nneething-group group)))
+ (setq nneething-group group)
+ (setq nneething-map nil)
+ (setq nneething-active (cons 1 0))
+ (nneething-create-mapping)))
(defun nneething-map-file ()
- ;; We make sure that the .nneething directory exists.
- (unless (file-exists-p nneething-map-file-directory)
- (make-directory nneething-map-file-directory 'parents))
+ ;; We make sure that the .nneething directory exists.
+ (gnus-make-directory nneething-map-file-directory)
;; We store it in a special directory under the user's home dir.
(concat (file-name-as-directory nneething-map-file-directory)
nneething-group nneething-map-file))
(defun nneething-create-mapping ()
;; Read nneething-active and nneething-map.
- (let ((map-file (nneething-map-file))
- (files (directory-files nneething-directory))
- touched map-files)
- (if (file-exists-p map-file)
- (condition-case nil
- (load map-file nil t t)
- (error nil)))
- (or nneething-active (setq nneething-active (cons 1 0)))
- ;; Old nneething had a different map format.
- (when (and (cdar nneething-map)
- (atom (cdar nneething-map)))
- (setq nneething-map
- (mapcar (lambda (n)
- (list (cdr n) (car n)
- (nth 5 (file-attributes
- (nneething-file-name (car n))))))
- nneething-map)))
- ;; Remove files matching the exclusion regexp.
- (when nneething-exclude-files
- (let ((f files)
+ (when (file-exists-p nneething-address)
+ (let ((map-file (nneething-map-file))
+ (files (directory-files nneething-address))
+ touched map-files)
+ (when (file-exists-p map-file)
+ (ignore-errors
+ (load map-file nil t t)))
+ (unless nneething-active
+ (setq nneething-active (cons 1 0)))
+ ;; Old nneething had a different map format.
+ (when (and (cdar nneething-map)
+ (atom (cdar nneething-map)))
+ (setq nneething-map
+ (mapcar (lambda (n)
+ (list (cdr n) (car n)
+ (nth 5 (file-attributes
+ (nneething-file-name (car n))))))
+ nneething-map)))
+ ;; Remove files matching the exclusion regexp.
+ (when nneething-exclude-files
+ (let ((f files)
+ prev)
+ (while f
+ (if (string-match nneething-exclude-files (car f))
+ (if prev (setcdr prev (cdr f))
+ (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)
- (while f
- (if (string-match nneething-exclude-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)
- (while map
- (if (and (member (cadar map) files)
- ;; We also remove files that have changed mod times.
- (equal (nth 5 (file-attributes
- (nneething-file-name (cadar map))))
- (caddar map)))
- (progn
- (push (cadar map) map-files)
- (setq prev map))
+ (while map
+ (if (and (member (cadr (car map)) files)
+ ;; We also remove files that have changed mod times.
+ (equal (nth 5 (file-attributes
+ (nneething-file-name (cadr (car map)))))
+ (cadr (cdar map))))
+ (progn
+ (push (cadr (car map)) map-files)
+ (setq prev map))
+ (setq touched t)
+ (if prev
+ (setcdr prev (cdr map))
+ (setq nneething-map (cdr nneething-map))))
+ (setq map (cdr map))))
+ ;; Find all new files and enter them into the map.
+ (while files
+ (unless (member (car files) map-files)
+ ;; This file is not in the map, so we enter it.
(setq touched t)
- (if prev
- (setcdr prev (cdr map))
- (setq nneething-map (cdr nneething-map))))
- (setq map (cdr map))))
- ;; Find all new files and enter them into the map.
- (while files
- (unless (member (car files) map-files)
- ;; This file is not in the map, so we enter it.
- (setq touched t)
- (setcdr nneething-active (1+ (cdr nneething-active)))
- (push (list (cdr nneething-active) (car files)
- (nth 5 (file-attributes
- (nneething-file-name (car files)))))
- nneething-map))
- (setq files (cdr files)))
- (when (and touched
- (not nneething-read-only))
- (save-excursion
- (nnheader-set-temp-buffer " *nneething map*")
- (insert "(setq nneething-map '" (prin1-to-string nneething-map) ")\n"
- "(setq nneething-active '" (prin1-to-string nneething-active)
- ")\n")
- (write-region (point-min) (point-max) map-file nil 'nomesg)
- (kill-buffer (current-buffer))))))
+ (setcdr nneething-active (1+ (cdr nneething-active)))
+ (push (list (cdr nneething-active) (car files)
+ (nth 5 (file-attributes
+ (nneething-file-name (car files)))))
+ nneething-map))
+ (setq files (cdr files)))
+ (when (and touched
+ (not nneething-read-only))
+ (with-temp-file map-file
+ (insert "(setq nneething-map '")
+ (gnus-prin1 nneething-map)
+ (insert ")\n(setq nneething-active '")
+ (gnus-prin1 nneething-active)
+ (insert ")\n"))))))
(defun nneething-insert-head (file)
"Insert the head of FILE."
(defun nneething-make-head (file &optional buffer)
"Create a head by looking at the file attributes of FILE."
(let ((atts (file-attributes file)))
- (insert
+ (insert
"Subject: " (file-name-nondirectory file) "\n"
- "Message-ID: <nneething-"
+ "Message-ID: <nneething-"
(int-to-string (incf nneething-message-id-number))
"@" (system-name) ">\n"
(if (equal '(0 0) (nth 5 atts)) ""
(concat "Date: " (current-time-string (nth 5 atts)) "\n"))
- (or (if buffer
- (save-excursion
- (set-buffer buffer)
- (if (re-search-forward "<[a-zA-Z0-9_]@[-a-zA-Z0-9_]>" 1000 t)
- (concat "From: " (match-string 0) "\n"))))
+ (or (when buffer
+ (save-excursion
+ (set-buffer buffer)
+ (when (re-search-forward "<[a-zA-Z0-9_]@[-a-zA-Z0-9_]>" 1000 t)
+ (concat "From: " (match-string 0) "\n"))))
(nneething-from-line (nth 2 atts) file))
(if (> (string-to-int (int-to-string (nth 7 atts))) 0)
(concat "Chars: " (int-to-string (nth 7 atts)) "\n")
"")
- (if buffer
+ (if buffer
(save-excursion
(set-buffer buffer)
- (concat "Lines: " (int-to-string
- (count-lines (point-min) (point-max))) "\n"))
- "")
- )))
+ (concat "Lines: " (int-to-string
+ (count-lines (point-min) (point-max)))
+ "\n"))
+ ""))))
(defun nneething-from-line (uid &optional file)
"Return a From header based of UID."
- (let* ((login (condition-case nil
+ (let* ((login (condition-case nil
(user-login-name uid)
- (error
+ (error
(cond ((= uid (user-uid)) (user-login-name))
((zerop uid) "root")
(t (int-to-string uid))))))
- (name (condition-case nil
+ (name (condition-case nil
(user-full-name uid)
- (error
+ (error
(cond ((= uid (user-uid)) (user-full-name))
((zerop uid) "Ms. Root")))))
(host (if (string-match "\\`/[^/@]*@\\([^:/]+\\):" file)
(prog1
- (substring file
- (match-beginning 1)
+ (substring file
+ (match-beginning 1)
(match-end 1))
- (if (string-match "/\\(users\\|home\\)/\\([^/]+\\)/" file)
- (setq login (substring file
- (match-beginning 2)
- (match-end 2))
- name nil)))
+ (when (string-match
+ "/\\(users\\|home\\)/\\([^/]+\\)/" file)
+ (setq login (substring file
+ (match-beginning 2)
+ (match-end 2))
+ name nil)))
(system-name))))
- (concat "From: " login "@" host
+ (concat "From: " login "@" host
(if name (concat " (" name ")") "") "\n")))
(defun nneething-get-head (file)
(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
+ (cond
((not (file-exists-p file))
- ;; The file do not exist.
+ ;; The file do not exist.
nil)
((or (file-directory-p file)
(file-symlink-p file))
;; It's a dir, so we fudge a head.
(nneething-make-head file) t)
- (t
+ (t
;; We examine the file.
(nnheader-insert-head file)
(if (nnheader-article-p)
- (delete-region
+ (delete-region
(progn
(goto-char (point-min))
(or (and (search-forward "\n\n" nil t)
(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)))
+ (expand-file-name fname dir)
+ (make-temp-name (expand-file-name "nneething" dir)))
+ (expand-file-name article dir))))
(provide 'nneething)
projects / gnus / blobdiff