elmo/elmo-dop.el

   1 ;;; elmo-dop.el --- Modules for Disconnected Operations on ELMO.
   2
   3 ;; Copyright (C) 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 (eval-when-compile (require 'cl))
  32
  33 (require 'elmo)
  34 (require 'elmo-vars)
  35 (require 'elmo-msgdb)
  36 (require 'elmo-util)
  37 (require 'elmo-localdir)
  38
  39 ;; global variable.
  40 (defvar elmo-dop-queue nil
  41   "A list of (folder-name function-to-be-called argument-list).
  42 Automatically loaded/saved.")
  43
  44 (defmacro elmo-make-dop-queue (fname method arguments)
  45   "Make a dop queue."
  46   `(vector ,fname ,method ,arguments))
  47
  48 (defmacro elmo-dop-queue-fname (queue)
  49   "Return the folder name string of the QUEUE."
  50   `(aref ,queue 0))
  51
  52 (defmacro elmo-dop-queue-method (queue)
  53   "Return the method symbol of the QUEUE."
  54   `(aref ,queue 1))
  55
  56 (defmacro elmo-dop-queue-arguments (queue)
  57   "Return the arguments of the QUEUE."
  58   `(aref ,queue 2))
  59
  60 (defun elmo-dop-queue-append (folder method arguments)
  61   "Append to disconnected operation queue."
  62   (let ((queue (elmo-make-dop-queue (elmo-folder-name-internal folder)
  63                                     method arguments)))
  64     (setq elmo-dop-queue (nconc elmo-dop-queue (list queue)))))
  65
  66 (defvar elmo-dop-queue-merge-method-list
  67   '(elmo-folder-set-read-delayed
  68     elmo-folder-unset-read-delayed
  69     elmo-folder-set-important-delayed
  70     elmo-folder-unset-important-delayed
  71     elmo-folder-set-answered-delayed
  72     elmo-folder-unset-answered-delayed))
  73
  74 (defvar elmo-dop-queue-method-name-alist
  75   '((elmo-folder-append-buffer-dop-delayed . "Append")
  76     (elmo-folder-delete-messages-dop-delayed . "Delete")
  77     (elmo-message-encache . "Encache")
  78     (elmo-folder-create-dop-delayed . "Create")
  79     (elmo-folder-set-read-delayed . "Read")
  80     (elmo-folder-unset-read-delayed . "Unread")
  81     (elmo-folder-set-answered-delayed . "Answered")
  82     (elmo-folder-unset-answered-delayed . "Unanswered")
  83     (elmo-folder-set-important-delayed . "Important")
  84     (elmo-folder-unset-important-delayed . "Unimportant")
  85     (elmo-folder-set-flag . "Set flag")
  86     (elmo-folder-unset-flag . "Unset flag")))
  87
  88 (defmacro elmo-dop-queue-method-name (queue)
  89   `(cdr (assq (elmo-dop-queue-method ,queue)
  90               elmo-dop-queue-method-name-alist)))
  91
  92 (defun elmo-dop-queue-flush ()
  93   "Flush disconnected operations that consern plugged folders."
  94   ;; obsolete
  95   (unless (or (null elmo-dop-queue)
  96               (vectorp (car elmo-dop-queue)))
  97     (if (y-or-n-p "\
  98 Saved queue is old version(2.6).  Clear all pending operations? ")
  99         (progn
 100           (setq elmo-dop-queue nil)
 101           (message "All pending operations are cleared.")
 102           (elmo-dop-queue-save))
 103       (error "Please use 2.6 or earlier")))
 104   (elmo-dop-queue-merge)
 105   (let ((queue-all elmo-dop-queue)
 106         queue
 107         (count 0)
 108         len)
 109     (while queue-all
 110       (if (elmo-folder-plugged-p
 111            (elmo-get-folder (elmo-dop-queue-fname (car queue-all))))
 112           (setq queue (append queue (list (car queue-all)))))
 113       (setq queue-all (cdr queue-all)))
 114     (setq count (length queue))
 115     (when (> count 0)
 116       (if (elmo-y-or-n-p
 117            (format "%d pending operation(s) exists.  Perform now? " count)
 118            (not elmo-dop-flush-confirm) t)
 119           (progn
 120             (message "")
 121             (sit-for 0)
 122             (let ((queue elmo-dop-queue)
 123                   (performed 0)
 124                   (i 0)
 125                   (num (length elmo-dop-queue))
 126                   folder func failure)
 127               (while queue
 128                 ;; now perform pending processes.
 129                 (setq failure nil)
 130                 (setq i (+ 1 i))
 131                 (message "Flushing queue....%d/%d." i num)
 132                 (condition-case err
 133                     (progn
 134                       (apply (elmo-dop-queue-method (car queue))
 135                              (prog1
 136                                  (setq folder
 137                                        (elmo-get-folder
 138                                         (elmo-dop-queue-fname (car queue))))
 139                                (elmo-folder-open folder)
 140                                (unless (elmo-folder-plugged-p folder)
 141                                  (error "Unplugged")))
 142                              (elmo-dop-queue-arguments (car queue)))
 143                       (elmo-folder-close folder))
 144                   (quit  (setq failure t))
 145                   (error (setq failure err)))
 146                 (if failure
 147                     ();
 148                   (setq elmo-dop-queue (delq (car queue) elmo-dop-queue))
 149                   (setq performed (+ 1 performed)))
 150                 (setq queue (cdr queue)))
 151               (message "%d/%d operation(s) are performed successfully."
 152                        performed num)
 153               (sit-for 0) ;
 154               (elmo-dop-queue-save)))
 155         ;; when answer=NO against performing dop
 156         (if (elmo-y-or-n-p "Clear these pending operations? "
 157                            (not elmo-dop-flush-confirm) t)
 158             (progn
 159               (while queue
 160                 (when (eq (elmo-dop-queue-method (car queue))
 161                           'elmo-folder-append-buffer-dop-delayed)
 162                   (elmo-folder-delete-messages
 163                    (elmo-dop-spool-folder
 164                     (elmo-get-folder (elmo-dop-queue-fname (car queue))))
 165                    (list (nth 1 (elmo-dop-queue-arguments (car queue))))))
 166                 (setq elmo-dop-queue (delq (car queue) elmo-dop-queue))
 167                 (setq queue (cdr queue)))
 168               (message "Pending operations are cleared.")
 169               (elmo-dop-queue-save))
 170           (message "")))
 171       count)))
 172
 173 (defun elmo-dop-queue-merge ()
 174   (let ((queue elmo-dop-queue)
 175         new-queue match-queue que)
 176     (while (setq que (car queue))
 177       (if (and
 178            (memq (elmo-dop-queue-method que)
 179                  elmo-dop-queue-merge-method-list)
 180            (setq match-queue
 181                  (car (delete
 182                        nil
 183                        (mapcar
 184                         (lambda (nqueue)
 185                           (if (and
 186                                (string= (elmo-dop-queue-fname que)
 187                                         (elmo-dop-queue-fname nqueue))
 188                                (string= (elmo-dop-queue-method que)
 189                                         (elmo-dop-queue-method nqueue)))
 190                               nqueue))
 191                         new-queue)))))
 192           (setcar (elmo-dop-queue-arguments match-queue)
 193                   (append (car (elmo-dop-queue-arguments match-queue))
 194                           (car (elmo-dop-queue-arguments que))))
 195         (setq new-queue (nconc new-queue (list que))))
 196       (setq queue (cdr queue)) )
 197     (setq elmo-dop-queue new-queue)))
 198
 199 ;;; dop spool folder
 200 (defun elmo-dop-spool-folder (folder)
 201   "Return a spool folder for disconnected operations
 202 which is corresponded to the FOLDER."
 203   (elmo-make-folder
 204    (concat "+" (expand-file-name "spool" (elmo-folder-msgdb-path folder)))
 205    nil
 206    (elmo-folder-mime-charset-internal folder)))
 207
 208 (defun elmo-dop-spool-folder-append-buffer (folder flags)
 209   "Append current buffer content to the dop spool folder.
 210 FOLDER is the folder structure.
 211 Return a message number."
 212   (let ((spool (elmo-dop-spool-folder folder)))
 213     (unless (elmo-folder-exists-p spool)
 214       (elmo-folder-create spool))
 215     (let ((new-number (1+ (car (elmo-folder-status spool)))))
 216       (elmo-folder-append-buffer spool flags new-number)
 217       new-number)))
 218
 219
 220 (defun elmo-dop-spool-folder-list-messages (folder)
 221   "List messages in the dop spool folder.
 222 FOLDER is the folder structure."
 223   (setq folder (elmo-dop-spool-folder folder))
 224   (if (elmo-folder-exists-p folder)
 225       (elmo-folder-list-messages folder)))
 226
 227 (defun elmo-dop-list-deleting-messages (folder)
 228   "List messages which are on the deleting queue for the folder.
 229 FOLDER is the folder structure."
 230   (let (messages)
 231     (dolist (queue elmo-dop-queue)
 232       (if (and (string= (elmo-dop-queue-fname queue)
 233                         (elmo-folder-name-internal folder))
 234                (eq (elmo-dop-queue-method queue)
 235                    'elmo-folder-delete-messages-dop-delayed))
 236           (setq messages (nconc messages
 237                                 (mapcar
 238                                  'car
 239                                  (car (elmo-dop-queue-arguments queue)))))))))
 240
 241 (defun elmo-dop-filter-pending-messages (numbers)
 242   (elmo-delete-if (lambda (number) (< number 0)) numbers))
 243
 244 ;;; DOP operations.
 245 (defsubst elmo-folder-append-buffer-dop (folder &optional flag number)
 246   (elmo-dop-queue-append
 247    folder 'elmo-folder-append-buffer-dop-delayed
 248    (list flag
 249          (elmo-dop-spool-folder-append-buffer folder flag)
 250          number)))
 251
 252 (defsubst elmo-folder-delete-messages-dop (folder numbers)
 253   (let ((spool-folder (elmo-dop-spool-folder folder))
 254         queue)
 255     (dolist (number numbers)
 256       (if (< number 0)
 257           (progn
 258             ;; delete from queue
 259             (elmo-folder-delete-messages spool-folder
 260                                          (list (abs number)))
 261             (dolist (queue elmo-dop-queue)
 262               (when (and (eq (elmo-dop-queue-fname queue)
 263                              (elmo-folder-name-internal folder))
 264                          (eq (elmo-dop-queue-method queue)
 265                              'elmo-folder-append-buffer-dop-delayed)
 266                          (eq (abs number)
 267                              (nth 1 (elmo-dop-queue-arguments queue))))
 268                 (setq elmo-dop-queue (delq queue elmo-dop-queue)))))
 269         (setq queue (cons number queue))))
 270     (when queue
 271       (elmo-dop-queue-append folder 'elmo-folder-delete-messages-dop-delayed
 272                              (list
 273                               (mapcar
 274                                (lambda (number)
 275                                  (cons number (elmo-message-field
 276                                                folder number 'message-id)))
 277                                queue))))
 278     t))
 279
 280 (defsubst elmo-message-encache-dop (folder number &optional read)
 281   (elmo-dop-queue-append folder 'elmo-message-encache (list number read)))
 282
 283 (defsubst elmo-folder-create-dop (folder)
 284   (elmo-dop-queue-append folder 'elmo-folder-create-dop-delayed nil))
 285
 286 (defsubst elmo-folder-set-flag-dop (folder numbers flag)
 287   (when (setq numbers (elmo-dop-filter-pending-messages numbers))
 288     (let ((method (case flag
 289                     (unread
 290                      'elmo-folder-unset-read-delayed)
 291                     (read
 292                      'elmo-folder-set-read-delayed)
 293                     (important
 294                      'elmo-folder-set-important-delayed)
 295                     (answered
 296                      'elmo-folder-set-answered-delayed))))
 297       (if method
 298           (elmo-dop-queue-append folder method (list numbers))
 299         (elmo-dop-queue-append folder 'elmo-folder-set-flag
 300                                (list numbers flag))))))
 301
 302 (defsubst elmo-folder-unset-flag-dop (folder numbers flag)
 303   (when (setq numbers (elmo-dop-filter-pending-messages numbers))
 304     (let ((method (case flag
 305                     (unread
 306                      'elmo-folder-set-read-delayed)
 307                     (read
 308                      'elmo-folder-unset-read-delayed)
 309                     (important
 310                      'elmo-folder-unset-important-delayed)
 311                     (answered
 312                      'elmo-folder-unset-answered-delayed))))
 313       (if method
 314           (elmo-dop-queue-append folder method (list numbers))
 315         (elmo-dop-queue-append folder 'elmo-folder-unset-flag
 316                                (list numbers flag))))))
 317
 318 ;;; Execute as subsutitute for plugged operation.
 319 (defun elmo-folder-status-dop (folder)
 320   (let ((number-list (elmo-folder-list-messages folder nil 'in-msgdb))
 321         (spool-folder (elmo-dop-spool-folder folder))
 322         spool-length
 323         max-num)
 324     (setq spool-length (or (if (elmo-folder-exists-p spool-folder)
 325                                (car (elmo-folder-status spool-folder)))
 326                            0))
 327     (setq max-num (if number-list (apply #'max number-list) 0))
 328     (cons (+ max-num spool-length) (+ (length number-list) spool-length))))
 329
 330 (defun elmo-folder-next-message-number-dop (folder)
 331   (let ((spool-folder (elmo-dop-spool-folder folder)))
 332     (- (+ 1 (elmo-max-of-list (or (elmo-folder-list-messages
 333                                    spool-folder)
 334                                   '(0)))))))
 335
 336 ;;; Delayed operation (executed at online status).
 337 (defun elmo-folder-append-buffer-dop-delayed (folder flag number set-number)
 338   (let ((spool-folder (elmo-dop-spool-folder folder))
 339         flags)
 340     (with-temp-buffer
 341       (when (elmo-message-fetch spool-folder number
 342                                 (elmo-make-fetch-strategy 'entire)
 343                                 'unread)
 344         (setq flags (or (elmo-message-flags-for-append folder (* -1 number))
 345                         (cond ((listp flag)
 346                                flag)
 347                               ;; for compatibility with 2.11.12 or earlier
 348                               ((eq flag t)
 349                                nil)
 350                               (t
 351                                (list flag)))))
 352         (when (or (condition-case nil
 353                       (let ((new-num (elmo-folder-next-message-number folder)))
 354                         (prog1
 355                             (elmo-folder-append-buffer folder flags set-number)
 356                           (elmo-emit-signal 'message-number-changed
 357                                             folder (- number) new-num)))
 358                     (error))
 359                   ;; Append failed...
 360                   (elmo-folder-append-buffer
 361                    (elmo-get-folder elmo-lost+found-folder)
 362                    flags))
 363           (elmo-folder-delete-messages spool-folder (list number)))))
 364     ;; ignore failure (already dequed)
 365     t))
 366
 367 (defun elmo-folder-delete-messages-dop-delayed (folder number-alist)
 368   (ignore-errors
 369     (elmo-folder-delete-messages
 370      folder
 371      ;; messages are deleted only if message-id is not changed.
 372      (mapcar 'car
 373              (elmo-delete-if
 374               (lambda (pair)
 375                 (not (string=
 376                       (cdr pair)
 377                       (elmo-message-fetch-field folder (car pair)
 378                                                 'message-id))))
 379               number-alist)))
 380     t)) ; Always success (If failure, just remain)
 381
 382 (defun elmo-folder-create-dop-delayed (folder)
 383   (unless (elmo-folder-exists-p folder)
 384     (elmo-folder-create folder)))
 385
 386 (defun elmo-folder-set-important-delayed (folder numbers)
 387   (elmo-folder-set-flag folder numbers 'important))
 388
 389 (defun elmo-folder-unset-important-delayed (folder numbers)
 390   (elmo-folder-unset-flag folder numbers 'important))
 391
 392 (defun elmo-folder-set-read-delayed (folder numbers)
 393   (elmo-folder-unset-flag folder numbers 'unread))
 394
 395 (defun elmo-folder-unset-read-delayed (folder numbers)
 396   (elmo-folder-set-flag folder numbers 'unread))
 397
 398 (defun elmo-folder-set-answered-delayed (folder numbers)
 399   (elmo-folder-set-flag folder numbers 'answered))
 400
 401 (defun elmo-folder-unset-answered-delayed (folder numbers)
 402   (elmo-folder-unset-flag folder numbers 'answered))
 403
 404 ;;; Util
 405 (defun elmo-dop-msgdb (msgdb)
 406   (let ((new-db (elmo-make-msgdb))
 407         entity)
 408     (dolist (dop-entity (mapcar
 409                          (lambda (number)
 410                            (setq entity (elmo-msgdb-message-entity
 411                                          msgdb number))
 412                            (elmo-message-entity-set-number
 413                             entity
 414                             (* -1 (elmo-message-entity-number entity)))
 415                            entity)
 416                          (elmo-msgdb-list-messages msgdb)))
 417       (elmo-msgdb-append-entity new-db
 418                                 dop-entity
 419                                 (elmo-msgdb-flags
 420                                  msgdb
 421                                  (abs (elmo-message-entity-number
 422                                        dop-entity)))))
 423     new-db))
 424
 425 (require 'product)
 426 (product-provide (provide 'elmo-dop) (require 'elmo-version))
 427
 428 ;;; elmo-dop.el ends here