;;; nneething.el --- random file access for Gnus
-;; Copyright (C) 1995 Free Software Foundation, Inc.
+;; Copyright (C) 1995,96 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
(require 'nnheader)
(require 'nnmail)
+(eval-when-compile (require 'cl))
(defvar nneething-map-file-directory "~/.nneething/"
"*Map files directory.")
-(defvar nneething-exclude-files "~$"
- "*Regexp saying what files to exclude from the group.")
+(defvar nneething-exclude-files nil
+ "*Regexp saying what files to exclude from the group.
+If this variable is nil, no files will be excluded.")
(defvar nneething-map-file ".nneething"
"*Name of map files.")
\f
-(defconst nneething-version "nneething 0.1"
+(defconst nneething-version "nneething 1.0"
"nneething version.")
(defvar nneething-current-directory nil
(defvar nneething-read-only nil)
(defvar nneething-active nil)
(defvar nneething-server-variables
- (list
- (list 'nneething-directory nneething-directory)
- '(nneething-current-directory nil)
- '(nneething-status-string "")
- '(nneething-group-alist)))
+ `((nneething-directory ,nneething-directory)
+ (nneething-current-directory nil)
+ (nneething-status-string "")
+ (nneething-group-alist)))
\f
;;; Interface functions.
-(defun nneething-retrieve-headers (sequence &optional newsgroup server)
+(defun nneething-retrieve-headers (sequence &optional newsgroup server fetch-old)
(nneething-possibly-change-directory newsgroup)
(save-excursion
(count 0)
(large (and (numberp nnmail-large-newsgroup)
(> number nnmail-large-newsgroup)))
- beg article file)
+ article file)
(if (stringp (car sequence))
'headers
(setq article (car sequence))
(setq file (nneething-file-name article))
- (if (file-exists-p file)
+ (if (and (file-exists-p file)
+ (or (file-directory-p file)
+ (not (zerop (nth 7 (file-attributes file))))))
(progn
(insert (format "221 %d Article retrieved.\n" article))
(nneething-insert-head file)
(defun nneething-request-post (&optional server)
(mail-send-and-exit nil))
-(defalias 'nneething-request-post-buffer 'nnmail-request-post-buffer)
-
(defun nneething-close-group (group &optional server)
t)
nneething-group-alist)))))))
(defun nneething-map-file ()
+ ;; We make sure that the .neething directory exists.
+ (or (file-exists-p nneething-map-file-directory)
+ (make-directory nneething-map-file-directory 'parents))
;; 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
+ ;; Read nneething-active and nneething-map.
(let ((map-file (nneething-map-file))
(files (directory-files nneething-directory))
- (dir (file-name-as-directory nneething-directory))
- touched)
+ 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)))
- ;; Remove files matching that regexp.
- (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 that have disappeared from the map.
+ ;; Old nneething had a different map format.
+ (when (and (cdr (car 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 deleted files from the map.
(let ((map nneething-map)
prev)
(while map
- (if (member (car (car map)) files)
- (setq prev 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))
(setq touched t)
(if prev
(setcdr prev (cdr map))
(setq map (cdr map))))
;; Find all new files and enter them into the map.
(while files
- (or (assoc (car files) nneething-map) ; If already in the map, ignore.
- (progn
- (setq touched t)
- (setcdr nneething-active (1+ (cdr nneething-active)))
- (setq nneething-map
- (cons (cons (car files) (cdr nneething-active)) nneething-map))))
+ (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)))
- (if (or (not touched) nneething-read-only)
- ()
+ (when (and touched
+ (not nneething-read-only))
(save-excursion
- (set-buffer (get-buffer-create " *nneething map*"))
- (buffer-disable-undo (current-buffer))
- (erase-buffer)
+ (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")
(setq case-fold-search nil)
(buffer-disable-undo (current-buffer))
(erase-buffer)
- (if (not (file-exists-p file))
- ()
- (if (or (not (file-regular-p file))
- (progn
- (nnheader-insert-head file)
- (if (nnheader-article-p)
- (progn
- (delete-region (point) (point-max))
- nil))))
- (progn
- (erase-buffer)
- (nneething-make-head file)))
- t)))
-
-(defun nneething-number-to-file (number)
- (car (rassq number nneething-map)))
+ (cond
+ ((not (file-exists-p file))
+ ;; 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
+ ;; We examine the file.
+ (nnheader-insert-head file)
+ (if (nnheader-article-p)
+ (delete-region
+ (progn
+ (goto-char (point-min))
+ (or (and (search-forward "\n\n" nil t)
+ (1- (point)))
+ (point-max)))
+ (point-max))
+ (erase-buffer)
+ (nneething-make-head file))
+ t))))
(defun nneething-file-name (article)
(concat (file-name-as-directory nneething-directory)
- (if (numberp article) (nneething-number-to-file article)
+ (if (numberp article)
+ (cadr (assq article nneething-map))
article)))
(provide 'nneething)
projects / gnus / blobdiff