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