elmo/elmo-localdir.el

   1 ;;; elmo-localdir.el -- Localdir Interface for ELMO.
   2
   3 ;; Copyright 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
   4
   5 ;; Author: Yuuichi Teranishi <teranisi@gohome.org>
   6 ;; Keywords: mail, net news
   7 ;; Time-stamp: <2000-05-18 17:12:55 teranisi>
   8
   9 ;; This file is part of ELMO (Elisp Library for Message Orchestration).
  10
  11 ;; This program is free software; you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation; either version 2, or (at your option)
  14 ;; any later version.
  15 ;;
  16 ;; This program is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20 ;;
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  24 ;; Boston, MA 02111-1307, USA.
  25 ;;
  26
  27 ;;; Commentary:
  28 ;;
  29
  30 ;;; Code:
  31 ;;
  32
  33 (require 'emu)
  34 (require 'std11)
  35
  36 (eval-when-compile
  37   (require 'elmo-cache))
  38 (require 'elmo-msgdb)
  39
  40 (defsubst elmo-localdir-get-folder-directory (spec)
  41   (if (file-name-absolute-p (nth 1 spec))
  42       (nth 1 spec) ; already full path.
  43     (expand-file-name (nth 1 spec)
  44                       (cond ((eq (car spec) 'localnews)
  45                              elmo-localnews-folder-path)
  46                             (t
  47                              elmo-localdir-folder-path)))))
  48
  49 (defun elmo-localdir-msgdb-expand-path (spec)
  50   (let ((fld-name (nth 1 spec)))
  51     (expand-file-name fld-name
  52                       (expand-file-name "localdir"
  53                                         elmo-msgdb-dir))))
  54
  55 (defun elmo-localdir-number-to-filename (spec dir number &optional loc-alist)
  56   (expand-file-name (int-to-string number) dir))
  57
  58 (if (boundp 'nemacs-version)
  59     (defsubst elmo-localdir-insert-header (file)
  60       "Insert the header of the article (Does not work on nemacs)."
  61       (as-binary-input-file
  62        (insert-file-contents file)))
  63   (defsubst elmo-localdir-insert-header (file)
  64     "Insert the header of the article."
  65     (let ((beg 0)
  66           insert-file-contents-pre-hook   ; To avoid autoconv-xmas...
  67           insert-file-contents-post-hook
  68           format-alist)
  69       (when (file-exists-p file)
  70         ;; Read until header separator is found.
  71         (while (and (eq elmo-localdir-header-chop-length
  72                         (nth 1
  73                              (as-binary-input-file
  74                               (insert-file-contents
  75                                file nil beg
  76                                (incf beg elmo-localdir-header-chop-length)))))
  77                     (prog1 (not (search-forward "\n\n" nil t))
  78                       (goto-char (point-max)))))))))
  79
  80
  81 (defsubst elmo-localdir-msgdb-create-overview-entity-from-file (number file)
  82   (save-excursion
  83     (let ((tmp-buffer (get-buffer-create " *ELMO LocalDir Temp*"))
  84           insert-file-contents-pre-hook   ; To avoid autoconv-xmas...
  85           insert-file-contents-post-hook header-end
  86           (attrib (file-attributes file))
  87           ret-val size mtime)
  88       (set-buffer tmp-buffer)
  89       (erase-buffer)
  90       (if (not (file-exists-p file))
  91           ()
  92         (setq size (nth 7 attrib))
  93         (setq mtime (timezone-make-date-arpa-standard
  94                      (current-time-string (nth 5 attrib)) (current-time-zone)))
  95         ;; insert header from file.
  96         (catch 'done
  97           (condition-case nil
  98               (elmo-localdir-insert-header file)
  99             (error (throw 'done nil)))
 100           (goto-char (point-min))
 101           (setq header-end
 102                 (if (re-search-forward "\\(^--.*$\\)\\|\\(\n\n\\)" nil t)
 103                     (point)
 104                   (point-max)))
 105           (narrow-to-region (point-min) header-end)
 106           (setq ret-val (elmo-msgdb-create-overview-from-buffer number size mtime))
 107           (kill-buffer tmp-buffer))
 108         ret-val
 109         ))))
 110
 111 (defun elmo-localdir-msgdb-create-entity (dir number)
 112   (elmo-localdir-msgdb-create-overview-entity-from-file
 113    number (expand-file-name (int-to-string number) dir)))
 114
 115 (defun elmo-localdir-msgdb-create-as-numlist (spec numlist new-mark
 116                                                    already-mark seen-mark
 117                                                    important-mark seen-list)
 118   (when numlist
 119     (let ((dir (elmo-localdir-get-folder-directory spec))
 120           overview number-alist mark-alist entity message-id
 121           i percent len num seen gmark)
 122       (setq len (length numlist))
 123       (setq i 0)
 124       (message "Creating msgdb...")
 125       (while numlist
 126         (setq entity
 127               (elmo-localdir-msgdb-create-entity
 128                dir (car numlist)))
 129         (if (null entity)
 130             ()
 131           (setq num (elmo-msgdb-overview-entity-get-number entity))
 132           (setq overview
 133                 (elmo-msgdb-append-element
 134                  overview entity))
 135           (setq number-alist
 136                 (elmo-msgdb-number-add number-alist
 137                                        num
 138                                        (elmo-msgdb-overview-entity-get-id
 139                                         entity)))
 140           (setq message-id (elmo-msgdb-overview-entity-get-id entity))
 141           (setq seen (member message-id seen-list))
 142           (if (setq gmark (or (elmo-msgdb-global-mark-get message-id)
 143                               (if (elmo-cache-exists-p message-id) ; XXX
 144                                   (if seen
 145                                       nil
 146                                     already-mark)
 147                                 (if seen
 148                                     nil ;;seen-mark
 149                                   new-mark))))
 150               (setq mark-alist
 151                     (elmo-msgdb-mark-append
 152                      mark-alist
 153                      num
 154                      gmark))))
 155         (setq i (1+ i))
 156         (setq percent (/ (* i 100) len))
 157         (elmo-display-progress
 158          'elmo-localdir-msgdb-create-as-numlist "Creating msgdb..."
 159          percent)
 160         (setq numlist (cdr numlist)))
 161       (message "Creating msgdb...done.")
 162       (list overview number-alist mark-alist))))
 163
 164 (defalias 'elmo-localdir-msgdb-create 'elmo-localdir-msgdb-create-as-numlist)
 165
 166 (defvar elmo-localdir-list-folders-spec-string "+")
 167 (defvar elmo-localdir-list-folders-filter-regexp "^\\(\\.\\.?\\|[0-9]+\\)$")
 168
 169 (defun elmo-localdir-list-folders (spec &optional hierarchy)
 170   (let ((folder (concat elmo-localdir-list-folders-spec-string (nth 1 spec))))
 171     (elmo-localdir-list-folders-subr folder hierarchy)))
 172
 173 (defun elmo-localdir-list-folders-subr (folder &optional hierarchy)
 174   (let ((case-fold-search t)
 175         folders curdir dirent relpath abspath attr
 176         subprefix subfolder)
 177     (condition-case ()
 178         (progn
 179           (setq curdir
 180                 (expand-file-name (nth 1 (elmo-folder-get-spec folder))
 181                                   elmo-localdir-folder-path))
 182           (if (string-match "^[+=$.]$" folder) ; localdir, archive, localnews
 183               (setq subprefix folder)
 184             (setq subprefix (concat folder elmo-path-sep))
 185             ;; include parent
 186             (setq folders (list folder)))
 187           (setq dirent (directory-files curdir))
 188           (catch 'done
 189            (while dirent
 190             (setq relpath (car dirent))
 191             (setq dirent (cdr dirent))
 192             (setq abspath (expand-file-name relpath curdir))
 193             (and
 194              (not (string-match
 195                    elmo-localdir-list-folders-filter-regexp
 196                    relpath))
 197              (eq (nth 0 (setq attr (file-attributes abspath))) t)
 198              (if (eq hierarchy 'check)
 199                  (throw 'done (nconc folders t))
 200                t)
 201              (setq subfolder (concat subprefix relpath))
 202              (setq folders (nconc folders
 203                                   (if (and hierarchy
 204                                            (if elmo-have-link-count
 205                                                (< 2 (nth 1 attr))
 206                                              (cdr
 207                                               (elmo-localdir-list-folders-subr
 208                                                subfolder 'check))))
 209                                       (list (list subfolder))
 210                                     (list subfolder))))
 211              (or
 212               hierarchy
 213               (and elmo-have-link-count (>= 2 (nth 1 attr)))
 214               (setq folders
 215                     (nconc folders (cdr (elmo-localdir-list-folders-subr
 216                                          subfolder hierarchy))))))))
 217           folders)
 218       (file-error folders))))
 219
 220 (defsubst elmo-localdir-list-folder-subr (spec &optional nonsort)
 221   (let* ((dir (elmo-localdir-get-folder-directory spec))
 222          (flist (mapcar 'string-to-int
 223                         (directory-files dir nil "^[0-9]+$" t))))
 224     (if nonsort
 225         (cons (or (elmo-max-of-list flist) 0) (length flist))
 226       (sort flist '<))))
 227
 228 (defun elmo-localdir-append-msg (spec string &optional msg no-see)
 229   (let ((dir (elmo-localdir-get-folder-directory spec))
 230         (tmp-buffer (get-buffer-create " *ELMO Temp buffer*"))
 231         (next-num (or msg
 232                       (1+ (car (elmo-localdir-list-folder-subr spec t)))))
 233         filename)
 234     (save-excursion
 235       (set-buffer tmp-buffer)
 236       (erase-buffer)
 237       (setq filename (expand-file-name (int-to-string
 238                                         next-num)
 239                                        dir))
 240       (unwind-protect
 241           (if (file-writable-p filename)
 242               (progn
 243                 (insert string)
 244                 (as-binary-output-file
 245                  (write-region (point-min) (point-max) filename nil 'no-msg))
 246                 t)
 247             nil
 248             )
 249         (kill-buffer tmp-buffer)))))
 250
 251 (defun elmo-localdir-delete-msg (spec number)
 252   (let (file
 253         (dir (elmo-localdir-get-folder-directory spec))
 254         (number (int-to-string number)))
 255     (setq file (expand-file-name number dir))
 256     (if (and (string-match "[0-9]+" number) ; for safety.
 257              (file-exists-p file)
 258              (file-writable-p file)
 259              (not (file-directory-p file)))
 260         (progn (delete-file file)
 261                t))))
 262
 263 (defun elmo-localdir-read-msg (spec number outbuf &optional set-mark)
 264   (save-excursion
 265     (let* ((number (int-to-string number))
 266            (dir (elmo-localdir-get-folder-directory spec))
 267            (file (expand-file-name number dir)))
 268       (set-buffer outbuf)
 269       (erase-buffer)
 270       (when (file-exists-p file)
 271         (as-binary-input-file (insert-file-contents file))
 272         (elmo-delete-cr-get-content-type)))))
 273
 274 (defun elmo-localdir-delete-msgs (spec msgs)
 275   (mapcar '(lambda (msg) (elmo-localdir-delete-msg spec msg))
 276           msgs))
 277
 278 (defun elmo-localdir-list-folder (spec); called by elmo-localdir-search()
 279   (elmo-localdir-list-folder-subr spec))
 280
 281 (defun elmo-localdir-max-of-folder (spec)
 282   (elmo-localdir-list-folder-subr spec t))
 283
 284 (defun elmo-localdir-check-validity (spec validity-file)
 285   (let* ((dir (elmo-localdir-get-folder-directory spec))
 286          (cur-val (nth 5 (file-attributes dir)))
 287          (file-val (read
 288                     (or (elmo-get-file-string validity-file)
 289                         "nil"))))
 290     (cond
 291      ((or (null cur-val) (null file-val)) nil)
 292      ((> (car cur-val) (car file-val)) nil)
 293      ((= (car cur-val) (car file-val))
 294       (if (> (cadr cur-val) (cadr file-val)) nil t)) ; t if same
 295      (t t))))
 296
 297 (defun elmo-localdir-sync-validity (spec validity-file)
 298   (save-excursion
 299     (let* ((dir (elmo-localdir-get-folder-directory spec))
 300            (tmp-buffer (get-buffer-create " *ELMO TMP*"))
 301            (number-file (expand-file-name elmo-msgdb-number-filename dir)))
 302       (set-buffer tmp-buffer)
 303       (erase-buffer)
 304       (prin1 (nth 5 (file-attributes dir)) tmp-buffer)
 305       (princ "\n" tmp-buffer)
 306       (if (file-writable-p validity-file)
 307           (write-region (point-min) (point-max)
 308                         validity-file nil 'no-msg)
 309         (message (format "%s is not writable." number-file)))
 310       (kill-buffer tmp-buffer))))
 311
 312 (defun elmo-localdir-folder-exists-p (spec)
 313   (file-directory-p (elmo-localdir-get-folder-directory spec)))
 314
 315 (defun elmo-localdir-folder-creatable-p (spec)
 316   t)
 317
 318 (defun elmo-localdir-create-folder (spec)
 319   (save-excursion
 320     (let ((dir (elmo-localdir-get-folder-directory spec)))
 321       (if (file-directory-p dir)
 322           ()
 323         (if (file-exists-p dir)
 324             (error "Create folder failed")
 325           (elmo-make-directory dir))
 326         t
 327         ))))
 328
 329 (defun elmo-localdir-delete-folder (spec)
 330   (let* ((dir (elmo-localdir-get-folder-directory spec)))
 331     (if (not (file-directory-p dir))
 332         (error "no such directory: %s" dir)
 333       (elmo-delete-directory dir t)
 334       t)))
 335
 336 (defun elmo-localdir-rename-folder (old-spec new-spec)
 337   (let* ((old (elmo-localdir-get-folder-directory old-spec))
 338          (new (elmo-localdir-get-folder-directory new-spec))
 339          (new-dir (directory-file-name (file-name-directory new))))
 340     (if (not (file-directory-p old))
 341         (error "no such directory: %s" old)
 342       (if (file-exists-p new)
 343           (error "already exists directory: %s" new)
 344         (if (not (file-exists-p new-dir))
 345             (elmo-make-directory new-dir))
 346         (rename-file old new)
 347         t))))
 348
 349 (defsubst elmo-localdir-field-condition-match (spec number condition)
 350   (elmo-file-field-condition-match
 351    (expand-file-name (int-to-string number)
 352                      (elmo-localdir-get-folder-directory spec))
 353    condition))
 354
 355 (defun elmo-localdir-search (spec condition &optional from-msgs)
 356   (let* ((msgs (or from-msgs (elmo-localdir-list-folder spec)))
 357          (num (length msgs))
 358          (i 0) case-fold-search ret-val)
 359     (while msgs
 360       (if (elmo-localdir-field-condition-match spec (car msgs)
 361                                                condition)
 362           (setq ret-val (cons (car msgs) ret-val)))
 363       (setq i (1+ i))
 364       (elmo-display-progress
 365        'elmo-localdir-search "Searching..."
 366        (/ (* i 100) num))
 367       (setq msgs (cdr msgs)))
 368     (nreverse ret-val)))
 369
 370 ;;; (localdir, maildir, localnews) -> localdir
 371 (defun elmo-localdir-copy-msgs (dst-spec msgs src-spec
 372                                          &optional loc-alist same-number)
 373   (let ((dst-dir
 374          (elmo-localdir-get-folder-directory dst-spec))
 375         (next-num (1+ (car (elmo-localdir-list-folder-subr dst-spec t)))))
 376     (while msgs
 377       (elmo-copy-file
 378        ;; src file
 379        (elmo-call-func src-spec "get-msg-filename" (car msgs) loc-alist)
 380        ;; dst file
 381        (expand-file-name (int-to-string
 382                           (if same-number (car msgs) next-num))
 383                          dst-dir))
 384       (if (and (setq msgs (cdr msgs))
 385                (not same-number))
 386           (setq next-num
 387                 (if (and (eq (car dst-spec) 'localdir)
 388                          (elmo-localdir-locked-p))
 389                     ;; MDA is running.
 390                     (1+ (car (elmo-localdir-list-folder-subr dst-spec t)))
 391                   (1+ next-num)))))
 392     t))
 393
 394 (defun elmo-localdir-pack-number (spec msgdb arg)
 395   (let ((dir (elmo-localdir-get-folder-directory spec))
 396         (onum-alist (elmo-msgdb-get-number-alist msgdb))
 397         (omark-alist (elmo-msgdb-get-mark-alist msgdb))
 398         (oov (elmo-msgdb-get-overview msgdb))
 399         i flist onum mark new-mark-alist total)
 400     (setq flist
 401           (if elmo-pack-number-check-strict
 402               (elmo-call-func spec "list-folder") ;; allow localnews
 403             (mapcar 'car onum-alist)))
 404     (setq total (length flist))
 405     (while flist
 406       (elmo-display-progress
 407        'elmo-localdir-pack-number "Packing..."
 408        (/ (* i 100) total))
 409       (setq onum (car flist))
 410       (when (not (eq onum i)) ;; why \=() is wrong..
 411         (elmo-bind-directory
 412          dir
 413          ;; xxx  nfs,hardlink
 414          (rename-file (int-to-string onum) (int-to-string i) t))
 415         ;; update overview
 416         (elmo-msgdb-overview-entity-set-number
 417          (elmo-msgdb-overview-get-entity-by-number
 418           oov onum) i)
 419         ;; update number-alist
 420         (setcar (assq onum onum-alist) i))
 421       ;; update mark-alist
 422       (when (setq mark (cadr (assq onum omark-alist)))
 423         (setq new-mark-alist
 424               (elmo-msgdb-mark-append
 425                new-mark-alist
 426                i mark)))
 427       (setq i (1+ i))
 428       (setq flist (cdr flist)))
 429     (message "Packing...done.")
 430     (list (elmo-msgdb-get-overview msgdb)
 431           onum-alist
 432           new-mark-alist
 433           (elmo-msgdb-get-location msgdb))))
 434
 435 (defun elmo-localdir-use-cache-p (spec number)
 436   nil)
 437
 438 (defun elmo-localdir-local-file-p (spec number)
 439   t)
 440
 441 (defun elmo-localdir-get-msg-filename (spec number &optional loc-alist)
 442   (expand-file-name
 443    (int-to-string number)
 444    (elmo-localdir-get-folder-directory spec)))
 445
 446 (defun elmo-localdir-locked-p ()
 447   (if elmo-localdir-lockfile-list
 448       (let ((lock elmo-localdir-lockfile-list))
 449         (catch 'found
 450           (while lock
 451             (if (file-exists-p (car lock))
 452                 (throw 'found t))
 453             (setq lock (cdr lock)))))))
 454
 455 (defalias 'elmo-localdir-sync-number-alist
 456   'elmo-generic-sync-number-alist)
 457 (defalias 'elmo-localdir-list-folder-unread
 458   'elmo-generic-list-folder-unread)
 459 (defalias 'elmo-localdir-list-folder-important
 460   'elmo-generic-list-folder-important)
 461 (defalias 'elmo-localdir-commit 'elmo-generic-commit)
 462
 463 (provide 'elmo-localdir)
 464
 465 ;;; elmo-localdir.el ends here