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           num seen gmark
 121           (i 0)
 122           (len (length numlist)))
 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 message-id (elmo-msgdb-overview-entity-get-id entity))
 135           (setq number-alist
 136                 (elmo-msgdb-number-add number-alist
 137                                        num
 138                                        message-id))
 139           (setq seen (member message-id seen-list))
 140           (if (setq gmark (or (elmo-msgdb-global-mark-get message-id)
 141                               (if (elmo-cache-exists-p message-id) ; XXX
 142                                   (if seen
 143                                       nil
 144                                     already-mark)
 145                                 (if seen
 146                                     nil ;;seen-mark
 147                                   new-mark))))
 148               (setq mark-alist
 149                     (elmo-msgdb-mark-append
 150                      mark-alist
 151                      num
 152                      gmark))))
 153         (when (> len elmo-display-progress-threshold)
 154           (setq i (1+ i))
 155           (elmo-display-progress
 156            'elmo-localdir-msgdb-create-as-numlist "Creating msgdb..."
 157            (/ (* i 100) len)))
 158         (setq numlist (cdr numlist)))
 159       (message "Creating msgdb...done.")
 160       (list overview number-alist mark-alist))))
 161
 162 (defalias 'elmo-localdir-msgdb-create 'elmo-localdir-msgdb-create-as-numlist)
 163
 164 (defvar elmo-localdir-list-folders-spec-string "+")
 165 (defvar elmo-localdir-list-folders-filter-regexp "^\\(\\.\\.?\\|[0-9]+\\)$")
 166
 167 (defun elmo-localdir-list-folders (spec &optional hierarchy)
 168   (let ((folder (concat elmo-localdir-list-folders-spec-string (nth 1 spec))))
 169     (elmo-localdir-list-folders-subr folder hierarchy)))
 170
 171 (defun elmo-localdir-list-folders-subr (folder &optional hierarchy)
 172   (let ((case-fold-search t)
 173         folders curdir dirent relpath abspath attr
 174         subprefix subfolder)
 175     (condition-case ()
 176         (progn
 177           (setq curdir
 178                 (expand-file-name (nth 1 (elmo-folder-get-spec folder))
 179                                   elmo-localdir-folder-path))
 180           (if (string-match "^[+=$.]$" folder) ; localdir, archive, localnews
 181               (setq subprefix folder)
 182             (setq subprefix (concat folder elmo-path-sep))
 183             ;; include parent
 184             (setq folders (list folder)))
 185           (setq dirent (directory-files curdir))
 186           (catch 'done
 187            (while dirent
 188             (setq relpath (car dirent))
 189             (setq dirent (cdr dirent))
 190             (setq abspath (expand-file-name relpath curdir))
 191             (and
 192              (not (string-match
 193                    elmo-localdir-list-folders-filter-regexp
 194                    relpath))
 195              (eq (nth 0 (setq attr (file-attributes abspath))) t)
 196              (if (eq hierarchy 'check)
 197                  (throw 'done (nconc folders t))
 198                t)
 199              (setq subfolder (concat subprefix relpath))
 200              (setq folders (nconc folders
 201                                   (if (and hierarchy
 202                                            (if elmo-have-link-count
 203                                                (< 2 (nth 1 attr))
 204                                              (cdr
 205                                               (elmo-localdir-list-folders-subr
 206                                                subfolder 'check))))
 207                                       (list (list subfolder))
 208                                     (list subfolder))))
 209              (or
 210               hierarchy
 211               (and elmo-have-link-count (>= 2 (nth 1 attr)))
 212               (setq folders
 213                     (nconc folders (cdr (elmo-localdir-list-folders-subr
 214                                          subfolder hierarchy))))))))
 215           folders)
 216       (file-error folders))))
 217
 218 (defsubst elmo-localdir-list-folder-subr (spec &optional nonsort)
 219   (let* ((dir (elmo-localdir-get-folder-directory spec))
 220          (flist (mapcar 'string-to-int
 221                         (directory-files dir nil "^[0-9]+$" t)))
 222          (killed (and elmo-use-killed-list
 223                       (elmo-msgdb-killed-list-load
 224                        (elmo-msgdb-expand-path nil spec))))
 225          numbers)
 226     (if nonsort
 227         (cons (or (elmo-max-of-list flist) 0)
 228               (if killed
 229                   (- (length flist) (length killed))
 230                 (length flist)))
 231       (setq numbers (sort flist '<))
 232       (if killed
 233           (delq nil
 234                 (mapcar (lambda (number)
 235                           (unless (memq number killed) number))
 236                         numbers))
 237         numbers))))
 238
 239 (defun elmo-localdir-append-msg (spec string &optional msg no-see)
 240   (let ((dir (elmo-localdir-get-folder-directory spec))
 241         (tmp-buffer (get-buffer-create " *ELMO Temp buffer*"))
 242         (next-num (or msg
 243                       (1+ (car (elmo-localdir-max-of-folder spec)))))
 244         filename)
 245     (save-excursion
 246       (set-buffer tmp-buffer)
 247       (erase-buffer)
 248       (setq filename (expand-file-name (int-to-string
 249                                         next-num)
 250                                        dir))
 251       (unwind-protect
 252           (if (file-writable-p filename)
 253               (progn
 254                 (insert string)
 255                 (as-binary-output-file
 256                  (write-region (point-min) (point-max) filename nil 'no-msg))
 257                 t)
 258             nil
 259             )
 260         (kill-buffer tmp-buffer)))))
 261
 262 (defun elmo-localdir-delete-msg (spec number)
 263   (let (file
 264         (dir (elmo-localdir-get-folder-directory spec))
 265         (number (int-to-string number)))
 266     (setq file (expand-file-name number dir))
 267     (if (and (string-match "[0-9]+" number) ; for safety.
 268              (file-exists-p file)
 269              (file-writable-p file)
 270              (not (file-directory-p file)))
 271         (progn (delete-file file)
 272                t))))
 273
 274 (defun elmo-localdir-read-msg (spec number outbuf &optional set-mark)
 275   (save-excursion
 276     (let* ((number (int-to-string number))
 277            (dir (elmo-localdir-get-folder-directory spec))
 278            (file (expand-file-name number dir)))
 279       (set-buffer outbuf)
 280       (erase-buffer)
 281       (when (file-exists-p file)
 282         (as-binary-input-file (insert-file-contents file))
 283         (elmo-delete-cr-get-content-type)))))
 284
 285 (defun elmo-localdir-delete-msgs (spec msgs)
 286   (mapcar '(lambda (msg) (elmo-localdir-delete-msg spec msg))
 287           msgs))
 288
 289 (defun elmo-localdir-list-folder (spec); called by elmo-localdir-search()
 290   (elmo-localdir-list-folder-subr spec))
 291
 292 (defun elmo-localdir-max-of-folder (spec)
 293   (elmo-localdir-list-folder-subr spec t))
 294
 295 (defun elmo-localdir-check-validity (spec validity-file)
 296   (let* ((dir (elmo-localdir-get-folder-directory spec))
 297          (cur-val (nth 5 (file-attributes dir)))
 298          (file-val (read
 299                     (or (elmo-get-file-string validity-file)
 300                         "nil"))))
 301     (cond
 302      ((or (null cur-val) (null file-val)) nil)
 303      ((> (car cur-val) (car file-val)) nil)
 304      ((= (car cur-val) (car file-val))
 305       (if (> (cadr cur-val) (cadr file-val)) nil t)) ; t if same
 306      (t t))))
 307
 308 (defun elmo-localdir-sync-validity (spec validity-file)
 309   (save-excursion
 310     (let* ((dir (elmo-localdir-get-folder-directory spec))
 311            (tmp-buffer (get-buffer-create " *ELMO TMP*"))
 312            (number-file (expand-file-name elmo-msgdb-number-filename dir)))
 313       (set-buffer tmp-buffer)
 314       (erase-buffer)
 315       (prin1 (nth 5 (file-attributes dir)) tmp-buffer)
 316       (princ "\n" tmp-buffer)
 317       (if (file-writable-p validity-file)
 318           (write-region (point-min) (point-max)
 319                         validity-file nil 'no-msg)
 320         (message (format "%s is not writable." number-file)))
 321       (kill-buffer tmp-buffer))))
 322
 323 (defun elmo-localdir-folder-exists-p (spec)
 324   (file-directory-p (elmo-localdir-get-folder-directory spec)))
 325
 326 (defun elmo-localdir-folder-creatable-p (spec)
 327   t)
 328
 329 (defun elmo-localdir-create-folder (spec)
 330   (save-excursion
 331     (let ((dir (elmo-localdir-get-folder-directory spec)))
 332       (if (file-directory-p dir)
 333           ()
 334         (if (file-exists-p dir)
 335             (error "Create folder failed")
 336           (elmo-make-directory dir))
 337         t
 338         ))))
 339
 340 (defun elmo-localdir-delete-folder (spec)
 341   (let* ((dir (elmo-localdir-get-folder-directory spec)))
 342     (if (not (file-directory-p dir))
 343         (error "no such directory: %s" dir)
 344       (elmo-delete-directory dir t)
 345       t)))
 346
 347 (defun elmo-localdir-rename-folder (old-spec new-spec)
 348   (let* ((old (elmo-localdir-get-folder-directory old-spec))
 349          (new (elmo-localdir-get-folder-directory new-spec))
 350          (new-dir (directory-file-name (file-name-directory new))))
 351     (if (not (file-directory-p old))
 352         (error "no such directory: %s" old)
 353       (if (file-exists-p new)
 354           (error "already exists directory: %s" new)
 355         (if (not (file-exists-p new-dir))
 356             (elmo-make-directory new-dir))
 357         (rename-file old new)
 358         t))))
 359
 360 (defsubst elmo-localdir-field-condition-match (spec condition
 361                                                     number number-list)
 362   (elmo-file-field-condition-match
 363    (expand-file-name (int-to-string number)
 364                      (elmo-localdir-get-folder-directory spec))
 365    condition
 366    number number-list))
 367
 368 (defun elmo-localdir-search (spec condition &optional from-msgs)
 369   (let* ((msgs (or from-msgs (elmo-localdir-list-folder spec)))
 370          (num (length msgs))
 371          (i 0) case-fold-search ret-val)
 372     (while msgs
 373       (if (elmo-localdir-field-condition-match spec condition
 374                                                (car msgs) msgs)
 375           (setq ret-val (cons (car msgs) ret-val)))
 376       (when (> num elmo-display-progress-threshold)
 377         (setq i (1+ i))
 378         (elmo-display-progress
 379          'elmo-localdir-search "Searching..."
 380          (/ (* i 100) num)))
 381       (setq msgs (cdr msgs)))
 382     (nreverse ret-val)))
 383
 384 ;;; (localdir, maildir, localnews) -> localdir
 385 (defun elmo-localdir-copy-msgs (dst-spec msgs src-spec
 386                                          &optional loc-alist same-number)
 387   (let ((dst-dir
 388          (elmo-localdir-get-folder-directory dst-spec))
 389         (next-num (1+ (car (elmo-localdir-max-of-folder dst-spec)))))
 390     (while msgs
 391       (elmo-copy-file
 392        ;; src file
 393        (elmo-call-func src-spec "get-msg-filename" (car msgs) loc-alist)
 394        ;; dst file
 395        (expand-file-name (int-to-string
 396                           (if same-number (car msgs) next-num))
 397                          dst-dir))
 398       (if (and (setq msgs (cdr msgs))
 399                (not same-number))
 400           (setq next-num
 401                 (if (and (eq (car dst-spec) 'localdir)
 402                          (elmo-localdir-locked-p))
 403                     ;; MDA is running.
 404                     (1+ (car (elmo-localdir-max-of-folder dst-spec)))
 405                   (1+ next-num)))))
 406     t))
 407
 408 (defun elmo-localdir-pack-number (spec msgdb arg)
 409   (let ((dir (elmo-localdir-get-folder-directory spec))
 410         (onum-alist (elmo-msgdb-get-number-alist msgdb))
 411         (omark-alist (elmo-msgdb-get-mark-alist msgdb))
 412         (new-number 1)                  ; first ordinal position in localdir
 413         flist onum mark new-mark-alist total)
 414     (setq flist
 415           (if elmo-pack-number-check-strict
 416               (elmo-call-func spec "list-folder") ; allow localnews
 417             (mapcar 'car onum-alist)))
 418     (setq total (length flist))
 419     (while flist
 420       (when (> total elmo-display-progress-threshold)
 421         (elmo-display-progress
 422          'elmo-localdir-pack-number "Packing..."
 423          (/ (* new-number 100) total)))
 424       (setq onum (car flist))
 425       (when (not (eq onum new-number))          ; why \=() is wrong..
 426         (elmo-bind-directory
 427          dir
 428          ;; xxx  nfs,hardlink
 429          (rename-file (int-to-string onum) (int-to-string new-number) t))
 430         ;; update overview
 431         (elmo-msgdb-overview-entity-set-number
 432          (elmo-msgdb-overview-get-entity onum msgdb)
 433          new-number)
 434         ;; update number-alist
 435         (setcar (assq onum onum-alist) new-number))
 436       ;; update mark-alist
 437       (when (setq mark (cadr (assq onum omark-alist)))
 438         (setq new-mark-alist
 439               (elmo-msgdb-mark-append
 440                new-mark-alist
 441                new-number mark)))
 442       (setq new-number (1+ new-number))
 443       (setq flist (cdr flist)))
 444     (message "Packing...done.")
 445     (list (elmo-msgdb-get-overview msgdb)
 446           onum-alist
 447           new-mark-alist
 448           (elmo-msgdb-get-location msgdb)
 449           ;; remake hash table
 450           (elmo-msgdb-make-overview-hashtb (elmo-msgdb-get-overview msgdb)))))
 451
 452 (defun elmo-localdir-use-cache-p (spec number)
 453   nil)
 454
 455 (defun elmo-localdir-local-file-p (spec number)
 456   t)
 457
 458 (defun elmo-localdir-get-msg-filename (spec number &optional loc-alist)
 459   (expand-file-name
 460    (int-to-string number)
 461    (elmo-localdir-get-folder-directory spec)))
 462
 463 (defun elmo-localdir-locked-p ()
 464   (if elmo-localdir-lockfile-list
 465       (let ((lock elmo-localdir-lockfile-list))
 466         (catch 'found
 467           (while lock
 468             (if (file-exists-p (car lock))
 469                 (throw 'found t))
 470             (setq lock (cdr lock)))))))
 471
 472 (defalias 'elmo-localdir-sync-number-alist
 473   'elmo-generic-sync-number-alist)
 474 (defalias 'elmo-localdir-list-folder-unread
 475   'elmo-generic-list-folder-unread)
 476 (defalias 'elmo-localdir-list-folder-important
 477   'elmo-generic-list-folder-important)
 478 (defalias 'elmo-localdir-commit 'elmo-generic-commit)
 479
 480 (provide 'elmo-localdir)
 481
 482 ;;; elmo-localdir.el ends here