(require 'elmo)
(require 'elmo-multi)
+(eval-when-compile (require 'elmo-filter))
(require 'wl-message)
(require 'wl-vars)
(require 'wl-highlight)
(defvar wl-summary-buffer-elmo-folder nil)
-(defmacro wl-summary-buffer-folder-name ()
- (` (and wl-summary-buffer-elmo-folder
- (elmo-folder-name-internal wl-summary-buffer-elmo-folder))))
+(defun wl-summary-buffer-folder-name ()
+ (and wl-summary-buffer-elmo-folder
+ (elmo-folder-name-internal wl-summary-buffer-elmo-folder)))
(defvar wl-summary-buffer-disp-msg nil)
(defvar wl-summary-buffer-disp-folder nil)
(defvar wl-temp-mark)
(defvar wl-persistent-mark)
-(defmacro wl-summary-sticky-buffer-name (name)
- (` (concat wl-summary-buffer-name ":" (, name))))
+(defun wl-summary-sticky-buffer-name (name)
+ (concat wl-summary-buffer-name ":" name))
(defun wl-summary-default-subject (subject-string)
(if (string-match "^[ \t]*\\[[^:]+[,: ][0-9]+\\][ \t]*" subject-string)
["Resend bounced mail" wl-summary-resend-bounced-mail t]
["Enter the message" wl-summary-jump-to-current-message t]
["Pipe message" wl-summary-pipe-message t]
- ["Print message" wl-summary-print-message t])
+ ["Print message" wl-summary-print-message t]
+ ["View raw message" wl-summary-display-raw t])
("Thread Operation"
["Open or Close" wl-thread-open-close (eq wl-summary-buffer-view 'thread)]
["Open all" wl-thread-open-all (eq wl-summary-buffer-view 'thread)]
;; basic commands
(define-key wl-summary-mode-map " " 'wl-summary-read)
(define-key wl-summary-mode-map "." 'wl-summary-redisplay)
+ (define-key wl-summary-mode-map "," 'wl-summary-display-raw)
(define-key wl-summary-mode-map "<" 'wl-summary-display-top)
(define-key wl-summary-mode-map ">" 'wl-summary-display-bottom)
(define-key wl-summary-mode-map "\177" 'wl-summary-prev-page)
(setq wl-summary-buffer-message-ring
(cdr wl-summary-buffer-message-ring)))))
-(defmacro wl-summary-message-status (&optional number)
- `(elmo-message-status wl-summary-buffer-elmo-folder
- (or ,number (wl-summary-message-number))))
+(defsubst wl-summary-message-status (&optional number)
+ (elmo-message-status wl-summary-buffer-elmo-folder
+ (or number (wl-summary-message-number))))
(defun wl-summary-update-mark-and-highlight-window (&optional win beg)
"A function to be called as window-scroll-functions."
wl-summary-highlight
temp persistent)
(with-temp-buffer
+ (set-buffer-multibyte t)
(setq wl-summary-buffer-number-column column
wl-summary-buffer-line-formatter formatter
wl-summary-buffer-weekday-name-lang lang)
(count (elmo-find-list-match-value
elmo-mailing-list-count-spec-list
getter)))
- (cons name (and count (string-to-int count)))))))
+ (cons name (and count (string-to-number count)))))))
(defun wl-summary-overview-entity-compare-by-list-info (x y)
"Compare entity X and Y by mailing-list info."
(wl-summary-rescan ,(symbol-name sort-by) reverse)))))
(defun wl-summary-sort-function-from-spec (spec reverse)
- (let (funtion)
+ (let (function)
(when (string-match "^!\\(.+\\)$" spec)
(setq spec (match-string 1 spec)
reverse (not reverse)))
- (setq funtion
+ (setq function
(intern (format "wl-summary-overview-entity-compare-by-%s" spec)))
(if reverse
- `(lambda (x y) (not (,funtion x y)))
- funtion)))
+ `(lambda (x y) (not (,function x y)))
+ function)))
(defun wl-summary-sort-messages (numbers sort-by reverse)
(let* ((functions (mapcar
(and disable-thread wl-summary-search-parent-by-subject-regexp))
(wl-summary-divide-thread-when-subject-changed
(and disable-thread wl-summary-divide-thread-when-subject-changed))
- (i 0)
num
expunged)
(erase-buffer)
wl-summary-buffer-temp-mark-list nil
wl-summary-delayed-update nil)
(elmo-kill-buffer wl-summary-search-buf-name)
- (while numbers
- (wl-summary-insert-message (elmo-message-entity
- wl-summary-buffer-elmo-folder
- (car numbers))
- wl-summary-buffer-elmo-folder
- nil)
- (setq numbers (cdr numbers))
- (when (> num elmo-display-progress-threshold)
- (setq i (+ i 1))
- (if (or (zerop (% i 5)) (= i num))
- (elmo-display-progress
- 'wl-summary-rescan "Constructing summary structure..."
- (/ (* i 100) num)))))
- (when wl-summary-delayed-update
+ (elmo-with-progress-display (wl-summary-insert-line num)
+ "Constructing summary structure"
+ (dolist (number numbers)
+ (wl-summary-insert-message (elmo-message-entity
+ wl-summary-buffer-elmo-folder
+ number)
+ wl-summary-buffer-elmo-folder
+ nil))
(while wl-summary-delayed-update
(message "Parent (%d) of message %d is no entity"
(caar wl-summary-delayed-update)
(cdar wl-summary-delayed-update)
wl-summary-buffer-elmo-folder nil t)
(setq wl-summary-delayed-update (cdr wl-summary-delayed-update))))
- (message "Constructing summary structure...done")
- (if (eq wl-summary-buffer-view 'thread)
- (progn
- (message "Inserting thread...")
- (wl-thread-insert-top)
- (message "Inserting thread...done")))
+ (when (eq wl-summary-buffer-view 'thread)
+ (wl-thread-insert-top))
(when wl-use-scoring
(wl-summary-score-headers (wl-summary-rescore-msgs
wl-summary-buffer-number-list)
(when wl-summary-buffer-temp-mark-list
(wl-summary-exec-with-confirmation
(format "Execute marks in %s? (answer \"n\" to discard them) "
- (wl-summary-buffer-folder-name)))
- (wl-summary-delete-all-temp-marks 'no-msg)
- (setq wl-summary-scored nil)))
+ (wl-summary-buffer-folder-name))))
+ (wl-summary-delete-all-temp-marks 'no-msg)
+ (setq wl-summary-scored nil))
;; a subroutine for wl-summary-exit/wl-save-status
;; Note that folder is not commited here.
(setq fields (cdr fields)))
(setq candidates (elmo-uniq-list candidates))
(elmo-with-enable-multibyte
- (mapcar (function
- (lambda (x)
- (setq components (std11-extract-address-components x))
- (cons (nth 1 components)
- (and (car components)
- (eword-decode-string
- (decode-mime-charset-string
- (car components)
- mime-charset))))))
- candidates))))
+ (mapcar
+ (lambda (x)
+ (setq components (std11-extract-address-components x))
+ (cons (nth 1 components)
+ (and (car components)
+ (eword-decode-string
+ (decode-mime-charset-string
+ (car components)
+ mime-charset)))))
+ candidates))))
(defun wl-summary-edit-addresses-subr (the-email name-in-addr)
;; returns nil if there's no change.
the-email)
(while (not (or (eq (setq char (read-char)) ?\r)
(eq char ?\n)
- (eq char ? )
+ (eq char (string-to-char " "))
(eq char ?e)
(eq char ?c)
(eq char ?d)))
((or (eq char ?e)
(eq char ?\n)
(eq char ?\r)
- (eq char ? ))
+ (eq char (string-to-char " ")))
;; Change Addresses
(wl-address-add-or-change
the-email
(completing-read
(format "Target address (%s): " address)
(mapcar
- (function (lambda (x) (cons (car x) (car x))))
+ (lambda (x) (cons (car x) (car x)))
candidates)
nil nil nil nil address))))
(when address
"All uncached messages are cached."
(interactive)
(unless (elmo-folder-local-p wl-summary-buffer-elmo-folder)
- (let ((targets (elmo-folder-list-flagged wl-summary-buffer-elmo-folder
- 'uncached 'in-msgdb))
- (count 0)
- wl-prefetch-confirm
- wl-prefetch-threshold
- (elmo-inhibit-display-retrieval-progress t)
- length msg)
+ (let* ((targets (elmo-folder-list-flagged wl-summary-buffer-elmo-folder
+ 'uncached 'in-msgdb))
+ (count 0)
+ wl-prefetch-confirm
+ wl-prefetch-threshold
+ (length (length targets))
+ msg)
(save-excursion
- (goto-char (point-min))
- (setq length (length targets))
- (dolist (target targets)
- (when (if (not (wl-thread-entity-parent-invisible-p
- (wl-thread-get-entity target)))
- (progn
- (wl-summary-jump-to-msg target)
- (wl-summary-prefetch-msg
- (wl-summary-message-number)))
- (wl-summary-prefetch-msg target))
- (message "Retrieving... %d/%d" (incf count) length)))
+ (elmo-with-progress-display (wl-summary-prefetch-message length)
+ "Retrieving"
+ (goto-char (point-min))
+ (dolist (target targets)
+ (when (if (not (wl-thread-entity-parent-invisible-p
+ (wl-thread-get-entity target)))
+ (progn
+ (wl-summary-jump-to-msg target)
+ (wl-summary-prefetch-msg
+ (wl-summary-message-number)))
+ (wl-summary-prefetch-msg target))
+ (incf count))
+ (elmo-progress-notify 'wl-summary-prefetch-message)))
(message "Retrieved %d/%d message(s)" count length)))))
(defun wl-summary-prefetch-msg (number &optional arg)
(wl-summary-update-modeline)
(message "Resuming cache status...done"))))
-(defun wl-summary-delete-messages-on-buffer (msgs &optional deleting-info)
+(defun wl-summary-delete-messages-on-buffer (msgs)
(interactive)
(save-excursion
(let ((inhibit-read-only t)
(msgs2 msgs)
(len (length msgs))
(i 0)
- ;(deleting-info (or deleting-info "Deleting..."))
update-list)
(elmo-kill-buffer wl-summary-search-buf-name)
(while msgs
(delete-char 1) ; delete '\n'
(setq wl-summary-buffer-number-list
(delq (car msgs) wl-summary-buffer-number-list)))))
-; (when (> len elmo-display-progress-threshold)
-; (setq i (1+ i))
-; (if (or (zerop (% i 5)) (= i len))
-; (elmo-display-progress
-; 'wl-summary-delete-messages-on-buffer deleting-info
-; (/ (* i 100) len))))
(setq msgs (cdr msgs)))
(when (eq wl-summary-buffer-view 'thread)
- (wl-thread-update-line-msgs (elmo-uniq-list update-list))
- (wl-thread-cleanup-symbols msgs2))
- ;;(message (concat deleting-info "done"))
+ (let ((updates (elmo-uniq-list update-list)))
+ (elmo-with-progress-display (wl-thread-update-line (length updates))
+ "Updating deleted thread"
+ (wl-thread-update-line-msgs updates)
+ (wl-thread-cleanup-symbols msgs2))))
(wl-summary-count-unread)
(wl-summary-update-modeline)
(wl-summary-folder-info-update))))
(not wl-summary-lazy-highlight)))
append-list delete-list
update-thread update-top-list
- num diff entity
- (i 0))
+ num diff entity)
;; Setup sync-all
(if sync-all (wl-summary-sync-all-init))
(setq diff (elmo-list-diff (elmo-folder-list-messages
(setq num (length append-list))
(setq wl-summary-delayed-update nil)
(elmo-kill-buffer wl-summary-search-buf-name)
- (dolist (number append-list)
- (setq entity (elmo-message-entity folder number))
- (when (setq update-thread
- (wl-summary-insert-message
- entity folder
- (not sync-all)))
- (wl-append update-top-list update-thread))
- (if elmo-use-database
- (elmo-database-msgid-put
- (elmo-message-entity-field entity 'message-id)
- (elmo-folder-name-internal folder)
- (elmo-message-entity-number entity)))
- (when (> num elmo-display-progress-threshold)
- (setq i (+ i 1))
- (if (or (zerop (% i 5)) (= i num))
- (elmo-display-progress
- 'wl-summary-sync-update
- (if (eq wl-summary-buffer-view 'thread)
- "Making thread..."
- "Inserting message...")
- (/ (* i 100) num)))))
- (when wl-summary-delayed-update
+ (elmo-with-progress-display (wl-summary-insert-line num)
+ (if (eq wl-summary-buffer-view 'thread)
+ "Making thread"
+ "Inserting message")
+ (dolist (number append-list)
+ (setq entity (elmo-message-entity folder number))
+ (when (setq update-thread
+ (wl-summary-insert-message
+ entity folder
+ (not sync-all)))
+ (wl-append update-top-list update-thread))
+ (if elmo-use-database
+ (elmo-database-msgid-put
+ (elmo-message-entity-field entity 'message-id)
+ (elmo-folder-name-internal folder)
+ (elmo-message-entity-number entity))))
(while wl-summary-delayed-update
(message "Parent (%d) of message %d is no entity"
(caar wl-summary-delayed-update)
update-top-list)
(wl-thread-update-indent-string-thread
(elmo-uniq-list update-top-list)))
- (message (if (eq wl-summary-buffer-view 'thread)
- "Making thread...done"
- "Inserting message...done"))
(when (or delete-list append-list)
(wl-summary-set-message-modified))
(when (and sync-all (eq wl-summary-buffer-view 'thread))
(elmo-kill-buffer wl-summary-search-buf-name)
- (message "Inserting message...")
- (wl-thread-insert-top)
- (message "Inserting message...done"))
+ (wl-thread-insert-top))
(if elmo-use-database
(elmo-database-close))
(run-hooks 'wl-summary-sync-updated-hook)
(defun wl-summary-highlight-msgs (msgs)
(save-excursion
- (let ((len (length msgs))
- i)
- (message "Hilighting...")
- (setq i 0)
+ (elmo-with-progress-display (wl-summary-highlight-line (length msgs))
+ "Hilighting"
(while msgs
(if (wl-summary-jump-to-msg (car msgs))
(wl-highlight-summary-current-line))
(setq msgs (cdr msgs))
- (when (> len elmo-display-progress-threshold)
- (setq i (+ i 1))
- (if (or (zerop (% i 5)) (= i len))
- (elmo-display-progress
- 'wl-summary-highlight-msgs "Highlighting..."
- (/ (* i 100) len)))))
- (message "Highlighting...done"))))
+ (elmo-progress-notify 'wl-summary-highlight-line)))))
(defun wl-summary-message-number ()
(save-excursion
(beginning-of-line)
(if (or (re-search-forward "\r\\(-?[0-9]+\\)" (point-at-eol) t)
(re-search-forward "^ *\\(-?[0-9]+\\)" (point-at-eol) t))
- (string-to-int (wl-match-buffer 1))
+ (string-to-number (wl-match-buffer 1))
nil)))
(defun wl-summary-delete-all-msgs ()
(wl-summary-mode)
(wl-summary-buffer-set-folder folder)
(let ((buffer-read-only nil))
- (insert-buffer cur-buf))
+ (insert-buffer-substring cur-buf))
(set-buffer-modified-p nil)
(while copy-variables
(set (car copy-variables)
(eq major-mode 'wl-summary-mode)) ; called in summary.
(setq wl-summary-last-visited-folder (wl-summary-buffer-folder-name))
(run-hooks 'wl-summary-exit-pre-hook)
- (if (or force-exit (not (wl-summary-sticky-p)))
+ (let ((discard-contents (or force-exit (not (wl-summary-sticky-p)))))
+ (when discard-contents
(wl-summary-cleanup-temp-marks))
- (wl-summary-save-view)
- (elmo-folder-commit wl-summary-buffer-elmo-folder)
+ (wl-summary-save-view)
+ (if discard-contents
+ (elmo-folder-close wl-summary-buffer-elmo-folder)
+ (elmo-folder-commit wl-summary-buffer-elmo-folder)))
(if (and (wl-summary-sticky-p) force-exit)
(kill-buffer (current-buffer))))
(setq buf (wl-summary-get-buffer-create (elmo-folder-name-internal folder)
(save-excursion (beginning-of-line)(point))
(save-excursion (end-of-line)(point))
'mouse-face nil))
+ (elmo-progress-notify 'wl-summary-insert-line)
(ignore-errors
(run-hooks 'wl-summary-line-inserted-hook)))
(funcall wl-summary-subject-filter-function subject2)))
(defmacro wl-summary-put-alike (alike)
- (` (elmo-set-hash-val (format "#%d" (wl-count-lines))
- (, alike)
- wl-summary-alike-hashtb)))
+ `(elmo-set-hash-val (format "#%d" (wl-count-lines))
+ ,alike
+ wl-summary-alike-hashtb))
-(defmacro wl-summary-get-alike ()
- (` (elmo-get-hash-val (format "#%d" (wl-count-lines))
- wl-summary-alike-hashtb)))
+(defsubst wl-summary-get-alike ()
+ (elmo-get-hash-val (format "#%d" (wl-count-lines))
+ wl-summary-alike-hashtb))
(defun wl-summary-insert-headers (folder func &optional mime-decode)
(let ((numbers (elmo-folder-list-messages folder 'visible t))
(message "Creating subject cache...")
(wl-summary-insert-headers
folder
- (function
- (lambda (x)
- (funcall wl-summary-subject-filter-function
- (elmo-message-entity-field x 'subject)))))
+ (lambda (x)
+ (funcall wl-summary-subject-filter-function
+ (elmo-message-entity-field x 'subject))))
(message "Creating subject cache...done"))
(setq match (funcall wl-summary-subject-filter-function
(elmo-message-entity-field entity 'subject)))
(setq range
(completing-read (format "Range (%s): " default)
(mapcar
- (function (lambda (x) (cons x x)))
+ (lambda (x) (cons x x))
input-range-list)))
(if (string= range "")
default
nil)))))
(defun wl-summary-reply (&optional arg without-setup-hook)
- "Reply to current message. Default is \"wide\" reply.
-Reply to author if invoked with ARG."
+ "Reply to current message. See also `wl-draft-reply'."
(interactive "P")
(let ((folder wl-summary-buffer-elmo-folder)
(number (wl-summary-message-number))
(wl-summary-entity-info-msg next-entity finfo)))))))))
(defun wl-summary-get-prev-folder ()
- (let ((folder-buf (get-buffer wl-folder-buffer-name))
- last-entity cur-id)
+ (let ((folder-buf (get-buffer wl-folder-buffer-name)))
(when folder-buf
- (setq cur-id (save-excursion (set-buffer folder-buf)
- wl-folder-buffer-cur-entity-id))
- (wl-folder-get-prev-folder cur-id))))
+ (wl-folder-get-prev-folder
+ (with-current-buffer folder-buf
+ wl-folder-buffer-cur-entity-id)))))
(defun wl-summary-get-next-folder ()
- (let ((folder-buf (get-buffer wl-folder-buffer-name))
- cur-id)
+ (let ((folder-buf (get-buffer wl-folder-buffer-name)))
(when folder-buf
- (setq cur-id (save-excursion (set-buffer folder-buf)
- wl-folder-buffer-cur-entity-id))
- (wl-folder-get-next-folder cur-id))))
+ (wl-folder-get-next-folder
+ (with-current-buffer folder-buf
+ wl-folder-buffer-cur-entity-id)))))
(defun wl-summary-get-next-unread-folder ()
- (let ((folder-buf (get-buffer wl-folder-buffer-name))
- cur-id)
+ (let ((folder-buf (get-buffer wl-folder-buffer-name)))
(when folder-buf
- (setq cur-id (save-excursion (set-buffer folder-buf)
- wl-folder-buffer-cur-entity-id))
- (wl-folder-get-next-folder cur-id 'unread))))
+ (wl-folder-get-next-folder
+ (with-current-buffer folder-buf
+ wl-folder-buffer-cur-entity-id)
+ 'unread))))
(defun wl-summary-get-prev-unread-folder ()
- (let ((folder-buf (get-buffer wl-folder-buffer-name))
- cur-id)
+ (let ((folder-buf (get-buffer wl-folder-buffer-name)))
(when folder-buf
- (setq cur-id (save-excursion (set-buffer folder-buf)
- wl-folder-buffer-cur-entity-id))
- (wl-folder-get-prev-folder cur-id 'unread))))
+ (wl-folder-get-prev-folder
+ (with-current-buffer folder-buf
+ wl-folder-buffer-cur-entity-id)
+ 'unread))))
(defun wl-summary-down (&optional interactive skip-no-unread)
(interactive)
(if message-buf (set-buffer message-buf))
(wl-draft-edit-string (buffer-substring (point-min) (point-max)))))))
+(defun wl-summary-display-raw (&optional arg)
+ "Display current message in raw format."
+ (interactive)
+ (let ((number (wl-summary-message-number))
+ (folder wl-summary-buffer-elmo-folder))
+ (if number
+ (let ((raw (elmo-message-fetch-string
+ folder number
+ (elmo-find-fetch-strategy folder number)))
+ (raw-buffer (get-buffer-create "*wl:raw message*"))
+ (raw-mode-map (make-sparse-keymap)))
+ (with-current-buffer raw-buffer
+ (toggle-read-only -1)
+ (erase-buffer)
+ (princ raw raw-buffer)
+ (toggle-read-only t)
+ (goto-char (point-min))
+ (switch-to-buffer-other-window raw-buffer)
+ (define-key raw-mode-map "l" 'toggle-truncate-lines)
+ (define-key raw-mode-map "q" 'kill-buffer-and-window)
+ (define-key raw-mode-map "," 'kill-buffer-and-window)
+ (use-local-map raw-mode-map)))
+ (message "No message to display."))
+ number))
+
(defun wl-summary-save (&optional arg wl-save-dir)
"Save current message to disk."
(interactive)
(interactive (list current-prefix-arg nil))
(if (null (wl-summary-message-number))
(message "No message.")
- (setq command (read-string "Shell command on message: "
- wl-summary-shell-command-last))
+ (setq command (wl-read-shell-command "Shell command on message: "
+ wl-summary-shell-command-last))
(if (y-or-n-p "Send this message to pipe? ")
(wl-summary-pipe-message-subr prefix command))))
(interactive (list current-prefix-arg nil))
(if (null wl-summary-buffer-target-mark-list)
(message "No marked message.")
- (setq command (read-string "Shell command on each marked message: "
- wl-summary-shell-command-last))
+ (setq command (wl-read-shell-command
+ "Shell command on each marked message: "
+ wl-summary-shell-command-last))
(when (y-or-n-p "Send each marked message to pipe? ")
(while (car wl-summary-buffer-target-mark-list)
(let ((num (car wl-summary-buffer-target-mark-list)))
;; sum))
;; (message "Dropping...done"))))
+(defun wl-summary-previous-message-number (msg)
+ "Return a message number previous to the message specified by MSG."
+ (let ((list wl-summary-buffer-number-list)
+ previous)
+ (while (and list (not (eq msg (car list))))
+ (setq previous (car list))
+ (setq list (cdr list)))
+ previous))
+
+(defun wl-summary-next-message-number (msg)
+ "Return a message number next to the message specified by MSG."
+ (cadr (memq msg wl-summary-buffer-number-list)))
+
(defun wl-summary-default-get-next-msg (msg)
(or (wl-summary-next-message msg
(if wl-summary-move-direction-downward 'down
'up)
nil)
- (cadr (memq msg (if wl-summary-move-direction-downward
- wl-summary-buffer-number-list
- (reverse wl-summary-buffer-number-list))))))
+ (if wl-summary-move-direction-downward
+ (wl-summary-next-message-number msg)
+ (wl-summary-previous-message-number msg))))
(defun wl-summary-save-current-message ()
"Save current message for `wl-summary-yank-saved-message'."
projects / elisp / wanderlust.git / blobdiff