wl/wl-action.el

   1 ;;; wl-action.el --- Mark and actions in the Summary mode for Wanderlust.
   2
   3 ;; Copyright (C) 2003 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 Wanderlust (Yet Another Message Interface on Emacsen).
   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 'wl-summary)
  33
  34 (defsubst wl-summary-action-mark (action)
  35   (nth 0 action))
  36 (defsubst wl-summary-action-symbol (action)
  37   (nth 1 action))
  38 (defsubst wl-summary-action-argument-function (action)
  39   (nth 2 action))
  40 (defsubst wl-summary-action-set-function (action)
  41   (nth 3 action))
  42 (defsubst wl-summary-action-exec-function (action)
  43   (nth 4 action))
  44 (defsubst wl-summary-action-face (action)
  45   (nth 5 action))
  46 (defsubst wl-summary-action-docstring (action)
  47   (nth 6 action))
  48
  49 ;; Set mark
  50 (defun wl-summary-set-mark (&optional set-mark number interactive data)
  51   (interactive)
  52   "Set temporary mark SET-MARK on the message with NUMBER.
  53 NUMBER is the message number to set the mark on.
  54 INTERACTIVE is set as t if it have to run interactively.
  55 DATA is passed to the set-action function of the action as an argument.
  56 Return number if put mark succeed"
  57   (let* ((set-mark (or set-mark
  58                        (completing-read "Mark: " wl-summary-mark-action-list)))
  59          (current (wl-summary-message-number))
  60          (action (assoc set-mark wl-summary-mark-action-list))
  61          visible mark cur-mark)
  62     (save-excursion
  63       ;; Put mark
  64       (setq visible (or
  65                      ;; not-interactive and visible
  66                      (and number (wl-summary-jump-to-msg number))
  67                      ;; interactive
  68                      (and (null number) current))
  69             number (or number current))
  70       (when (and interactive
  71                  (null data)
  72                  (wl-summary-action-argument-function action))
  73         (setq data (funcall (wl-summary-action-argument-function action)
  74                             (wl-summary-action-symbol action)
  75                             number)))
  76       (when (setq cur-mark (nth 1 (wl-summary-registered-temp-mark number)))
  77         (when (and (wl-summary-reserve-temp-mark-p cur-mark)
  78                    interactive)
  79           (error "Already marked as `%s'" cur-mark)))
  80       (wl-summary-unset-mark number)
  81       (when visible
  82         (wl-summary-mark-line set-mark)
  83         (when wl-summary-highlight
  84           (wl-highlight-summary-current-line))
  85         (when data
  86           (wl-summary-print-destination number data)))
  87       ;; Set action.
  88       (funcall (wl-summary-action-set-function action)
  89                number
  90                (wl-summary-action-mark action)
  91                data)
  92       (set-buffer-modified-p nil))
  93     ;; Move the cursor.
  94     (if (or interactive (interactive-p))
  95         (if (eq wl-summary-move-direction-downward nil)
  96             (wl-summary-prev)
  97           (wl-summary-next)))
  98     ;; Return value.
  99     number))
 100
 101 (defun wl-summary-register-target-mark (number mark data)
 102   (or (memq number wl-summary-buffer-target-mark-list)
 103       (setq wl-summary-buffer-target-mark-list
 104             (cons number wl-summary-buffer-target-mark-list))))
 105
 106 (defun wl-summary-unregister-target-mark (number)
 107   (delq number wl-summary-buffer-target-mark-list))
 108
 109 (defun wl-summary-have-target-mark-p (number)
 110   (memq number wl-summary-buffer-target-mark-list))
 111
 112 (defun wl-summary-target-mark-set-action (action)
 113   (unless (eq (wl-summary-action-symbol action) 'target-mark)
 114     (save-excursion
 115       (goto-char (point-min))
 116       (let ((numlist wl-summary-buffer-number-list)
 117             number mlist data)
 118         ;; use firstly marked message.
 119         (when (wl-summary-action-argument-function action)
 120           (while numlist
 121             (if (memq (car numlist) wl-summary-buffer-target-mark-list)
 122                 (setq number (car numlist)
 123                       numlist nil))
 124             (setq numlist (cdr numlist)))
 125           (wl-summary-jump-to-msg number)
 126           (setq data (funcall (wl-summary-action-argument-function action)
 127                               (wl-summary-action-symbol action) number)))
 128         (while (not (eobp))
 129           (when (string= (wl-summary-temp-mark) "*")
 130             (let (wl-summary-buffer-disp-msg)
 131               (when (setq number (wl-summary-message-number))
 132                 (wl-summary-set-mark (wl-summary-action-mark action)
 133                                      number nil data)
 134                 (setq wl-summary-buffer-target-mark-list
 135                       (delq number wl-summary-buffer-target-mark-list)))))
 136           (forward-line 1))
 137         (setq mlist wl-summary-buffer-target-mark-list)
 138         (while mlist
 139           (wl-summary-register-temp-mark (car mlist)
 140                                          (wl-summary-action-mark action) data)
 141           (setq wl-summary-buffer-target-mark-list
 142                 (delq (car mlist) wl-summary-buffer-target-mark-list))
 143           (setq mlist (cdr mlist)))))))
 144
 145 ;; wl-summary-buffer-temp-mark-list specification
 146 ;; ((1 "D" nil)(2 "o" "+fuga")(3 "O" "+hoge"))
 147 (defun wl-summary-register-temp-mark (number mark mark-info)
 148   (let ((elem (assq number wl-summary-buffer-temp-mark-list)))
 149     (setq wl-summary-buffer-temp-mark-list
 150           (delq elem wl-summary-buffer-temp-mark-list)))
 151   (setq wl-summary-buffer-temp-mark-list
 152         (cons (list number mark mark-info) wl-summary-buffer-temp-mark-list)))
 153
 154 (defun wl-summary-unregister-temp-mark (number)
 155   (let ((elem (assq number wl-summary-buffer-temp-mark-list)))
 156     (setq wl-summary-buffer-temp-mark-list
 157           (delq elem wl-summary-buffer-temp-mark-list))))
 158
 159 (defun wl-summary-registered-temp-mark (number)
 160   (assq number wl-summary-buffer-temp-mark-list))
 161
 162 (defun wl-summary-collect-temp-mark (mark &optional begin end)
 163   (if (or begin end)
 164       (save-excursion
 165         (save-restriction
 166           (let (mark-list)
 167             (narrow-to-region (or begin (point-min))(or end (point-max)))
 168             (goto-char (point-min))
 169             ;; for thread...
 170             (if (eq wl-summary-buffer-view 'thread)
 171                 (let (number entity mark-info)
 172                   (while (not (eobp))
 173                     (setq number (wl-summary-message-number)
 174                           entity (wl-thread-get-entity number)
 175                           mark-info (wl-summary-registered-temp-mark number))
 176                     ;; toplevel message mark.
 177                     (when (string= (nth 1 mark-info) mark)
 178                       (setq mark-list (cons mark-info mark-list)))
 179                     ;; When thread is closed...children should also be checked.
 180                     (unless (wl-thread-entity-get-opened entity)
 181                       (dolist (msg (wl-thread-get-children-msgs number))
 182                         (setq mark-info (wl-summary-registered-temp-mark
 183                                          msg))
 184                         (when (string= (nth 1 mark-info) mark)
 185                           (setq mark-list (cons mark-info mark-list)))))
 186                     (forward-line 1)))
 187               (let (number mark-info)
 188                 (while (not (eobp))
 189                   (setq number (wl-summary-message-number)
 190                         mark-info (wl-summary-registered-temp-mark number))
 191                   (when (string= (nth 1 mark-info) mark)
 192                     (setq mark-list (cons mark-info mark-list)))
 193                   (forward-line 1))))
 194             mark-list)))
 195     (let (mark-list)
 196       (dolist (mark-info wl-summary-buffer-temp-mark-list)
 197         (when (string= (nth 1 mark-info) mark)
 198           (setq mark-list (cons mark-info mark-list))))
 199       mark-list)))
 200
 201 ;; Unset mark
 202 (defun wl-summary-unset-mark (&optional number interactive)
 203   "Unset temporary mark of the message with NUMBER.
 204 NUMBER is the message number to unset the mark.
 205 If not specified, the message on the cursor position is treated.
 206 Optional INTERACTIVE is non-nil when it should be called interactively.
 207 Return number if put mark succeed"
 208   (interactive)
 209   (save-excursion
 210     (beginning-of-line)
 211     (let ((buffer-read-only nil)
 212           visible mark action)
 213       (if number
 214           (setq visible (wl-summary-jump-to-msg number))
 215         (setq visible t))
 216       (setq number (or number (wl-summary-message-number)))
 217       ;; Delete mark on buffer.
 218       (when visible
 219         (setq mark (wl-summary-temp-mark))
 220         (unless (string= mark " ")
 221           (delete-backward-char 1)
 222           (insert (or (wl-summary-get-score-mark number)
 223                       " "))
 224           (setq action (assoc mark wl-summary-mark-action-list))
 225           (when wl-summary-highlight
 226             (wl-highlight-summary-current-line))
 227           (when (wl-summary-action-argument-function action)
 228             (wl-summary-remove-destination)))
 229         (set-buffer-modified-p nil))
 230       ;; Remove from temporal mark structure.
 231       (wl-summary-unregister-target-mark number)
 232       (wl-summary-unregister-temp-mark number)))
 233   ;; Move the cursor.
 234   ;;  (if (or interactive (interactive-p))
 235   ;;      (if (eq wl-summary-move-direction-downward nil)
 236   ;;      (wl-summary-prev)
 237   ;;    (wl-summary-next))))
 238   )
 239
 240 (defun wl-summary-make-destination-numbers-list (mark-list)
 241   (let (dest-numbers dest-number)
 242     (dolist (elem mark-list)
 243       (setq dest-number (assoc (nth 2 elem) dest-numbers))
 244       (if dest-number
 245           (unless (memq (car elem) (cdr dest-number))
 246             (nconc dest-number (list (car elem))))
 247         (setq dest-numbers (nconc dest-numbers
 248                                   (list
 249                                    (list (nth 2 elem)
 250                                          (car elem)))))))
 251     dest-numbers))
 252
 253 (defun wl-summary-move-mark-list-messages (mark-list folder-name message)
 254   (if (null mark-list)
 255       (message "No marks")
 256     (save-excursion
 257       (let ((start (point))
 258             (refiles (mapcar 'car mark-list))
 259             (refile-failures 0)
 260             refile-len
 261             dst-msgs                    ; loop counter
 262             result)
 263         ;; begin refile...
 264         (setq refile-len (length refiles))
 265         (goto-char start)               ; avoid moving cursor to
 266                                         ; the bottom line.
 267         (message message)
 268         (when (> refile-len elmo-display-progress-threshold)
 269           (elmo-progress-set 'elmo-folder-move-messages
 270                              refile-len message))
 271         (setq result nil)
 272         (condition-case nil
 273             (setq result (elmo-folder-move-messages
 274                           wl-summary-buffer-elmo-folder
 275                           refiles
 276                           (if (eq folder-name 'null)
 277                               'null
 278                             (wl-folder-get-elmo-folder folder-name))
 279                           (wl-summary-buffer-msgdb)
 280                           (not (null (cdr dst-msgs)))
 281                           nil ; no-delete
 282                           nil ; same-number
 283                           t))
 284           (error nil))
 285         (when result            ; succeeded.
 286           ;; update buffer.
 287           (wl-summary-delete-messages-on-buffer refiles)
 288           ;; update wl-summary-buffer-temp-mark-list.
 289           (dolist (mark-info mark-list)
 290             (setq wl-summary-buffer-temp-mark-list
 291                   (delq mark-info wl-summary-buffer-temp-mark-list))))
 292         (elmo-progress-clear 'elmo-folder-move-messages)
 293         (message (concat message "done"))
 294         (wl-summary-set-message-modified)
 295         ;; Return the operation failed message numbers.
 296         (if result
 297             0
 298           (length refiles))))))
 299
 300 (defun wl-summary-get-refile-destination-subr (action number learn)
 301   (let* ((number (or number (wl-summary-message-number)))
 302          (msgid (and number
 303                      (elmo-message-field wl-summary-buffer-elmo-folder
 304                                          number 'message-id)))
 305          (entity (and number
 306                       (elmo-message-entity wl-summary-buffer-elmo-folder
 307                                            number)))
 308          folder cur-mark tmp-folder)
 309     (catch 'done
 310       (when (null entity)
 311         (message "Cannot decide destination.")
 312         (throw 'done nil))
 313       (when (null number)
 314         (message "No message.")
 315         (throw 'done nil))
 316       (setq folder (wl-summary-read-folder
 317                     (or (wl-refile-guess entity) wl-trash-folder)
 318                     (format "for %s " action)))
 319       ;; Cache folder hack by okada@opaopa.org
 320       (when (and (eq (elmo-folder-type-internal
 321                       (wl-folder-get-elmo-folder
 322                        (wl-folder-get-realname folder))) 'cache)
 323                  (not (string= folder
 324                                (setq tmp-folder
 325                                      (concat "'cache/"
 326                                              (elmo-cache-get-path-subr
 327                                               (elmo-msgid-to-cache msgid)))))))
 328         (setq folder tmp-folder)
 329         (message "Force refile to %s." folder))
 330       (if (string= folder (wl-summary-buffer-folder-name))
 331           (error "Same folder"))
 332       (if (or (not (elmo-folder-writable-p (wl-folder-get-elmo-folder folder)))
 333               (string= folder wl-queue-folder)
 334               (string= folder wl-draft-folder))
 335           (error "Don't set as target: %s" folder))
 336       ;; learn for refile.
 337       (when learn
 338         (wl-refile-learn entity folder))
 339       folder)))
 340
 341 ;;; Actions
 342 (defun wl-summary-define-mark-action ()
 343   (interactive)
 344   (dolist (action wl-summary-mark-action-list)
 345     (fset (intern (format "wl-summary-%s" (wl-summary-action-symbol action)))
 346           `(lambda (&optional number data)
 347              ,(wl-summary-action-docstring action)
 348              (interactive)
 349              (wl-summary-set-mark ,(wl-summary-action-mark action)
 350                                   number (interactive-p) data)))
 351     (fset (intern (format "wl-summary-%s-region"
 352                           (wl-summary-action-symbol action)))
 353           `(lambda (beg end)
 354              ,(wl-summary-action-docstring action)
 355              (interactive "r")
 356              (goto-char beg)
 357              (wl-summary-mark-region-subr
 358               (quote ,(intern (format "wl-summary-%s"
 359                                       (wl-summary-action-symbol action))))
 360               beg end
 361               (if (quote ,(wl-summary-action-argument-function action))
 362                   (funcall (function
 363                             ,(wl-summary-action-argument-function action))
 364                            (quote ,(wl-summary-action-symbol action))
 365                            (wl-summary-message-number))))))
 366     (fset (intern (format "wl-summary-target-mark-%s"
 367                           (wl-summary-action-symbol action)))
 368           `(lambda ()
 369              ,(wl-summary-action-docstring action)
 370              (interactive)
 371              (wl-summary-target-mark-set-action (quote ,action))))
 372     (fset (intern (format "wl-thread-%s"
 373                           (wl-summary-action-symbol action)))
 374           `(lambda (arg)
 375              ,(wl-summary-action-docstring action)
 376              (interactive "P")
 377              (wl-thread-call-region-func
 378               (quote ,(intern (format "wl-summary-%s-region"
 379                                       (wl-summary-action-symbol action))))
 380               arg)
 381              (if arg
 382                  (wl-summary-goto-top-of-current-thread))
 383              (if (not wl-summary-move-direction-downward)
 384                  (wl-summary-prev)
 385                (wl-thread-goto-bottom-of-sub-thread)
 386                (if wl-summary-buffer-disp-msg
 387                    (wl-summary-redisplay)))))))
 388
 389 (defun wl-summary-get-dispose-folder (folder)
 390   (if (string= folder wl-trash-folder)
 391       'null
 392     (let* ((type (or (wl-get-assoc-list-value wl-dispose-folder-alist folder)
 393                      'trash)))
 394       (cond ((stringp type)
 395              type)
 396             ((or (equal type 'remove) (equal type 'null))
 397              'null)
 398             (t;; (equal type 'trash)
 399              (let ((trash-folder (wl-folder-get-elmo-folder wl-trash-folder)))
 400                (unless (elmo-folder-exists-p trash-folder)
 401                  (if (y-or-n-p
 402                       (format "Trash Folder %s does not exist, create it? "
 403                               wl-trash-folder))
 404                      (elmo-folder-create trash-folder)
 405                    (error "Trash Folder is not created"))))
 406              wl-trash-folder)))))
 407
 408 ;; Dispose action.
 409 (defun wl-summary-exec-action-dispose (mark-list)
 410   (wl-summary-move-mark-list-messages mark-list
 411                                       (wl-summary-get-dispose-folder
 412                                        (wl-summary-buffer-folder-name))
 413                                       "Disposing messages..."))
 414
 415 ;; Delete action.
 416 (defun wl-summary-exec-action-delete (mark-list)
 417   (wl-summary-move-mark-list-messages mark-list
 418                                       'null
 419                                       "Deleting messages..."))
 420
 421 ;; Refile action
 422 (defun wl-summary-set-action-refile (number mark data)
 423   (let ((policy (wl-get-assoc-list-value wl-refile-policy-alist
 424                                          (wl-summary-buffer-folder-name)))
 425         (elem wl-summary-mark-action-list))
 426     (if (eq policy 'copy)
 427         (while elem
 428           (when (eq (wl-summary-action-symbol (car elem)) 'copy)
 429             (wl-summary-register-temp-mark number
 430                                            (wl-summary-action-mark (car elem))
 431                                            data)
 432             (setq elem nil))
 433           (setq elem (cdr elem)))
 434       (wl-summary-register-temp-mark number mark data)
 435       (setq wl-summary-buffer-prev-refile-destination data))))
 436
 437 (defun wl-summary-get-refile-destination (action number)
 438   "Decide refile destination."
 439   (wl-summary-get-refile-destination-subr action number t))
 440
 441 (defun wl-summary-exec-action-refile (mark-list)
 442   (save-excursion
 443     (let ((start (point))
 444           (failures 0)
 445           (refile-len (length mark-list))
 446           dst-msgs ; loop counter
 447           result)
 448       ;; begin refile...
 449       (setq dst-msgs
 450             (wl-summary-make-destination-numbers-list mark-list))
 451       (goto-char start) ; avoid moving cursor to the bottom line.
 452       (when (> refile-len elmo-display-progress-threshold)
 453         (elmo-progress-set 'elmo-folder-move-messages
 454                            refile-len "Refiling messages..."))
 455       (while dst-msgs
 456         (setq result nil)
 457         (condition-case nil
 458             (setq result (elmo-folder-move-messages
 459                           wl-summary-buffer-elmo-folder
 460                           (cdr (car dst-msgs))
 461                           (wl-folder-get-elmo-folder
 462                            (car (car dst-msgs)))
 463                           (wl-summary-buffer-msgdb)
 464                           (not (null (cdr dst-msgs)))
 465                           nil ; no-delete
 466                           nil ; same-number
 467                           t))
 468           (error nil))
 469         (if result              ; succeeded.
 470             (progn
 471               ;; update buffer.
 472               (wl-summary-delete-messages-on-buffer (cdr (car dst-msgs)))
 473               (setq wl-summary-buffer-temp-mark-list
 474                     (wl-delete-associations
 475                      (cdr (car dst-msgs))
 476                      wl-summary-buffer-temp-mark-list)))
 477           (setq failures
 478                 (+ failures (length (cdr (car dst-msgs))))))
 479         (setq dst-msgs (cdr dst-msgs)))
 480       (elmo-progress-clear 'elmo-folder-move-messages)
 481       failures)))
 482
 483 ;; Copy action
 484 (defun wl-summary-get-copy-destination (action number)
 485   (wl-summary-get-refile-destination-subr action number nil))
 486
 487 (defun wl-summary-exec-action-copy (mark-list)
 488   (save-excursion
 489     (let ((start (point))
 490           (failures 0)
 491           (refile-len (length mark-list))
 492           dst-msgs ; loop counter
 493           result)
 494       ;; begin refile...
 495       (setq dst-msgs
 496             (wl-summary-make-destination-numbers-list mark-list))
 497       (goto-char start) ; avoid moving cursor to the bottom line.
 498       (when (> refile-len elmo-display-progress-threshold)
 499         (elmo-progress-set 'elmo-folder-move-messages
 500                            refile-len "Copying messages..."))
 501       (while dst-msgs
 502         (setq result nil)
 503         (condition-case nil
 504             (setq result (elmo-folder-move-messages
 505                             wl-summary-buffer-elmo-folder
 506                             (cdr (car dst-msgs))
 507                             (wl-folder-get-elmo-folder
 508                              (car (car dst-msgs)))
 509                             (wl-summary-buffer-msgdb)
 510                             (not (null (cdr dst-msgs)))
 511                             t ; t is no-delete (copy)
 512                             nil ; same-number
 513                             t))
 514           (error nil))
 515         (if result              ; succeeded.
 516             (progn
 517               ;; update buffer.
 518               (wl-summary-delete-copy-marks-on-buffer (cdr (car dst-msgs)))
 519               (setq wl-summary-buffer-temp-mark-list
 520                     (wl-delete-associations
 521                      (cdr (car dst-msgs))
 522                      wl-summary-buffer-temp-mark-list)))
 523           (setq failures
 524                 (+ failures (length (cdr (car dst-msgs))))))
 525         (setq dst-msgs (cdr dst-msgs)))
 526       (elmo-progress-clear 'elmo-folder-move-messages)
 527       failures)))
 528
 529 ;; Prefetch.
 530 (defun wl-summary-exec-action-prefetch (mark-list)
 531   (save-excursion
 532     (let* ((buffer-read-only nil)
 533            (count 0)
 534            (length (length mark-list))
 535            (mark-list-copy (copy-sequence mark-list))
 536            (pos (point))
 537            (failures 0)
 538            new-mark)
 539       (dolist (mark-info mark-list-copy)
 540         (message "Prefetching...(%d/%d)"
 541                  (setq count (+ 1 count)) length)
 542         (setq new-mark (wl-summary-prefetch-msg (car mark-info)))
 543         (if new-mark
 544             (progn
 545               (wl-summary-unset-mark (car mark-info))
 546               (when (wl-summary-jump-to-msg (car mark-info))
 547                 (wl-summary-persistent-mark) ; move
 548                 (delete-backward-char 1)
 549                 (insert new-mark)
 550                 (when wl-summary-highlight
 551                   (wl-highlight-summary-current-line))
 552                 (save-excursion
 553                   (goto-char pos)
 554                   (sit-for 0))))
 555           (incf failures)))
 556       (message "Prefetching...done")
 557       0)))
 558
 559 ;; Resend.
 560 (defun wl-summary-get-resend-address (action number)
 561   "Decide resend address."
 562   (wl-complete-field-to "Resend message to: "))
 563
 564 (defun wl-summary-exec-action-resend (mark-list)
 565   (let ((failure 0))
 566     (dolist (mark-info mark-list)
 567       (if (condition-case nil
 568               (progn
 569                 (wl-summary-exec-action-resend-subr (car mark-info)
 570                                                     (nth 2 mark-info))
 571                 t)
 572             (error))
 573           (wl-summary-unmark (car mark-info))
 574         (incf failure)))
 575     failure))
 576
 577 (defun wl-summary-exec-action-resend-subr (number address)
 578   "Resend the message with NUMBER to ADDRESS."
 579   (message "Resending message to %s..." address)
 580   (let ((folder wl-summary-buffer-elmo-folder))
 581     (save-excursion
 582       ;; We first set up a normal mail buffer.
 583       (set-buffer (get-buffer-create " *wl-draft-resend*"))
 584       (buffer-disable-undo (current-buffer))
 585       (erase-buffer)
 586       (setq wl-sent-message-via nil)
 587       ;; Insert our usual headers.
 588       (wl-draft-insert-from-field)
 589       (wl-draft-insert-date-field)
 590       (insert "To: " address "\n")
 591       (goto-char (point-min))
 592       ;; Rename them all to "Resent-*".
 593       (while (re-search-forward "^[A-Za-z]" nil t)
 594         (forward-char -1)
 595         (insert "Resent-"))
 596       (widen)
 597       (forward-line)
 598       (delete-region (point) (point-max))
 599       (let ((beg (point)))
 600         ;; Insert the message to be resent.
 601         (insert
 602          (with-temp-buffer
 603            (elmo-message-fetch folder number
 604                                (elmo-make-fetch-strategy 'entire)
 605                                nil (current-buffer) 'unread)
 606            (buffer-string)))
 607         (goto-char (point-min))
 608         (search-forward "\n\n")
 609         (forward-char -1)
 610         (save-restriction
 611           (narrow-to-region beg (point))
 612           (wl-draft-delete-fields wl-ignored-resent-headers)
 613           (goto-char (point-max)))
 614         (insert mail-header-separator)
 615         ;; Rename all old ("Previous-")Resent headers.
 616         (while (re-search-backward "^\\(Previous-\\)*Resent-" beg t)
 617           (beginning-of-line)
 618           (insert "Previous-"))
 619         ;; Quote any "From " lines at the beginning.
 620         (goto-char beg)
 621         (when (looking-at "From ")
 622           (replace-match "X-From-Line: ")))
 623       ;; Send it.
 624       (wl-draft-dispatch-message)
 625       (kill-buffer (current-buffer)))
 626     (message "Resending message to %s...done" address)))
 627
 628 ;;;
 629 (defun wl-summary-remove-destination ()
 630   (save-excursion
 631     (let ((inhibit-read-only t)
 632           (buffer-read-only nil)
 633           (buf (current-buffer))
 634           sol eol rs re)
 635       (beginning-of-line)
 636       (setq sol (point))
 637       (search-forward "\r")
 638       (forward-char -1)
 639       (setq eol (point))
 640       (setq rs (next-single-property-change sol 'wl-summary-destination
 641                                             buf eol))
 642       (setq re (next-single-property-change rs 'wl-summary-destination
 643                                             buf eol))
 644       (put-text-property rs re 'wl-summary-destination nil)
 645       (put-text-property rs re 'invisible nil)
 646       (goto-char re)
 647       (delete-char (- eol re)))))
 648
 649 (defun wl-summary-collect-numbers-region (begin end)
 650   "Return a list of message number in the region specified by BEGIN and END."
 651   (save-excursion
 652     (save-restriction
 653       (let (numbers)
 654         (narrow-to-region (or begin (point-min))(or end (point-max)))
 655         (goto-char (point-min))
 656         ;; for thread...
 657         (if (eq wl-summary-buffer-view 'thread)
 658             (let (number entity mark-info)
 659               (while (not (eobp))
 660                 (setq numbers (cons (wl-summary-message-number) numbers)
 661                       entity (wl-thread-get-entity number))
 662                 ;; When thread is closed...children should also be checked.
 663                 (unless (wl-thread-entity-get-opened entity)
 664                   (dolist (msg (wl-thread-get-children-msgs number))
 665                     (setq numbers (cons msg numbers))))
 666                 (forward-line 1)))
 667           (let (number mark-info)
 668             (while (not (eobp))
 669               (setq numbers (cons (wl-summary-message-number) numbers))
 670               (forward-line 1))))
 671         numbers))))
 672
 673 (defun wl-summary-exec (&optional numbers)
 674   (interactive)
 675   (let ((failures 0)
 676         collected pair action modified)
 677     (dolist (action wl-summary-mark-action-list)
 678       (setq collected (cons (cons
 679                              (wl-summary-action-mark action)
 680                              nil) collected)))
 681     (dolist (mark-info wl-summary-buffer-temp-mark-list)
 682       (if numbers
 683           (when (memq (nth 0 mark-info) numbers)
 684             (setq pair (assoc (nth 1 mark-info) collected)))
 685         (setq pair (assoc (nth 1 mark-info) collected)))
 686       (setq pair (assoc (nth 1 mark-info) collected))
 687       (setcdr pair (cons mark-info (cdr pair))))
 688     ;; collected is a pair of
 689     ;; mark-string and a list of mark-info
 690     (dolist (pair collected)
 691       (setq action (assoc (car pair) wl-summary-mark-action-list))
 692       (when (and (cdr pair) (wl-summary-action-exec-function action))
 693         (setq modified t)
 694         (setq failures (+ failures (funcall
 695                                     (wl-summary-action-exec-function action)
 696                                     (cdr pair))))))
 697     (when modified
 698       (wl-summary-set-message-modified))
 699     (run-hooks 'wl-summary-exec-hook)
 700     ;; message buffer is not up-to-date
 701     (unless (and wl-message-buffer
 702                  (eq (wl-summary-message-number)
 703                      (with-current-buffer wl-message-buffer
 704                        wl-message-buffer-cur-number)))
 705       (wl-summary-toggle-disp-msg 'off)
 706       (setq wl-message-buffer nil))
 707     (set-buffer-modified-p nil)
 708     (when (> failures 0)
 709       (format "%d execution(s) were failed" failures))))
 710
 711 (defun wl-summary-exec-region (beg end)
 712   (interactive "r")
 713   (wl-summary-exec
 714    (wl-summary-collect-numbers-region beg end)))
 715
 716 (defun wl-summary-read-folder (default &optional purpose ignore-error
 717                                 no-create init)
 718   (let ((fld (completing-read
 719               (format "Folder name %s(%s): " (or purpose "")
 720                       default)
 721               'wl-folder-complete-folder
 722               nil nil (or init wl-default-spec)
 723               'wl-read-folder-hist)))
 724     (if (or (string= fld wl-default-spec)
 725             (string= fld ""))
 726         (setq fld default))
 727     (setq fld (elmo-string (wl-folder-get-realname fld)))
 728     (if (string-match "\n" fld)
 729         (error "Not supported folder name: %s" fld))
 730     (unless no-create
 731       (if ignore-error
 732           (condition-case nil
 733               (wl-folder-confirm-existence
 734                (wl-folder-get-elmo-folder
 735                 fld))
 736             (error))
 737         (wl-folder-confirm-existence (wl-folder-get-elmo-folder
 738                                       fld))))
 739     fld))
 740
 741 (defun wl-summary-print-destination (msg-num folder)
 742   "Print refile destination on line."
 743   (wl-summary-remove-destination)
 744   (save-excursion
 745     (let ((inhibit-read-only t)
 746           (folder (copy-sequence folder))
 747           (buffer-read-only nil)
 748           len rs re c)
 749       (setq len (string-width folder))
 750       (if (< len 1) ()
 751         ;;(end-of-line)
 752         (beginning-of-line)
 753         (search-forward "\r")
 754         (forward-char -1)
 755         (setq re (point))
 756         (setq c 0)
 757         (while (< c len)
 758           (forward-char -1)
 759           (setq c (+ c (char-width (following-char)))))
 760         (and (> c len) (setq folder (concat " " folder)))
 761         (setq rs (point))
 762         (when wl-summary-width
 763           (put-text-property rs re 'invisible t))
 764         (put-text-property rs re 'wl-summary-destination t)
 765         (goto-char re)
 766         (wl-highlight-refile-destination-string folder)
 767         (insert folder)
 768         (set-buffer-modified-p nil)))))
 769
 770 (defsubst wl-summary-reserve-temp-mark-p (mark)
 771   "Return t if temporal MARK should be reserved."
 772   (member mark wl-summary-reserve-mark-list))
 773
 774 (defun wl-summary-refile-prev-destination ()
 775   "Refile message to previously refiled destination."
 776   (interactive)
 777   (funcall (symbol-function 'wl-summary-refile)
 778            wl-summary-buffer-prev-refile-destination
 779            (wl-summary-message-number))
 780   (if (eq wl-summary-move-direction-downward nil)
 781       (wl-summary-prev)
 782     (wl-summary-next)))
 783
 784 (defsubst wl-summary-no-auto-refile-message-p (msg)
 785   (member (elmo-msgdb-get-mark (wl-summary-buffer-msgdb) msg)
 786           wl-summary-auto-refile-skip-marks))
 787
 788 (defun wl-summary-auto-refile (&optional open-all)
 789   "Set refile mark automatically according to 'wl-refile-guess-by-rule'."
 790   (interactive "P")
 791   (message "Marking...")
 792   (save-excursion
 793     (if (and (eq wl-summary-buffer-view 'thread)
 794              open-all)
 795         (wl-thread-open-all))
 796     (let* ((spec (wl-summary-buffer-folder-name))
 797            checked-dsts
 798            (count 0)
 799            number dst thr-entity)
 800       (goto-line 1)
 801       (while (not (eobp))
 802         (setq number (wl-summary-message-number))
 803         (dolist (number (cons number
 804                               (and (eq wl-summary-buffer-view 'thread)
 805                                    ;; process invisible children.
 806                                    (not (wl-thread-entity-get-opened
 807                                          (setq thr-entity
 808                                                (wl-thread-get-entity number))))
 809                                    (wl-thread-entity-get-descendant
 810                                     thr-entity))))
 811           (when (and (not (wl-summary-no-auto-refile-message-p
 812                            number))
 813                      (setq dst
 814                            (wl-folder-get-realname
 815                             (wl-refile-guess-by-rule
 816                              (elmo-msgdb-overview-get-entity
 817                               number (wl-summary-buffer-msgdb)))))
 818                      (not (equal dst spec))
 819                      (let ((pair (assoc dst checked-dsts))
 820                            ret)
 821                        (if pair
 822                            (cdr pair)
 823                          (setq ret
 824                                (condition-case nil
 825                                    (progn
 826                                      (wl-folder-confirm-existence
 827                                       (wl-folder-get-elmo-folder dst))
 828                                      t)
 829                                  (error)))
 830                          (setq checked-dsts (cons (cons dst ret) checked-dsts))
 831                          ret)))
 832             (if (funcall (symbol-function 'wl-summary-refile) number dst)
 833                 (incf count))
 834             (message "Marking...%d message(s)." count)))
 835         (forward-line))
 836       (if (eq count 0)
 837           (message "No message was marked.")
 838         (message "Marked %d message(s)." count)))))
 839
 840 (defun wl-summary-unmark (&optional number)
 841   "Unmark marks (temporary, refile, copy, delete)of current line.
 842 If optional argument NUMBER is specified, unmark message specified by NUMBER."
 843   (interactive)
 844   (wl-summary-unset-mark number (interactive-p)))
 845
 846 (defun wl-summary-target-mark (&optional number)
 847   "Put target mark '*' on current message.
 848 If optional argument NUMBER is specified, mark message specified by NUMBER."
 849   (interactive)
 850   (wl-summary-set-mark "*" number (interactive-p)))
 851
 852 (defun wl-summary-unmark-region (beg end)
 853   (interactive "r")
 854   (save-excursion
 855     (save-restriction
 856       (narrow-to-region beg end)
 857       (goto-char (point-min))
 858       (if (eq wl-summary-buffer-view 'thread)
 859           (progn
 860             (while (not (eobp))
 861               (let* ((number (wl-summary-message-number))
 862                      (entity (wl-thread-get-entity number)))
 863                 (if (wl-thread-entity-get-opened entity)
 864                     ;; opened...unmark line.
 865                     (wl-summary-unmark)
 866                   ;; closed
 867                   (wl-summary-delete-marks-on-buffer
 868                    (wl-thread-get-children-msgs number))))
 869               (forward-line 1)))
 870         (while (not (eobp))
 871           (wl-summary-unmark)
 872           (forward-line 1))))))
 873
 874 (defun wl-summary-mark-region-subr (function beg end data)
 875   (save-excursion
 876     (save-restriction
 877       (narrow-to-region beg end)
 878       (goto-char (point-min))
 879       (if (eq wl-summary-buffer-view 'thread)
 880           (progn
 881             (while (not (eobp))
 882               (let* ((number (wl-summary-message-number))
 883                      (entity (wl-thread-get-entity number))
 884                      (wl-summary-move-direction-downward t)
 885                      children)
 886                 (if (wl-thread-entity-get-opened entity)
 887                     ;; opened...delete line.
 888                     (funcall function number data)
 889                   ;; closed
 890                   (setq children (wl-thread-get-children-msgs number))
 891                   (while children
 892                     (funcall function (pop children) data)))
 893                 (forward-line 1))))
 894         (while (not (eobp))
 895           (funcall function (wl-summary-message-number) data)
 896           (forward-line 1))))))
 897
 898 (defun wl-summary-target-mark-region (beg end)
 899   (interactive "r")
 900   (wl-summary-mark-region-subr 'wl-summary-target-mark beg end nil))
 901
 902 (defun wl-summary-target-mark-all ()
 903   (interactive)
 904   (wl-summary-target-mark-region (point-min) (point-max))
 905   (setq wl-summary-buffer-target-mark-list
 906         (mapcar 'car
 907                 (elmo-msgdb-get-number-alist (wl-summary-buffer-msgdb)))))
 908
 909 (defun wl-summary-delete-all-mark (mark)
 910   (goto-char (point-min))
 911   (while (not (eobp))
 912     (when (string= (wl-summary-temp-mark) mark)
 913       (wl-summary-unmark))
 914     (forward-line 1))
 915   (let (deleted)
 916     (dolist (mark-info wl-summary-buffer-temp-mark-list)
 917       (when (string= (nth 1 mark-info) mark)
 918         (setq deleted (cons mark-info deleted))))
 919     (dolist (delete deleted)
 920       (setq wl-summary-buffer-temp-mark-list
 921             (delq delete wl-summary-buffer-temp-mark-list)))))
 922
 923 (defun wl-summary-unmark-all ()
 924   "Unmark all according to what you input."
 925   (interactive)
 926   (let ((unmarks (string-to-char-list (read-from-minibuffer "Unmark: ")))
 927         cur-mark)
 928     (save-excursion
 929       (while unmarks
 930         (setq cur-mark (char-to-string (car unmarks)))
 931         (wl-summary-delete-all-mark cur-mark)
 932         (setq unmarks (cdr unmarks))))))
 933
 934 (defun wl-summary-target-mark-thread ()
 935   (interactive)
 936   (wl-thread-call-region-func 'wl-summary-target-mark-region t))
 937
 938 (require 'product)
 939 (product-provide (provide 'wl-action) (require 'wl-version))
 940
 941 ;;; wl-action.el ends here