- (wl-thread-goto-bottom-of-sub-thread)))
- (let ((inhibit-read-only t)
- (buffer-read-only nil))
- (wl-summary-insert-line
- (wl-summary-create-line
- entity
- parent-entity
- nil
- (wl-thread-maybe-get-children-num msg)
- (wl-thread-make-indent-string thr-entity)
- (wl-thread-entity-get-linked thr-entity))))))
-
-(defun wl-summary-mark-as-unread (&optional number
- no-server-update
- no-modeline-update)
- (interactive)
- (save-excursion
- (let* (eol
- (inhibit-read-only t)
- (buffer-read-only nil)
- (folder wl-summary-buffer-elmo-folder)
- (msgdb (wl-summary-buffer-msgdb))
-;;; (number-alist (elmo-msgdb-get-number-alist msgdb))
- new-mark visible mark)
- (if number
- (progn
- (setq visible (wl-summary-jump-to-msg number))
- (unless (setq mark (elmo-msgdb-get-mark msgdb number))
- (setq mark " ")))
- ;; interactive
- (setq visible t))
- (when visible
- (if (null (wl-summary-message-number))
- (message "No message.")
- (end-of-line)
- (setq eol (point))
- (wl-summary-goto-previous-message-beginning)))
- (if (or (and (not visible)
- ;; already exists in msgdb.
- (assq number (elmo-msgdb-get-number-alist msgdb)))
- (re-search-forward
- (format (concat "^ *\\("
- (if number (int-to-string number)
- "-?[0-9]+")
- "\\)[^0-9]\\(%s\\|%s\\)")
- wl-summary-read-uncached-mark
- " ") eol t))
- (progn
- (setq number (or number (string-to-int (wl-match-buffer 1))))
- (setq mark (or mark (elmo-match-buffer 2)))
- (save-match-data
- (setq new-mark (if (string= mark
- wl-summary-read-uncached-mark)
- wl-summary-unread-uncached-mark
- (if (elmo-message-use-cache-p folder number)
- wl-summary-unread-mark
- wl-summary-unread-uncached-mark))))
- ;; server side mark
- (unless no-server-update
- (save-match-data
- (unless (elmo-folder-unmark-read folder (list number))
- (error "Setting mark failed"))))
- (when visible
- (delete-region (match-beginning 2) (match-end 2))
- (insert new-mark))
- (elmo-msgdb-set-mark msgdb number new-mark)
- (unless no-modeline-update
- (setq wl-summary-buffer-unread-count
- (+ 1 wl-summary-buffer-unread-count))
- (wl-summary-update-modeline)
- (wl-folder-update-unread
- (wl-summary-buffer-folder-name)
- (+ wl-summary-buffer-unread-count
- wl-summary-buffer-new-count)))
- (wl-summary-set-mark-modified)
- (if (and visible wl-summary-highlight)
- (wl-highlight-summary-current-line))))))
- (set-buffer-modified-p nil))
-
-(defun wl-summary-delete (&optional number)
- "Mark Delete mark 'D'.
-If optional argument NUMBER is specified, mark message specified by NUMBER."
- (interactive)
- (let* ((buffer-num (wl-summary-message-number))
- (msg-num (or number buffer-num))
- mark)
- (catch 'done
- (when (null msg-num)
- (if (interactive-p)
- (message "No message."))
- (throw 'done nil))
- (when (setq mark (wl-summary-get-mark msg-num))
- (when (wl-summary-reserve-temp-mark-p mark)
- (if (interactive-p)
- (error "Already marked as `%s'" mark))
- (throw 'done nil))
- (wl-summary-unmark msg-num))
- (if (or (interactive-p)
- (eq number buffer-num))
- (wl-summary-mark-line "D"))
- (setq wl-summary-buffer-delete-list
- (cons msg-num wl-summary-buffer-delete-list))
- (if (interactive-p)
- (if (eq wl-summary-move-direction-downward nil)
- (wl-summary-prev)
- (wl-summary-next)))
- msg-num)))
-
-(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))
- (end-of-line)
- (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-check-mark (msg mark)
- (let ((check-func (cond ((string= mark "o")
- 'wl-summary-msg-marked-as-refiled)
- ((string= mark "O")
- 'wl-summary-msg-marked-as-copied)
- ((string= mark "D")
- 'wl-summary-msg-marked-as-deleted)
- ((string= mark "*")
- 'wl-summary-msg-marked-as-target))))
- (if check-func
- (funcall check-func msg))))
-
-(defun wl-summary-mark-collect (mark &optional begin end)
- (save-excursion
- (save-restriction
- (let (msglist)
- (narrow-to-region (or begin (point-min))
- (or end (point-max)))
- (goto-char (point-min))
- ;; for thread...
- (if (eq wl-summary-buffer-view 'thread)
- (progn
- (while (not (eobp))
- (let* ((number (wl-summary-message-number))
- (entity (wl-thread-get-entity number))
- result)
- ;; opened...only myself is checked.
- (if (wl-summary-check-mark number mark)
- (wl-append msglist (list number)))
- (unless (wl-thread-entity-get-opened entity)
- ;; closed...children is also checked.
- (if (setq result (wl-thread-get-children-msgs-with-mark
- number
- mark))
- (wl-append msglist result)))
- (forward-line 1)))
- (elmo-uniq-list msglist))
- (let* ((case-fold-search nil)
- (re (format (concat wl-summary-message-regexp "%s")
- (regexp-quote mark))))
- (while (re-search-forward re nil t)
- (setq msglist (cons (wl-summary-message-number) msglist)))
- (nreverse msglist)))))))
-
-(defun wl-summary-exec ()
- (interactive)
- (wl-summary-exec-subr (mapcar 'car wl-summary-buffer-refile-list)
- (reverse wl-summary-buffer-delete-list)
- (mapcar 'car wl-summary-buffer-copy-list)))
-
-(defun wl-summary-exec-region (beg end)
- (interactive "r")
- (message "Collecting marks ...")
- (save-excursion
- (goto-char beg)
- (beginning-of-line)
- (setq beg (point))
- (goto-char (1- end))
- (forward-line)
- (setq end (point))
- (wl-summary-exec-subr (wl-summary-mark-collect "o" beg end)
- (wl-summary-mark-collect "D" beg end)
- (wl-summary-mark-collect "O" beg end))))
-
-(defun wl-summary-exec-subr (moves dels copies)
- (if (not (or moves dels copies))
- (message "No marks")
- (save-excursion
- (let ((del-fld (wl-summary-get-delete-folder
- (wl-summary-buffer-folder-name)))
- (start (point))
- (unread-marks (list wl-summary-unread-cached-mark
- wl-summary-unread-uncached-mark
- wl-summary-new-mark))
- (refiles (append moves dels))
- (refile-failures 0)
- (copy-failures 0)
- (copy-len (length copies))
- refile-len
- dst-msgs ; loop counter
- result)
- (message "Executing ...")
- (while dels
- (when (not (assq (car dels) wl-summary-buffer-refile-list))
- (wl-append wl-summary-buffer-refile-list
- (list (cons (car dels) del-fld)))
- (setq wl-summary-buffer-delete-list
- (delete (car dels) wl-summary-buffer-delete-list)))
- (setq dels (cdr dels)))
- ;; begin refile...
- (setq refile-len (length refiles))
- (setq dst-msgs
- (wl-inverse-alist refiles wl-summary-buffer-refile-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))
- (if (eq 'null (car (car dst-msgs)))
- 'null
- (wl-folder-get-elmo-folder
- (car (car dst-msgs))))
- (wl-summary-buffer-msgdb)
- (not (null (cdr dst-msgs)))
- nil ; no-delete
- nil ; same-number
- unread-marks
- t))
- (error nil))
- (if result ; succeeded.
- (progn
- ;; update buffer.
- (wl-summary-delete-messages-on-buffer (cdr (car dst-msgs)))
- ;; update refile-alist.
- (setq wl-summary-buffer-refile-list
- (wl-delete-associations (cdr (car dst-msgs))
- wl-summary-buffer-refile-list)))
- (setq refile-failures
- (+ refile-failures (length (cdr (car dst-msgs))))))
- (setq dst-msgs (cdr dst-msgs)))
- (elmo-progress-clear 'elmo-folder-move-messages)
- ;; end refile
- ;; begin cOpy...
- (setq dst-msgs (wl-inverse-alist copies wl-summary-buffer-copy-list))
- (when (> copy-len elmo-display-progress-threshold)
- (elmo-progress-set 'elmo-folder-move-messages
- copy-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
- unread-marks
- t))
- (error nil))
- (if result ; succeeded.
- (progn
- ;; update buffer.
- (wl-summary-delete-copy-marks-on-buffer (cdr (car dst-msgs)))
- ;; update copy-alist
- (setq wl-summary-buffer-copy-list
- (wl-delete-associations (cdr (car dst-msgs))
- wl-summary-buffer-copy-list)))
- (setq copy-failures
- (+ copy-failures (length (cdr (car dst-msgs))))))
- (setq dst-msgs (cdr dst-msgs)))
- ;; Hide progress bar.
- (elmo-progress-clear 'elmo-folder-move-messages)
- ;; end cOpy
- (wl-summary-folder-info-update)
- (wl-summary-set-message-modified)
- (wl-summary-set-mark-modified)
- (run-hooks 'wl-summary-exec-hook)
- (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))
- (set-buffer-modified-p nil)
- (message (concat "Executing ... done"
- (if (> refile-failures 0)
- (format " (%d refiling failed)" refile-failures)
- "")
- (if (> copy-failures 0)
- (format " (%d copying failed)" copy-failures)
- "")
- "."))))))
-
-(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)
- (or wl-folder-completion-function
- (if (memq 'read-folder wl-use-folder-petname)
- (wl-folder-get-entity-with-petname)
- wl-folder-entity-hashtb))
- 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)
- (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)
- (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))
- (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-get-mark (number)
- "Return a temporal mark of message specified by NUMBER."
- (or (and (memq number wl-summary-buffer-delete-list) "D")
- (and (assq number wl-summary-buffer-copy-list) "O")
- (and (assq number wl-summary-buffer-refile-list) "o")
- (and (memq number wl-summary-buffer-target-mark-list) "*")))
-
-(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 (&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)
- (if (interactive-p)
- (call-interactively 'wl-summary-copy)
- (wl-summary-copy dst number)))
- (t
- (wl-summary-refile-subr 'refile (interactive-p) dst number)))))
-
-(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-refile-subr 'copy (interactive-p) dst number))
-
-(defun wl-summary-refile-subr (copy-or-refile interactive &optional dst number)
- (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))))
- (variable
- (intern (format "wl-summary-buffer-%s-list" copy-or-refile)))
- folder 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 mark (wl-summary-get-mark msg-num))
- (when (wl-summary-reserve-temp-mark-p mark)
- (if interactive
- (error "Already marked as `%s'" 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
- (if (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)))))))
- (progn
- (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 %s messages to %s" copy-or-refile folder))
- ;; learn for refile.
- (if (eq copy-or-refile 'refile)
- (wl-refile-learn entity folder))
- (wl-summary-unmark msg-num)
- (set variable (append
- (symbol-value variable)
- (list (cons msg-num folder))))
- (when (or interactive
- (eq number buffer-num))
- (wl-summary-mark-line (if (eq copy-or-refile 'refile)
- "o" "O"))
- ;; print refile destination
- (wl-summary-print-destination msg-num folder))
- (if interactive
- (if (eq wl-summary-move-direction-downward nil)
- (wl-summary-prev)
- (wl-summary-next)))
- (run-hooks (intern (format "wl-summary-%s-hook" copy-or-refile)))
- (setq wl-summary-buffer-prev-refile-destination folder)
- msg-num)))
-
-(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)))
-
-(defun wl-summary-copy-prev-destination ()
- "Refile message to previously refiled destination."
- (interactive)
- (wl-summary-copy wl-summary-buffer-prev-copy-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)
- (save-excursion
- (beginning-of-line)
- (let ((inhibit-read-only t)
- (buffer-read-only nil)
- visible
- msg-num
- cur-mark
- score-mark)
- (if number
- (setq visible (wl-summary-jump-to-msg number))
- (setq visible t))
- ;; Delete mark on buffer.
- (when (and visible
- (looking-at "^ *\\(-?[0-9]+\\)\\([^0-9]\\)"))
- (goto-char (match-end 2))
- (or number
- (setq number (string-to-int (wl-match-buffer 1))))
- (setq cur-mark (wl-match-buffer 2))
- (if (string= cur-mark " ")
- ()
- (delete-region (match-beginning 2) (match-end 2))
- (if (setq score-mark (wl-summary-get-score-mark number))
- (insert score-mark)
- (insert " ")))
- (if (or (string= cur-mark "o")
- (string= cur-mark "O"))
- (wl-summary-remove-destination))
- (if wl-summary-highlight
- (wl-highlight-summary-current-line nil nil score-mark))
- (set-buffer-modified-p nil))
- ;; Remove from temporary mark structure.
- (and number
- (wl-summary-delete-mark number)))))
-
-(defun wl-summary-msg-marked-as-target (msg)
- (if (memq msg wl-summary-buffer-target-mark-list)
- t))
-
-(defun wl-summary-msg-marked-as-copied (msg)
- (assq msg wl-summary-buffer-copy-list))
-
-(defun wl-summary-msg-marked-as-deleted (msg)
- (if (memq msg wl-summary-buffer-delete-list)
- t))
-
-(defun wl-summary-msg-marked-as-refiled (msg)
- (assq msg wl-summary-buffer-refile-list))
-
-(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)
- (let* ((buffer-num (wl-summary-message-number))
- (msg-num (or number buffer-num))
- mark)
- (catch 'done
- (when (null msg-num)
- (if (interactive-p)
- (message "No message."))
- (throw 'done nil))
- (when (setq mark (wl-summary-get-mark msg-num))
- (when (wl-summary-reserve-temp-mark-p mark)
- (if (interactive-p)
- (error "Already marked as `%s'" mark))
- (throw 'done nil))
- (wl-summary-unmark msg-num))
- (if (or (interactive-p)
- (eq number buffer-num))
- (wl-summary-mark-line "*"))
- (setq wl-summary-buffer-target-mark-list
- (cons msg-num wl-summary-buffer-target-mark-list))
- (if (interactive-p)
- (if (eq wl-summary-move-direction-downward nil)
- (wl-summary-prev)
- (wl-summary-next)))
- msg-num)))
-
-
-(defun wl-summary-refile-region (beg end)
- "Put copy mark on messages in the region specified by BEG and END."
- (interactive "r")
- (wl-summary-refile-region-subr "refile" beg end))
-
-(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-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-delete-region (beg end)
- (interactive "r")
- (wl-summary-mark-region-subr 'wl-summary-delete beg end))
-
-(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))
- (let ((case-fold-search nil))
- (while (re-search-forward (format "^ *-?[0-9]+%s"
- (regexp-quote mark)) nil t)
- (wl-summary-unmark))
- (cond ((string= mark "*")
- (setq wl-summary-buffer-target-mark-list nil))
- ((string= mark "D")
- (setq wl-summary-buffer-delete-list nil))
- ((string= mark "O")
- (setq wl-summary-buffer-copy-list nil))
- ((string= mark "o")
- (setq wl-summary-buffer-refile-list nil)))))
-
-(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))