["Mark as read" wl-summary-mark-as-read t]
["Mark as important" wl-summary-mark-as-important t]
["Mark as unread" wl-summary-mark-as-unread t]
- ["Set delete mark" wl-summary-delete t]
+ ["Set dispose mark" wl-summary-dispose t]
["Set refile mark" wl-summary-refile t]
["Set copy mark" wl-summary-copy t]
["Prefetch" wl-summary-prefetch t]
["Mark as read" wl-summary-mark-as-read-region t]
["Mark as important" wl-summary-mark-as-important-region t]
["Mark as unread" wl-summary-mark-as-unread-region t]
- ["Set delete mark" wl-summary-delete-region t]
+ ["Set dispose mark" wl-summary-dispose-region t]
["Set refile mark" wl-summary-refile-region t]
["Set copy mark" wl-summary-copy-region t]
["Prefetch" wl-summary-prefetch-region t]
(define-key wl-summary-mode-map "O" 'wl-summary-copy)
(define-key wl-summary-mode-map "\M-o" 'wl-summary-refile-prev-destination)
(define-key wl-summary-mode-map "\C-o" 'wl-summary-auto-refile)
- (define-key wl-summary-mode-map "d" 'wl-summary-delete)
+ (define-key wl-summary-mode-map "d" 'wl-summary-dispose)
(define-key wl-summary-mode-map "u" 'wl-summary-unmark)
(define-key wl-summary-mode-map "U" 'wl-summary-unmark-all)
- (define-key wl-summary-mode-map "D" 'wl-summary-erase)
+ (define-key wl-summary-mode-map "D" 'wl-summary-delete)
;; thread commands
(define-key wl-summary-mode-map "t" (make-sparse-keymap))
(define-key wl-summary-mode-map "m?" 'wl-summary-target-mark-pick)
(define-key wl-summary-mode-map "m#" 'wl-summary-target-mark-print)
(define-key wl-summary-mode-map "m|" 'wl-summary-target-mark-pipe)
- (define-key wl-summary-mode-map "mD" 'wl-summary-target-mark-erase)
+ (define-key wl-summary-mode-map "mD" 'wl-summary-target-mark-delete)
;; region commands
(define-key wl-summary-mode-map "r" (make-sparse-keymap))
(define-key wl-summary-mode-map "r*" 'wl-summary-target-mark-region)
(define-key wl-summary-mode-map "ro" 'wl-summary-refile-region)
(define-key wl-summary-mode-map "rO" 'wl-summary-copy-region)
- (define-key wl-summary-mode-map "rd" 'wl-summary-delete-region)
- (define-key wl-summary-mode-map "rD" 'wl-summary-erase-region)
+ (define-key wl-summary-mode-map "rd" 'wl-summary-dispose-region)
+ (define-key wl-summary-mode-map "rD" 'wl-summary-delete-region)
(define-key wl-summary-mode-map "ru" 'wl-summary-unmark-region)
(define-key wl-summary-mode-map "r!" 'wl-summary-mark-as-unread-region)
(define-key wl-summary-mode-map "r$" 'wl-summary-mark-as-important-region)
(wl-thread-get-entity (car targets))))
(progn
(wl-summary-jump-to-msg (car targets))
- (wl-summary-prefetch))
+ (wl-summary-prefetch-msg
+ (wl-summary-message-number)))
(wl-summary-prefetch-msg (car targets))))
(if (if prefetch-marks
(string= mark elmo-msgdb-unread-cached-mark)
(message "Prefetched %d/%d message(s)" count length)
(cons count length)))))
-(defun wl-summary-prefetch-region (beg end)
- (interactive "r")
- (wl-summary-mark-region-subr 'wl-summary-prefetch beg end))
-
-(defun wl-summary-prefetch (&optional number)
- "Prefetch current message."
- (interactive)
- (wl-summary-set-mark "i" number (interactive-p) nil))
-
(defun wl-summary-delete-marks-on-buffer (marks)
(while marks
(wl-summary-unmark (pop marks))))
(wl-summary-delete-marks-on-buffer copies))
;;;
-
(defun wl-summary-delete-all-target-marks ()
(wl-summary-delete-marks-on-buffer wl-summary-buffer-target-mark-list))
(if wl-summary-highlight (wl-highlight-summary-current-line)))
(forward-line 1)))))
-(defun wl-summary-get-delete-folder (folder)
- (if (string= folder wl-trash-folder)
- 'null
- (let* ((type (or (wl-get-assoc-list-value wl-delete-folder-alist folder)
- 'trash)))
- (cond ((stringp type)
- type)
- ((or (equal type 'remove) (equal type 'null))
- 'null)
- (t;; (equal type 'trash)
- (let ((trash-folder (wl-folder-get-elmo-folder wl-trash-folder)))
- (unless (elmo-folder-exists-p trash-folder)
- (if (y-or-n-p
- (format "Trash Folder %s does not exist, create it? "
- wl-trash-folder))
- (elmo-folder-create trash-folder)
- (error "Trash Folder is not created"))))
- wl-trash-folder)))))
-
(defun wl-summary-insert-message (&rest args)
(if (eq wl-summary-buffer-view 'thread)
(apply 'wl-summary-insert-thread args)
(wl-thread-make-indent-string thr-entity)
(wl-thread-entity-get-linked thr-entity)))))))
-;; Set mark
-(defun wl-summary-set-mark (&optional set-mark number interactive data)
- (interactive)
- "Set temporary mark SET-MARK on the message with NUMBER.
-NUMBER is the message number to set the mark on.
-INTERACTIVE is set as t if it have to run interactively.
-DATA is passed to the set-action function of the action as an argument.
-Return number if put mark succeed"
- (let* ((set-mark (or set-mark
- (completing-read "Mark: " wl-summary-mark-action-list)))
- (current (wl-summary-message-number))
- (action (assoc set-mark wl-summary-mark-action-list))
- visible mark)
- (save-excursion
- ;; Put mark
- (setq visible (or
- ;; not-interactive and visible
- (and number (wl-summary-jump-to-msg number))
- ;; interactive
- (and (null number) current))
- number (or number current))
- ;; Put mark on the current line.
- (funcall (nth 1 action) (nth 0 action) number visible
- (or interactive (interactive-p)) data)
- (set-buffer-modified-p nil))
- ;; Move the cursor.
- (if (or interactive (interactive-p))
- (if (eq wl-summary-move-direction-downward nil)
- (wl-summary-prev)
- (wl-summary-next)))
- ;; Return value.
- number))
-
-(defun wl-summary-register-target-mark (number)
- (or (memq number wl-summary-buffer-target-mark-list)
- (setq wl-summary-buffer-target-mark-list
- (cons number wl-summary-buffer-target-mark-list))))
-
-(defun wl-summary-unregister-target-mark (number)
- (delq number wl-summary-buffer-target-mark-list))
-
-(defun wl-summary-have-target-mark-p (number)
- (memq number wl-summary-buffer-target-mark-list))
-
-;; wl-summary-buffer-temp-mark-list specification
-;; ((1 "D" nil)(2 "o" "+fuga")(3 "O" "+hoge"))
-(defun wl-summary-register-temp-mark (number mark mark-info)
- (let ((elem (assq number wl-summary-buffer-temp-mark-list)))
- (setq wl-summary-buffer-temp-mark-list
- (delq elem wl-summary-buffer-temp-mark-list)))
- (setq wl-summary-buffer-temp-mark-list
- (cons (list number mark mark-info) wl-summary-buffer-temp-mark-list)))
-
-(defun wl-summary-unregister-temp-mark (number)
- (let ((elem (assq number wl-summary-buffer-temp-mark-list)))
- (setq wl-summary-buffer-temp-mark-list
- (delq elem wl-summary-buffer-temp-mark-list))))
-
-(defun wl-summary-registered-temp-mark (number)
- (assq number wl-summary-buffer-temp-mark-list))
-
-(defun wl-summary-collect-temp-mark (mark &optional begin end)
- (if (or begin end)
- (save-excursion
- (save-restriction
- (let (mark-list)
- (narrow-to-region (or begin (point-min))(or end (point-max)))
- (goto-char (point-min))
- ;; for thread...
- (if (eq wl-summary-buffer-view 'thread)
- (let (number entity mark-info)
- (while (not (eobp))
- (setq number (wl-summary-message-number)
- entity (wl-thread-get-entity number)
- mark-info (wl-summary-registered-temp-mark number))
- ;; toplevel message mark.
- (when (string= (nth 1 mark-info) mark)
- (setq mark-list (cons mark-info mark-list)))
- ;; When thread is closed...children should also be checked.
- (unless (wl-thread-entity-get-opened entity)
- (dolist (msg (wl-thread-get-children-msgs number))
- (setq mark-info (wl-summary-registered-temp-mark
- msg))
- (when (string= (nth 1 mark-info) mark)
- (setq mark-list (cons mark-info mark-list)))))
- (forward-line 1)))
- (let (number mark-info)
- (while (not (eobp))
- (setq number (wl-summary-message-number)
- mark-info (wl-summary-registered-temp-mark number))
- (when (string= (nth 1 mark-info) mark)
- (setq mark-list (cons mark-info mark-list)))
- (forward-line 1))))
- mark-list)))
- (let (mark-list)
- (dolist (mark-info wl-summary-buffer-temp-mark-list)
- (when (string= (nth 1 mark-info) mark)
- (setq mark-list (cons mark-info mark-list))))
- mark-list)))
-
-;; Unset mark
-(defun wl-summary-unset-mark (&optional number interactive)
- "Unset temporary mark of the message with NUMBER.
-NUMBER is the message number to unset the mark.
-If not specified, the message on the cursor position is treated.
-Optional INTERACTIVE is non-nil when it should be called interactively.
-Return number if put mark succeed"
- (interactive)
- (save-excursion
- (beginning-of-line)
- (let ((buffer-read-only nil)
- visible mark action)
- (if number
- (setq visible (wl-summary-jump-to-msg number))
- (setq visible t))
- (setq number (or number (wl-summary-message-number)))
- ;; Delete mark on buffer.
- (when visible
- (setq mark (wl-summary-temp-mark))
- (unless (string= mark " ")
- (delete-backward-char 1)
- (insert (or (wl-summary-get-score-mark number)
- " "))
- (setq action (assoc mark wl-summary-mark-action-list))
- (funcall (nth 2 action) number))
- (set-buffer-modified-p nil))
- ;; Remove from temporal mark structure.
- (wl-summary-unregister-target-mark number)
- (wl-summary-unregister-temp-mark number)))
- ;; Move the cursor.
- ;; (if (or interactive (interactive-p))
- ;; (if (eq wl-summary-move-direction-downward nil)
- ;; (wl-summary-prev)
- ;; (wl-summary-next))))
- )
-
-(defun wl-summary-make-destination-numbers-list (mark-list)
- (let (dest-numbers dest-number)
- (dolist (elem mark-list)
- (setq dest-number (assoc (nth 2 elem) dest-numbers))
- (if dest-number
- (unless (memq (car elem) (cdr dest-number))
- (nconc dest-number (list (car elem))))
- (setq dest-numbers (nconc dest-numbers
- (list
- (list (nth 2 elem)
- (car elem)))))))
- dest-numbers))
-
-(defun wl-summary-move-mark-list-messages (mark-list folder-name message)
- (if (null mark-list)
- (message "No marks")
- (save-excursion
- (let ((start (point))
- (refiles (mapcar 'car mark-list))
- (refile-failures 0)
- refile-len
- dst-msgs ; loop counter
- result)
- ;; begin refile...
- (setq refile-len (length refiles))
- (goto-char start) ; avoid moving cursor to
- ; the bottom line.
- (when (> refile-len elmo-display-progress-threshold)
- (elmo-progress-set 'elmo-folder-move-messages
- refile-len message))
- (setq result nil)
- (condition-case nil
- (setq result (elmo-folder-move-messages
- wl-summary-buffer-elmo-folder
- refiles
- (if (eq folder-name 'null)
- 'null
- (wl-folder-get-elmo-folder folder-name))
- (wl-summary-buffer-msgdb)
- (not (null (cdr dst-msgs)))
- nil ; no-delete
- nil ; same-number
- t))
- (error nil))
- (when result ; succeeded.
- ;; update buffer.
- (wl-summary-delete-messages-on-buffer refiles)
- ;; update wl-summary-buffer-temp-mark-list.
- (dolist (mark-info mark-list)
- (setq wl-summary-buffer-temp-mark-list
- (delq mark-info wl-summary-buffer-temp-mark-list))))
- (elmo-progress-clear 'elmo-folder-move-messages)
- (wl-summary-set-message-modified)
- ;; Return the operation failed message numbers.
- (if result
- 0
- (length refiles))))))
-
-;;; Actions
-(defun wl-summary-set-action-generic (mark number visible interactive data)
- (when visible
- ;; Note that the cursor is on the target message at this moment.
- (let ((cur-mark (wl-summary-temp-mark)))
- (if (wl-summary-reserve-temp-mark-p cur-mark)
- (if interactive
- (error "%s is already marked as `%s'" number cur-mark))
- ;; Remove current mark.
- (wl-summary-unset-mark)))
- (wl-summary-mark-line mark)
- (when (and visible
- wl-summary-highlight)
- (wl-highlight-summary-current-line)))
- (wl-summary-register-temp-mark number mark nil))
-
-(defun wl-summary-unset-action-generic (number)
- ;; Just unhighlight.
- (when wl-summary-highlight
- (wl-highlight-summary-current-line)))
-
-;; Target mark handling.
-(defun wl-summary-set-target-mark (mark number visible interactive data)
- (when visible
- ;; Note that the cursor is on the target message at this moment.
- (let ((cur-mark (wl-summary-temp-mark)))
- (if (wl-summary-reserve-temp-mark-p cur-mark)
- (if interactive
- (error "%s is already marked as `%s'" number cur-mark))
- ;; Remove current mark.
- (wl-summary-unset-mark)))
- (wl-summary-mark-line mark)
- (when (and visible
- wl-summary-highlight)
- (wl-highlight-summary-current-line)))
- (wl-summary-register-target-mark number))
-
-(defun wl-summary-unset-target-mark (number)
- ;; Just unhighlight.
- (when wl-summary-highlight
- (wl-highlight-summary-current-line)))
-
-;; Delete action.
-(defun wl-summary-delete (&optional number)
- (interactive)
- (wl-summary-set-mark "d" number (interactive-p)))
-
-(defun wl-summary-delete-region (beg end)
- (interactive "r")
- (wl-summary-mark-region-subr 'wl-summary-delete beg end))
-
-(defun wl-summary-target-mark-delete ()
- (interactive)
- (wl-summary-target-mark-replace "d"))
-
-(defun wl-summary-exec-action-delete (mark-list)
- (wl-summary-move-mark-list-messages mark-list
- (wl-summary-get-delete-folder
- (wl-summary-buffer-folder-name))
- "Deleting messages..."))
-
-;; Erase action.
-(defun wl-summary-erase (&optional number)
- (interactive)
- (wl-summary-set-mark "D" number (interactive-p)))
-
-(defun wl-summary-target-mark-erase ()
- (interactive)
- (wl-summary-target-mark-replace "D"))
-
-(defun wl-summary-erase-region (beg end)
- (interactive "r")
- (wl-summary-mark-region-subr 'wl-summary-erase beg end))
-
-(defun wl-summary-exec-action-erase (mark-list)
- (wl-summary-move-mark-list-messages mark-list
- 'null
- "Erasing messages..."))
-
-;; Refile action
-(defun wl-summary-refile (&optional dst number)
- "Put refile mark on current line message.
-If optional argument DST is specified, put mark without asking
-destination folder.
-If optional argument NUMBER is specified, mark message specified by NUMBER.
-
-If folder is read-only, message should be copied.
-See `wl-refile-policy-alist' for more details."
- (interactive)
- (let ((policy (wl-get-assoc-list-value wl-refile-policy-alist
- (wl-summary-buffer-folder-name))))
- (cond ((eq policy 'copy)
- (wl-summary-set-mark "O" number (interactive-p) dst)
- (run-hooks 'wl-summary-copy-hook))
- (t
- (wl-summary-set-mark "o" number (interactive-p) dst)
- (run-hooks 'wl-summary-refile-hook)))))
-
-(defun wl-summary-refile-region (beg end)
- "Put refile mark on messages in the region specified by BEG and END."
- (interactive "r")
- (wl-summary-refile-region-subr "refile" beg end))
-
-(defun wl-summary-target-mark-refile ()
- (interactive)
- (wl-summary-target-mark-refile-subr "refile" "o"))
-
-(defun wl-summary-set-action-refile (mark number visible interactive data)
- (wl-summary-set-action-refile-subr
- 'refile mark number visible interactive data))
-
-(defun wl-summary-set-action-refile-subr (copy-or-refile
- mark number visible
- interactive dst)
- (let* ((buffer-num (wl-summary-message-number))
- (msg-num (or number buffer-num))
- (msgid (and msg-num
- (elmo-message-field wl-summary-buffer-elmo-folder
- msg-num 'message-id)))
- (entity (and msg-num
- (elmo-msgdb-overview-get-entity
- msg-num (wl-summary-buffer-msgdb))))
- folder cur-mark already tmp-folder)
- (catch 'done
- (when (null entity)
- ;; msgdb is empty?
- (if interactive
- (message "Cannot refile."))
- (throw 'done nil))
- (when (null msg-num)
- (if interactive
- (message "No message."))
- (throw 'done nil))
- (when (setq cur-mark (nth 1 (wl-summary-registered-temp-mark number)))
- (when (wl-summary-reserve-temp-mark-p cur-mark)
- (if interactive
- (error "Already marked as `%s'" cur-mark))
- (throw 'done nil)))
- (setq folder (and msg-num
- (or dst (wl-summary-read-folder
- (or (wl-refile-guess entity) wl-trash-folder)
- (format "for %s " copy-or-refile)))))
- ;; Cache folder hack by okada@opaopa.org
- (when (and (eq (elmo-folder-type-internal
- (wl-folder-get-elmo-folder
- (wl-folder-get-realname folder))) 'cache)
- (not (string= folder
- (setq tmp-folder
- (concat "'cache/"
- (elmo-cache-get-path-subr
- (elmo-msgid-to-cache msgid)))))))
- (setq folder tmp-folder)
- (message "Force refile to %s." folder))
- (if (string= folder (wl-summary-buffer-folder-name))
- (error "Same folder"))
- (if (or (not (elmo-folder-writable-p (wl-folder-get-elmo-folder folder)))
- (string= folder wl-queue-folder)
- (string= folder wl-draft-folder))
- (error "Don't set as target: %s" folder))
- ;; learn for refile.
- (when (eq copy-or-refile 'refile)
- (wl-refile-learn entity folder))
- (wl-summary-unset-mark msg-num)
- (when visible
- (wl-summary-mark-line mark)
- (when wl-summary-highlight
- (wl-highlight-summary-current-line))
- ;; print refile destination
- (wl-summary-print-destination msg-num folder))
- (wl-summary-register-temp-mark msg-num mark folder)
- (setq wl-summary-buffer-prev-refile-destination folder)
- msg-num)))
-
-(defun wl-summary-unset-action-refile (number)
- ;; Just unhighlight.
- (when wl-summary-highlight
- (wl-highlight-summary-current-line))
- (wl-summary-remove-destination))
-
-(defun wl-summary-exec-action-refile (mark-list)
- (save-excursion
- (let ((del-fld (wl-summary-get-delete-folder
- (wl-summary-buffer-folder-name)))
- (start (point))
- (failures 0)
- (refile-len (length mark-list))
- dst-msgs ; loop counter
- result)
- ;; begin refile...
- (setq dst-msgs
- (wl-summary-make-destination-numbers-list mark-list))
- (goto-char start) ; avoid moving cursor to the bottom line.
- (when (> refile-len elmo-display-progress-threshold)
- (elmo-progress-set 'elmo-folder-move-messages
- refile-len "Moving messages..."))
- (while dst-msgs
- (setq result nil)
- (condition-case nil
- (setq result (elmo-folder-move-messages
- wl-summary-buffer-elmo-folder
- (cdr (car dst-msgs))
- (wl-folder-get-elmo-folder
- (car (car dst-msgs)))
- (wl-summary-buffer-msgdb)
- (not (null (cdr dst-msgs)))
- nil ; no-delete
- nil ; same-number
- t))
- (error nil))
- (if result ; succeeded.
- (progn
- ;; update buffer.
- (wl-summary-delete-messages-on-buffer (cdr (car dst-msgs)))
- (setq wl-summary-buffer-temp-mark-list
- (wl-delete-associations
- (cdr (car dst-msgs))
- wl-summary-buffer-temp-mark-list)))
- (setq failures
- (+ failures (length (cdr (car dst-msgs))))))
- (setq dst-msgs (cdr dst-msgs)))
- (elmo-progress-clear 'elmo-folder-move-messages)
- failures)))
-
-;; Copy action
-(defun wl-summary-copy (&optional dst number)
- "Put copy mark on current line message.
-If optional argument DST is specified, put mark without asking
-destination folder.
-If optional argument NUMBER is specified, mark message specified by NUMBER."
- (interactive)
- (wl-summary-set-mark "O" number (interactive-p) dst))
-
-(defun wl-summary-target-mark-copy ()
- (interactive)
- (wl-summary-target-mark-refile-subr "copy" "O"))
-
-(defun wl-summary-copy-region (beg end)
- "Put copy mark on messages in the region specified by BEG and END."
- (interactive "r")
- (wl-summary-refile-region-subr "copy" beg end))
-
-(defun wl-summary-set-action-copy (mark number visible interactive data)
- (wl-summary-set-action-refile-subr
- 'copy mark number visible interactive data))
-
-(defun wl-summary-unset-action-copy (number)
- ;; Just unhighlight.
- (when wl-summary-highlight
- (wl-highlight-summary-current-line))
- (wl-summary-remove-destination))
-
-(defun wl-summary-exec-action-copy (mark-list)
- (save-excursion
- (let ((del-fld (wl-summary-get-delete-folder
- (wl-summary-buffer-folder-name)))
- (start (point))
- (failures 0)
- (refile-len (length mark-list))
- dst-msgs ; loop counter
- result)
- ;; begin refile...
- (setq dst-msgs
- (wl-summary-make-destination-numbers-list mark-list))
- (goto-char start) ; avoid moving cursor to the bottom line.
- (when (> refile-len elmo-display-progress-threshold)
- (elmo-progress-set 'elmo-folder-move-messages
- refile-len "Copying messages..."))
- (while dst-msgs
- (setq result nil)
- (condition-case nil
- (setq result (elmo-folder-move-messages
- wl-summary-buffer-elmo-folder
- (cdr (car dst-msgs))
- (wl-folder-get-elmo-folder
- (car (car dst-msgs)))
- (wl-summary-buffer-msgdb)
- (not (null (cdr dst-msgs)))
- t ; t is no-delete (copy)
- nil ; same-number
- t))
- (error nil))
- (if result ; succeeded.
- (progn
- ;; update buffer.
- (wl-summary-delete-copy-marks-on-buffer (cdr (car dst-msgs)))
- (setq wl-summary-buffer-temp-mark-list
- (wl-delete-associations
- (cdr (car dst-msgs))
- wl-summary-buffer-temp-mark-list)))
- (setq failures
- (+ failures (length (cdr (car dst-msgs))))))
- (setq dst-msgs (cdr dst-msgs)))
- (elmo-progress-clear 'elmo-folder-move-messages)
- failures)))
-
-;; Prefetch.
-(defun wl-summary-target-mark-prefetch ()
- (interactive)
- (wl-summary-target-mark-replace "i"))
-
-(defun wl-summary-exec-action-prefetch (mark-list)
- (save-excursion
- (let* ((buffer-read-only nil)
- (count 0)
- (length (length mark-list))
- (mark-list-copy (copy-sequence mark-list))
- (pos (point))
- (failures 0)
- new-mark)
- (dolist (mark-info mark-list-copy)
- (message "Prefetching...(%d/%d)"
- (setq count (+ 1 count)) length)
- (setq new-mark (wl-summary-prefetch-msg (car mark-info)))
- (if new-mark
- (progn
- (wl-summary-unset-mark (car mark-info))
- (when (wl-summary-jump-to-msg (car mark-info))
- (wl-summary-persistent-mark) ; move
- (delete-backward-char 1)
- (insert new-mark)
- (when wl-summary-highlight
- (wl-highlight-summary-current-line))
- (save-excursion
- (goto-char pos)
- (sit-for 0))))
- (incf failures)))
- (message "Prefetching...done")
- 0)))
-
-(defun wl-summary-remove-destination ()
- (save-excursion
- (let ((inhibit-read-only t)
- (buffer-read-only nil)
- (buf (current-buffer))
- sol eol rs re)
- (beginning-of-line)
- (setq sol (point))
- (search-forward "\r")
- (forward-char -1)
- (setq eol (point))
- (setq rs (next-single-property-change sol 'wl-summary-destination
- buf eol))
- (setq re (next-single-property-change rs 'wl-summary-destination
- buf eol))
- (put-text-property rs re 'wl-summary-destination nil)
- (put-text-property rs re 'invisible nil)
- (goto-char re)
- (delete-char (- eol re)))))
-
-(defun wl-summary-collect-numbers-region (begin end)
- "Return a list of message number in the region specified by BEGIN and END."
- (save-excursion
- (save-restriction
- (let (numbers)
- (narrow-to-region (or begin (point-min))(or end (point-max)))
- (goto-char (point-min))
- ;; for thread...
- (if (eq wl-summary-buffer-view 'thread)
- (let (number entity mark-info)
- (while (not (eobp))
- (setq numbers (cons (wl-summary-message-number) numbers)
- entity (wl-thread-get-entity number))
- ;; When thread is closed...children should also be checked.
- (unless (wl-thread-entity-get-opened entity)
- (dolist (msg (wl-thread-get-children-msgs number))
- (setq numbers (cons msg numbers))))
- (forward-line 1)))
- (let (number mark-info)
- (while (not (eobp))
- (setq numbers (cons (wl-summary-message-number) numbers))
- (forward-line 1))))
- numbers))))
-
-(defun wl-summary-exec (&optional numbers)
- (interactive)
- (let ((failures 0)
- collected pair action modified)
- (dolist (action wl-summary-mark-action-list)
- (setq collected (cons (cons (car action) nil) collected)))
- (dolist (mark-info wl-summary-buffer-temp-mark-list)
- (if numbers
- (when (memq (nth 0 mark-info) numbers)
- (setq pair (assoc (nth 1 mark-info) collected)))
- (setq pair (assoc (nth 1 mark-info) collected)))
- (setq pair (assoc (nth 1 mark-info) collected))
- (setcdr pair (cons mark-info (cdr pair))))
- ;; collected is a pair of
- ;; mark-string and a list of mark-info
- (dolist (pair collected)
- (setq action (assoc (car pair) wl-summary-mark-action-list))
- (when (and (cdr pair) (nth 3 action))
- (setq modified t)
- (setq failures (+ failures (funcall (nth 3 action) (cdr pair))))))
- (when modified
- (wl-summary-set-message-modified))
- (run-hooks 'wl-summary-exec-hook)
- ;; message buffer is not up-to-date
- (unless (and wl-message-buffer
- (eq (wl-summary-message-number)
- (with-current-buffer wl-message-buffer
- wl-message-buffer-cur-number)))
- (wl-summary-toggle-disp-msg 'off)
- (setq wl-message-buffer nil))
- (set-buffer-modified-p nil)
- (message "Executing...done%s"
- (if (> failures 0)
- (format " (%d failed)" failures)
- ""))))
-
-(defun wl-summary-exec-region (beg end)
- (interactive "r")
- (wl-summary-exec
- (wl-summary-collect-numbers-region beg end)))
-
-(defun wl-summary-read-folder (default &optional purpose ignore-error
- no-create init)
- (let ((fld (completing-read
- (format "Folder name %s(%s): " (or purpose "")
- default)
- 'wl-folder-complete-folder
- nil nil (or init wl-default-spec)
- 'wl-read-folder-hist)))
- (if (or (string= fld wl-default-spec)
- (string= fld ""))
- (setq fld default))
- (setq fld (elmo-string (wl-folder-get-realname fld)))
- (if (string-match "\n" fld)
- (error "Not supported folder name: %s" fld))
- (unless no-create
- (if ignore-error
- (condition-case nil
- (wl-folder-confirm-existence
- (wl-folder-get-elmo-folder
- fld))
- (error))
- (wl-folder-confirm-existence (wl-folder-get-elmo-folder
- fld))))
- fld))
-
-(defun wl-summary-print-destination (msg-num folder)
- "Print refile destination on line."
- (wl-summary-remove-destination)
- (save-excursion
- (let ((inhibit-read-only t)
- (folder (copy-sequence folder))
- (buffer-read-only nil)
- len rs re c)
- (setq len (string-width folder))
- (if (< len 1) ()
- ;;(end-of-line)
- (beginning-of-line)
- (search-forward "\r")
- (forward-char -1)
- (setq re (point))
- (setq c 0)
- (while (< c len)
- (forward-char -1)
- (setq c (+ c (char-width (following-char)))))
- (and (> c len) (setq folder (concat " " folder)))
- (setq rs (point))
- (when wl-summary-width
- (put-text-property rs re 'invisible t))
- (put-text-property rs re 'wl-summary-destination t)
- (goto-char re)
- (wl-highlight-refile-destination-string folder)
- (insert folder)
- (set-buffer-modified-p nil)))))
-
-(defsubst wl-summary-reserve-temp-mark-p (mark)
- "Return t if temporal MARK should be reserved."
- (member mark wl-summary-reserve-mark-list))
-
-(defun wl-summary-refile-prev-destination ()
- "Refile message to previously refiled destination."
- (interactive)
- (wl-summary-refile wl-summary-buffer-prev-refile-destination
- (wl-summary-message-number))
- (if (eq wl-summary-move-direction-downward nil)
- (wl-summary-prev)
- (wl-summary-next)))
-
-(defsubst wl-summary-no-auto-refile-message-p (msg)
- (member (elmo-msgdb-get-mark (wl-summary-buffer-msgdb) msg)
- wl-summary-auto-refile-skip-marks))
-
-(defun wl-summary-auto-refile (&optional open-all)
- "Set refile mark automatically according to 'wl-refile-guess-by-rule'."
- (interactive "P")
- (message "Marking...")
- (save-excursion
- (if (and (eq wl-summary-buffer-view 'thread)
- open-all)
- (wl-thread-open-all))
- (let* ((spec (wl-summary-buffer-folder-name))
- checked-dsts
- (count 0)
- number dst thr-entity)
- (goto-line 1)
- (while (not (eobp))
- (setq number (wl-summary-message-number))
- (dolist (number (cons number
- (and (eq wl-summary-buffer-view 'thread)
- ;; process invisible children.
- (not (wl-thread-entity-get-opened
- (setq thr-entity
- (wl-thread-get-entity number))))
- (wl-thread-entity-get-descendant
- thr-entity))))
- (when (and (not (wl-summary-no-auto-refile-message-p
- number))
- (setq dst
- (wl-folder-get-realname
- (wl-refile-guess-by-rule
- (elmo-msgdb-overview-get-entity
- number (wl-summary-buffer-msgdb)))))
- (not (equal dst spec))
- (let ((pair (assoc dst checked-dsts))
- ret)
- (if pair
- (cdr pair)
- (setq ret
- (condition-case nil
- (progn
- (wl-folder-confirm-existence
- (wl-folder-get-elmo-folder dst))
- t)
- (error)))
- (setq checked-dsts (cons (cons dst ret) checked-dsts))
- ret)))
- (if (wl-summary-refile dst number)
- (incf count))
- (message "Marking...%d message(s)." count)))
- (forward-line))
- (if (eq count 0)
- (message "No message was marked.")
- (message "Marked %d message(s)." count)))))
-
-(defun wl-summary-unmark (&optional number)
- "Unmark marks (temporary, refile, copy, delete)of current line.
-If optional argument NUMBER is specified, unmark message specified by NUMBER."
- (interactive)
- (wl-summary-unset-mark number (interactive-p)))
-
-(defun wl-summary-target-mark (&optional number)
- "Put target mark '*' on current message.
-If optional argument NUMBER is specified, mark message specified by NUMBER."
- (interactive)
- (wl-summary-set-mark "*" number (interactive-p)))
-
-(defun wl-summary-refile-region-subr (copy-or-refile beg end)
- (save-excursion
- (save-restriction
- (goto-char beg)
- ;; guess by first msg
- (let* ((msgid (cdr (assq (wl-summary-message-number)
- (elmo-msgdb-get-number-alist
- (wl-summary-buffer-msgdb)))))
- (function (intern (format "wl-summary-%s" copy-or-refile)))
- (entity (assoc msgid (elmo-msgdb-get-overview
- (wl-summary-buffer-msgdb))))
- folder)
- (if entity
- (setq folder (wl-summary-read-folder (wl-refile-guess entity)
- (format "for %s"
- copy-or-refile))))
- (narrow-to-region beg end)
- (if (eq wl-summary-buffer-view 'thread)
- (progn
- (while (not (eobp))
- (let* ((number (wl-summary-message-number))
- (entity (wl-thread-get-entity number))
- children)
- (if (wl-thread-entity-get-opened entity)
- ;; opened...refile line.
- (funcall function folder number)
- ;; closed
- (setq children (wl-thread-get-children-msgs number))
- (while children
- (funcall function folder (pop children))))
- (forward-line 1))))
- (while (not (eobp))
- (funcall function folder (wl-summary-message-number))
- (forward-line 1)))))))
-
-(defun wl-summary-unmark-region (beg end)
- (interactive "r")
- (save-excursion
- (save-restriction
- (narrow-to-region beg end)
- (goto-char (point-min))
- (if (eq wl-summary-buffer-view 'thread)
- (progn
- (while (not (eobp))
- (let* ((number (wl-summary-message-number))
- (entity (wl-thread-get-entity number)))
- (if (wl-thread-entity-get-opened entity)
- ;; opened...unmark line.
- (wl-summary-unmark)
- ;; closed
- (wl-summary-delete-marks-on-buffer
- (wl-thread-get-children-msgs number))))
- (forward-line 1)))
- (while (not (eobp))
- (wl-summary-unmark)
- (forward-line 1))))))
-
-(defun wl-summary-mark-region-subr (function beg end)
- (save-excursion
- (save-restriction
- (narrow-to-region beg end)
- (goto-char (point-min))
- (if (eq wl-summary-buffer-view 'thread)
- (progn
- (while (not (eobp))
- (let* ((number (wl-summary-message-number))
- (entity (wl-thread-get-entity number))
- (wl-summary-move-direction-downward t)
- children)
- (if (wl-thread-entity-get-opened entity)
- ;; opened...delete line.
- (funcall function number)
- ;; closed
- (setq children (wl-thread-get-children-msgs number))
- (while children
- (funcall function (pop children))))
- (forward-line 1))))
- (while (not (eobp))
- (funcall function (wl-summary-message-number))
- (forward-line 1))))))
-
-(defun wl-summary-target-mark-region (beg end)
- (interactive "r")
- (wl-summary-mark-region-subr 'wl-summary-target-mark beg end))
-
-(defun wl-summary-target-mark-all ()
- (interactive)
- (wl-summary-target-mark-region (point-min) (point-max))
- (setq wl-summary-buffer-target-mark-list
- (mapcar 'car
- (elmo-msgdb-get-number-alist (wl-summary-buffer-msgdb)))))
-
-(defun wl-summary-delete-all-mark (mark)
- (goto-char (point-min))
- (while (not (eobp))
- (when (string= (wl-summary-temp-mark) mark)
- (wl-summary-unmark))
- (forward-line 1))
- (let (deleted)
- (dolist (mark-info wl-summary-buffer-temp-mark-list)
- (when (string= (nth 1 mark-info) mark)
- (setq deleted (cons mark-info deleted))))
- (dolist (delete deleted)
- (setq wl-summary-buffer-temp-mark-list
- (delq delete wl-summary-buffer-temp-mark-list)))))
-
-(defun wl-summary-unmark-all ()
- "Unmark all according to what you input."
- (interactive)
- (let ((unmarks (string-to-char-list (read-from-minibuffer "Unmark: ")))
- cur-mark)
- (save-excursion
- (while unmarks
- (setq cur-mark (char-to-string (car unmarks)))
- (wl-summary-delete-all-mark cur-mark)
- (setq unmarks (cdr unmarks))))))
-
-(defun wl-summary-target-mark-thread ()
- (interactive)
- (wl-thread-call-region-func 'wl-summary-target-mark-region t))
-
(defun wl-summary-target-mark-msgs (msgs)
"Return the number of marked messages."
(let ((i 0) num)
(delete-backward-char 1)
(insert mark))))
-(defun wl-summary-target-mark-replace (mark)
- (save-excursion
- (goto-char (point-min))
- (let (number mlist)
- (while (not (eobp))
- (when (string= (wl-summary-temp-mark) "*")
- (let (wl-summary-buffer-disp-msg)
- (when (setq number (wl-summary-message-number))
- (wl-summary-set-mark mark number)
- (setq wl-summary-buffer-target-mark-list
- (delq number wl-summary-buffer-target-mark-list)))))
- (forward-line 1))
- (setq mlist wl-summary-buffer-target-mark-list)
- (while mlist
- (wl-summary-register-temp-mark (car mlist) mark nil)
- (setq wl-summary-buffer-target-mark-list
- (delq (car mlist) wl-summary-buffer-target-mark-list))
- (setq mlist (cdr mlist))))))
-
-(defun wl-summary-target-mark-refile-subr (copy-or-refile mark)
- (let ((numlist wl-summary-buffer-number-list)
- (function
- (intern (format "wl-summary-%s" copy-or-refile)))
- regexp number msgid entity folder mlist)
- (save-excursion
- ;; guess by first mark
- (while numlist
- (if (memq (car numlist) wl-summary-buffer-target-mark-list)
- (setq number (car numlist)
- numlist nil))
- (setq numlist (cdr numlist)))
- (when number
- (setq msgid (elmo-message-field wl-summary-buffer-elmo-folder
- number 'message-id)
- entity (elmo-msgdb-overview-get-entity
- number (wl-summary-buffer-msgdb)))
- (if (null entity)
- (error "Cannot %s" copy-or-refile))
- (setq folder (wl-summary-read-folder
- (wl-refile-guess entity)
- (format "for %s" copy-or-refile)))
- (goto-char (point-min))
- (while (not (eobp))
- (when (string= (wl-summary-temp-mark) "*")
- (let (wl-summary-buffer-disp-msg)
- (when (setq number (wl-summary-message-number))
- (funcall function folder number)
- (setq wl-summary-buffer-target-mark-list
- (delq number wl-summary-buffer-target-mark-list)))))
- (forward-line 1))
- ;; process invisible messages.
- (setq mlist wl-summary-buffer-target-mark-list)
- (while mlist
- (wl-summary-register-temp-mark (car mlist) mark folder)
- (setq wl-summary-buffer-target-mark-list
- (delq (car mlist) wl-summary-buffer-target-mark-list))
- (setq mlist (cdr mlist)))))))
-
(defun wl-summary-next-buffer ()
"Switch to next summary buffer."
(interactive)
projects / elisp / wanderlust.git / commitdiff