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