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