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