elmo/elmo-localdir.el

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