(defvar wl-summary-buffer-mime-charset nil)
(defvar wl-summary-buffer-weekday-name-lang nil)
(defvar wl-summary-buffer-thread-indent-set-alist nil)
-(defvar wl-summary-buffer-view 'thread)
+(defvar wl-summary-buffer-view nil)
(defvar wl-summary-buffer-message-modified nil)
(defvar wl-summary-buffer-mark-modified nil)
(defvar wl-summary-buffer-thread-modified nil)
subject-string))
(defun wl-summary-default-from (from)
+ "Instance of `wl-summary-from-function'.
+Ordinarily returns the sender name. Returns recipient names if (1)
+summary's folder name matches with `wl-summary-showto-folder-regexp'
+and (2) sender address is yours.
+
+See also variable `wl-use-petname'."
(let (retval tos ng)
(unless
(and (eq major-mode 'wl-summary-mode)
(define-key wl-summary-mode-map "g" 'wl-summary-goto-folder)
(define-key wl-summary-mode-map "G" 'wl-summary-goto-folder-sticky)
(define-key wl-summary-mode-map "c" 'wl-summary-mark-as-read-all)
-; (define-key wl-summary-mode-map "D" 'wl-summary-drop-unsync)
(define-key wl-summary-mode-map "a" 'wl-summary-reply)
(define-key wl-summary-mode-map "A" 'wl-summary-reply-with-citation)
(define-key wl-summary-mode-map "p" 'wl-summary-prev)
(define-key wl-summary-mode-map "N" 'wl-summary-down)
(define-key wl-summary-mode-map "P" 'wl-summary-up)
-;;;(define-key wl-summary-mode-map "w" 'wl-draft)
(define-key wl-summary-mode-map "w" 'wl-summary-write)
(define-key wl-summary-mode-map "W" 'wl-summary-write-current-folder)
-;;;(define-key wl-summary-mode-map "e" 'wl-draft-open-file)
(define-key wl-summary-mode-map "e" 'wl-summary-save)
(define-key wl-summary-mode-map "\C-c\C-o" 'wl-jump-to-draft-buffer)
(define-key wl-summary-mode-map "\C-c\C-a" 'wl-addrmgr)
(define-key wl-summary-mode-map "d" 'wl-summary-delete)
(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)
;; 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)
;; region commands
(define-key wl-summary-mode-map "r" (make-sparse-keymap))
"Re-edit current message.
If ARG is non-nil, Supersedes message"
(interactive "P")
- (if arg
- (wl-summary-supersedes-message)
- (if (string= (wl-summary-buffer-folder-name) wl-draft-folder)
- (if (wl-summary-message-number)
- (progn
- (wl-draft-reedit (wl-summary-message-number))
- (if (wl-message-news-p)
- (mail-position-on-field "Newsgroups")
- (mail-position-on-field "To"))
- (delete-other-windows)))
- (wl-draft-edit-string (wl-summary-message-string)))))
+ (wl-summary-toggle-disp-msg 'off)
+ (cond
+ ((not (wl-summary-message-number))
+ (message "No message."))
+ (arg
+ (wl-summary-supersedes-message))
+ ((string= (wl-summary-buffer-folder-name) wl-draft-folder)
+ (wl-draft-reedit (wl-summary-message-number))
+ (if (wl-message-news-p)
+ (mail-position-on-field "Newsgroups")
+ (mail-position-on-field "To")))
+ (t
+ (wl-draft-edit-string (wl-summary-message-string)))))
(defun wl-summary-resend-bounced-mail ()
"Re-mail the current message.
contains some mail you have written but has been bounced back to
you."
(interactive)
+ (wl-summary-toggle-disp-msg 'off)
(save-excursion
(wl-summary-set-message-buffer-or-redisplay)
(set-buffer (wl-message-get-original-buffer))
(concat "^--" boundary "\n"
"\\([Cc]ontent-[Dd]escription:.*\n\\)?"
"[Cc]ontent-[Tt]ype:[ \t]+"
- "\\(message/rfc822\\|text/rfc822-headers\\)\n"
+ "\\(message/rfc822\\|text/rfc822-headers\\).*\n"
"\\(.+\n\\)*\n") nil t))
(re-search-forward
(concat "\n\\(--" boundary "\\)--\n") nil t))
(wl-mode-line-buffer-identification '(wl-summary-buffer-mode-line))
(easy-menu-add wl-summary-mode-menu)
(when wl-summary-lazy-highlight
- (if wl-on-xemacs
+ (if wl-on-xemacs
(progn
(make-local-variable 'pre-idle-hook)
(add-hook 'pre-idle-hook 'wl-highlight-summary-window))
(defun wl-summary-get-list-info (entity)
"Returns (\"ML-name\" . ML-count) of ENTITY."
- (let (sequence ml-name ml-count subject return-path)
+ (let (sequence ml-name ml-count subject return-path delivered-to mailing-list)
(setq sequence (elmo-msgdb-overview-entity-get-extra-field
entity "x-sequence")
ml-name (or (elmo-msgdb-overview-entity-get-extra-field
(progn
(or ml-name (setq ml-name (match-string 1 return-path)))
(or ml-count (setq ml-count (match-string 2 return-path)))))
+ (and (setq delivered-to
+ (elmo-msgdb-overview-entity-get-extra-field
+ entity "delivered-to"))
+ (string-match "^mailing list \\([^@]+\\)@" delivered-to)
+ (or ml-name (setq ml-name (match-string 1 delivered-to))))
+ (and (setq mailing-list
+ (elmo-msgdb-overview-entity-get-extra-field
+ entity "mailing-list"))
+ (string-match "\\(^\\|; \\)contact \\([^@]+\\)-[^-@]+@" mailing-list) ; *-help@, *-owner@, etc.
+ (or ml-name (setq ml-name (match-string 2 mailing-list))))
(cons (and ml-name (car (split-string ml-name " ")))
(and ml-count (string-to-int ml-count)))))
"Compare entity X and Y by mailing-list info."
(let* ((list-info-x (wl-summary-get-list-info x))
(list-info-y (wl-summary-get-list-info y)))
- (if (equal list-info-x list-info-y)
- (wl-summary-overview-entity-compare-by-date x y)
- (if (string= (car list-info-x) (car list-info-y))
+ (if (equal (car list-info-x) (car list-info-y))
+ (if (equal (cdr list-info-x) (cdr list-info-y))
+ (wl-summary-overview-entity-compare-by-date x y)
(< (or (cdr list-info-x) 0)
- (or (cdr list-info-y) 0))
- (string< (car list-info-x) (car list-info-y))))))
+ (or (cdr list-info-y) 0)))
+ (string< (or (car list-info-x) "")
+ (or (car list-info-y) "")))))
(defun wl-summary-sort-by-date ()
(interactive)
(if (or wl-summary-buffer-refile-list
wl-summary-buffer-copy-list
wl-summary-buffer-delete-list)
- (if (y-or-n-p "Marks remain to be executed. Execute them? ")
+ (if (y-or-n-p (format "Execute remaining marks in %s? "
+ (wl-summary-buffer-folder-name)))
(progn
(wl-summary-exec)
(if (or wl-summary-buffer-refile-list
(elmo-folder-commit wl-summary-buffer-elmo-folder)
(elmo-folder-check wl-summary-buffer-elmo-folder)
(if wl-use-scoring (wl-score-save))
- (if (interactive-p) (message "Saving summary status...done.")))
+ (if (interactive-p) (message "Saving summary status...done")))
(defun wl-summary-force-exit ()
"Exit current summary. Buffer is deleted even the buffer is sticky."
(number-alist (elmo-msgdb-get-number-alist msgdb))
(message-id (cdr (assq number number-alist)))
(ov (elmo-msgdb-overview-get-entity message-id msgdb))
- (entity ov)
+ (wl-message-entity ov)
+ (entity ov) ; backward compatibility.
(size (elmo-msgdb-overview-entity-get-size ov))
(inhibit-read-only t)
(buffer-read-only nil)
(narrow-to-region beg end)
(goto-char (point-min))
(if (eq wl-summary-buffer-view 'thread)
- (progn
+ (let (number-list)
(while (not (eobp))
(let* ((number (wl-summary-message-number))
- (entity (wl-thread-get-entity number))
- children)
+ (entity (wl-thread-get-entity number)))
(if (wl-thread-entity-get-opened entity)
- ;; opened...mark line.
- (wl-summary-mark-as-read number)
- ;; closed
- (wl-summary-mark-as-read number) ; mark itself.
- (setq children (wl-thread-get-children-msgs number))
- (while children
- (wl-summary-mark-as-read (car children))
- (setq children (cdr children))))
- (forward-line 1))))
- (while (not (eobp))
- (wl-summary-mark-as-read (wl-summary-message-number))
- (forward-line 1)))))
- (wl-summary-count-unread)
- (wl-summary-update-modeline))
+ (setq number-list (append number-list (list number)))
+ (setq number-list
+ (append number-list
+ (wl-thread-get-children-msgs number))))
+ (forward-line 1)))
+ (wl-summary-mark-as-read number-list))
+ (let (number-list)
+ (while (not (eobp))
+ (setq number-list
+ (append number-list (list (wl-summary-message-number))))
+ (forward-line 1))
+ (wl-summary-mark-as-read number-list))))))
(defun wl-summary-mark-as-unread-region (beg end)
(interactive "r")
(save-excursion
(save-restriction
(narrow-to-region beg end)
-;;; use narrowing.
-;;; (save-excursion (goto-char end)
-;;; (end-of-line) (point)))
(goto-char (point-min))
(if (eq wl-summary-buffer-view 'thread)
- (progn
+ (let (number-list)
(while (not (eobp))
(let* ((number (wl-summary-message-number))
- (entity (wl-thread-get-entity number))
- children)
+ (entity (wl-thread-get-entity number)))
(if (wl-thread-entity-get-opened entity)
- ;; opened...mark line.
- ;; Crossposts are not processed
- (wl-summary-mark-as-unread)
- ;; closed
- (wl-summary-mark-as-unread) ; mark itself.
- (setq children
- (delq number (wl-thread-get-children-msgs number)))
- (while children
- (wl-summary-mark-as-unread (car children))
- (setq children (cdr children))))
- (forward-line 1))))
- (while (not (eobp))
- (wl-summary-mark-as-unread)
- (forward-line 1)))))
- (wl-summary-count-unread)
- (wl-summary-update-modeline))
+ (setq number-list (append number-list (list number)))
+ (setq number-list
+ (append number-list
+ (wl-thread-get-children-msgs number))))
+ (forward-line 1)))
+ (wl-summary-mark-as-unread number-list))
+ (let (number-list)
+ (while (not (eobp))
+ (setq number-list
+ (append number-list (list (wl-summary-message-number))))
+ (forward-line 1))
+ (wl-summary-mark-as-unread number-list))))))
(defun wl-summary-mark-as-important-region (beg end)
(interactive "r")
(elmo-msgdb-set-mark
msgdb msg wl-summary-read-uncached-mark))
(if wl-summary-highlight
- (wl-highlight-summary-current-line nil nil t)))
+ (wl-highlight-summary-current-line)))
(forward-line 1)))
(elmo-folder-replace-marks
folder
(elmo-msgdb-set-mark msgdb number new-mark)
(wl-summary-set-mark-modified)
(if wl-summary-highlight
- (wl-highlight-summary-current-line nil nil t))
+ (wl-highlight-summary-current-line))
(set-buffer-modified-p nil)))))
(defun wl-summary-resume-cache-status ()
(defun wl-summary-replace-status-marks (before after)
"Replace the status marks on buffer."
- (interactive)
(save-excursion
(goto-char (point-min))
(let ((inhibit-read-only t)
(setq diffs (car diff)) ; unread-appends
(setq mes (concat mes (format "/+%d) unread mark(s)." (length diffs))))
(while diffs
- (wl-summary-mark-as-unread (car diffs) 'no-server 'no-modeline)
+ (wl-summary-mark-as-unread (car diffs) 'no-server)
(setq diffs (cdr diffs)))
- (if (interactive-p) (message mes)))))
+ (if (interactive-p) (message "%s" mes)))))
(defun wl-summary-sync-update (&optional unset-cursor sync-all no-check)
"Update the summary view to the newest folder status."
(goto-char (point-max))
(forward-line -1))
(if (and wl-summary-highlight
+ (not wl-summary-lazy-highlight)
(not (get-text-property (point) 'face)))
(save-excursion
(forward-line (- 0
(delete-backward-char 1)
(insert mark)
(if wl-summary-highlight
- (wl-highlight-summary-current-line nil nil t))
+ (wl-highlight-summary-current-line))
(set-buffer-modified-p nil)))))
(defun wl-summary-get-score-mark (msg-num)
(decode-mime-charset-region
(point-min)(point-max)
wl-summary-buffer-mime-charset 'LF))
- (when (file-exists-p view)
+ (if (file-exists-p view)
+ (setq wl-summary-buffer-view
+ (wl-summary-load-file-object view))
(setq wl-summary-buffer-view
- (wl-summary-load-file-object view)))
+ (or (wl-get-assoc-list-value
+ wl-summary-default-view-alist
+ (elmo-folder-name-internal folder))
+ wl-summary-default-view)))
(wl-thread-resume-entity folder)
(wl-summary-open-folder folder))
(setq wl-summary-buffer-view
(forward-line -1)
(wl-summary-prev))
(setq retval 'more-next))
- ;(setq wl-summary-highlight hilit)
(if (and wl-summary-highlight
(not wl-summary-lazy-highlight)
(not reuse-buf))
(if (and interactive wl-summary-recenter)
(recenter (/ (- (window-height) 2) 2))))))
;; set current entity-id
- (if (and (not folder)
- (setq entity
- (wl-folder-search-entity-by-name (elmo-folder-name-internal
- folder)
- wl-folder-entity
- 'folder)))
- ;; entity-id is unknown.
- (wl-folder-set-current-entity-id
- (wl-folder-get-entity-id entity)))
+ (when (and folder
+ (setq entity
+ (wl-folder-search-entity-by-name
+ (elmo-folder-name-internal folder)
+ wl-folder-entity
+ 'folder)))
+ ;; entity-id is unknown.
+ (wl-folder-set-current-entity-id
+ (wl-folder-get-entity-id entity)))
(when (and wl-summary-lazy-highlight
wl-on-xemacs)
(sit-for 0))
wl-summary-alike-hashtb)))
(defun wl-summary-insert-headers (overview func mime-decode)
- (message "Creating subject cache...")
(let (ov this last alike)
(buffer-disable-undo (current-buffer))
(make-local-variable 'wl-summary-alike-hashtb)
(setq this (funcall func ov))
(and this (setq this (std11-unfold-string this)))
(if (equal last this)
- (wl-append alike (list ov))
+ (setq alike (cons ov alike))
(when last
(wl-summary-put-alike alike)
(insert last ?\n))
elmo-mime-charset)
(when (eq mime-decode 'mime)
(eword-decode-region (point-min) (point-max))))
- (message "Creating subject cache...done")
(run-hooks 'wl-summary-insert-headers-hook)))
(defun wl-summary-search-by-subject (entity overview)
(let ((summary-buf (current-buffer))
(buf (get-buffer-create wl-summary-search-buf-name))
(folder-name (wl-summary-buffer-folder-name))
- match founds found-entity)
+ match founds cur result)
(with-current-buffer buf
(let ((case-fold-search t))
(when (or (not (string= wl-summary-search-buf-folder-name folder-name))
(zerop (buffer-size)))
(setq wl-summary-search-buf-folder-name folder-name)
+ (message "Creating subject cache...")
(wl-summary-insert-headers
overview
(function
(lambda (x)
(funcall wl-summary-subject-filter-function
- (elmo-msgdb-overview-entity-get-subject-no-decode x))))
- t))
+ (elmo-msgdb-overview-entity-get-subject-no-decode x))))
+ t)
+ (message "Creating subject cache...done"))
(setq match (funcall wl-summary-subject-filter-function
(elmo-msgdb-overview-entity-get-subject entity)))
(if (string= match "")
(setq match "\n"))
- (goto-char (point-min))
- (while (and (not founds)
- (not (= (point) (point-max)))
- (search-forward match nil t))
+ (goto-char (point-max))
+ (while (and (null result)
+ (not (= (point) (point-min)))
+ (search-backward match nil t))
;; check exactly match
- (when (and (eolp)
- (= (point-at-bol)
- (match-beginning 0)))
- (setq found-entity (wl-summary-get-alike))
- (if (and found-entity
- ;; Is founded entity myself or children?
- (not (string=
- (elmo-msgdb-overview-entity-get-id entity)
- (elmo-msgdb-overview-entity-get-id
- (car found-entity))))
- (with-current-buffer summary-buf
+ (when (and (bolp) (= (point-at-eol)(match-end 0)))
+ (setq founds (wl-summary-get-alike))
+ (with-current-buffer summary-buf
+ (while founds
+ (when (and
+ ;; the first element of found-entity list exists on
+ ;; thread tree.
+ (wl-thread-get-entity
+ (elmo-msgdb-overview-entity-get-number
+ (car founds)))
+ ;; message id is not same as myself.
+ (not (string=
+ (elmo-msgdb-overview-entity-get-id entity)
+ (elmo-msgdb-overview-entity-get-id (car founds))))
+ ;; not a descendant.
(not (wl-thread-descendant-p
(elmo-msgdb-overview-entity-get-number entity)
(elmo-msgdb-overview-entity-get-number
- (car found-entity))))))
- ;; return matching entity
- (setq founds found-entity))))
- (if founds
- (car founds))))))
+ (car founds)))))
+ (setq result (car founds)
+ founds nil))
+ (setq founds (cdr founds))))))
+ result))))
(defun wl-summary-insert-thread-entity (entity msgdb update
&optional force-insert)
parent-entity
parent-number
(case-fold-search t)
+ (depth 0) relatives anumber
cur number overview2 cur-entity linked retval delayed-entity
update-list entity-stack)
(while entity
parent-number (elmo-msgdb-overview-entity-get-number
parent-entity))
(setq number (elmo-msgdb-overview-entity-get-number entity))
- ;; If thread loop detected, set parent as nil.
(setq cur entity)
+ ;; If thread loop detected, set parent as nil.
(while cur
- (if (eq number (elmo-msgdb-overview-entity-get-number
- (setq cur
- (elmo-msgdb-get-parent-entity cur msgdb))))
+ (setq anumber
+ (elmo-msgdb-overview-entity-get-number
+ (setq cur (elmo-msgdb-get-parent-entity cur msgdb))))
+ (if (memq anumber relatives)
(setq parent-number nil
- cur nil)))
+ cur nil))
+ (setq relatives (cons
+ (elmo-msgdb-overview-entity-get-number cur)
+ relatives)))
(if (and parent-number
(not (wl-thread-get-entity parent-number))
(not force-insert))
(overview-entity entity)
(parent-id (elmo-msgdb-overview-entity-get-id parent-entity))
(number (elmo-msgdb-overview-entity-get-number entity))
- (parent-number (elmo-msgdb-overview-entity-get-number parent-entity)))
+ (parent-number (elmo-msgdb-overview-entity-get-number parent-entity))
+ insert-line)
(cond
((or (not parent-id)
(string= this-id parent-id))
(goto-char (point-max))
- (beginning-of-line))
+ (beginning-of-line)
+ (setq insert-line t))
;; parent already exists in buffer.
((wl-summary-jump-to-msg parent-number)
- (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
- (elmo-msgdb-get-mark (wl-summary-buffer-msgdb) number)
- (wl-thread-maybe-get-children-num number)
- (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)
+ (wl-thread-goto-bottom-of-sub-thread)
+ (setq insert-line t)))
+ (when insert-line
+ (let (buffer-read-only)
+ (wl-summary-insert-line
+ (wl-summary-create-line
+ entity
+ parent-entity
+ nil
+ (elmo-msgdb-get-mark (wl-summary-buffer-msgdb) number)
+ (wl-thread-maybe-get-children-num number)
+ (wl-thread-make-indent-string thr-entity)
+ (wl-thread-entity-get-linked thr-entity)))))))
+
+(defun wl-summary-mark-as-unread (&optional number-or-numbers
+ no-server-update)
(interactive)
(save-excursion
- (let* (eol
- (inhibit-read-only t)
+ (let ((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 cur-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.
- (elmo-msgdb-overview-get-entity number msgdb))
- (progn
- ;; visible.
- (setq cur-mark (wl-summary-persistent-mark))
- (or (string= cur-mark " ")
- (string= cur-mark wl-summary-read-uncached-mark))))
- (progn
- (setq number (or number (wl-summary-message-number)))
- (setq mark (or mark cur-mark))
- (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"))))
+ number-list visible mark new-mark)
+ (setq number-list (or (and (numberp number-or-numbers)
+ (list number-or-numbers))
+ number-or-numbers ; list of numbers
+ (and (wl-summary-message-number) ; interactive
+ (list (wl-summary-message-number)))))
+ (if (null number-list)
+ (message "No message.")
+ (unless no-server-update
+ (elmo-folder-unmark-read folder number-list))
+ (dolist (number number-list)
+ (setq visible (wl-summary-jump-to-msg number)
+ mark (or (elmo-msgdb-get-mark msgdb number)))
+ (when (or (null mark)
+ (string= mark wl-summary-read-uncached-mark))
+ (setq new-mark
+ (cond ((string= mark wl-summary-read-uncached-mark)
+ wl-summary-unread-uncached-mark)
+ ((elmo-message-use-cache-p folder number)
+ wl-summary-unread-mark)
+ (t
+ wl-summary-unread-uncached-mark)))
(when visible
- (delete-backward-char 1)
- (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)
+ (unless (string= (wl-summary-persistent-mark) new-mark)
+ (delete-backward-char 1)
+ (insert (or new-mark " "))))
+ (unless (string= mark new-mark)
+ (elmo-msgdb-set-mark msgdb number new-mark)
+ (wl-summary-set-mark-modified))
+ (setq wl-summary-buffer-unread-count
+ (+ 1 wl-summary-buffer-unread-count))
(if (and visible wl-summary-highlight)
- (wl-highlight-summary-current-line))))))
- (set-buffer-modified-p nil))
+ (wl-highlight-summary-current-line))))
+ (wl-summary-update-modeline)
+ (wl-folder-update-unread
+ (wl-summary-buffer-folder-name)
+ (+ wl-summary-buffer-unread-count
+ wl-summary-buffer-new-count))
+ (set-buffer-modified-p nil)
+ number-or-numbers ;return value
+ ))))
(defun wl-summary-delete (&optional number)
"Mark a delete mark 'D'.
(while (not (eobp))
(when (string= (wl-summary-temp-mark) mark)
(setq msglist (cons (wl-summary-message-number) msglist)))
- (forward-line 1)))))))
+ (forward-line 1))
+ (nreverse msglist))))))
(defun wl-summary-exec ()
(interactive)
(defun wl-summary-exec-region (beg end)
(interactive "r")
- (message "Collecting marks ...")
+ (message "Collecting marks...")
(save-excursion
(goto-char beg)
(beginning-of-line)
refile-len
dst-msgs ; loop counter
result)
- (message "Executing ...")
+ (message "Executing...")
(while dels
(when (not (assq (car dels) wl-summary-buffer-refile-list))
(wl-append wl-summary-buffer-refile-list
(wl-summary-set-message-modified)
(wl-summary-set-mark-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))
+ (wl-summary-toggle-disp-msg 'off)
+ (setq wl-message-buffer nil))
(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)
- "")
- "."))))))
+ (message "Executing...done%s%s"
+ (if (> refile-failures 0)
+ (format " (%d refiling failed)" refile-failures)
+ "")
+ (if (> copy-failures 0)
+ (format " (%d copying failed)" copy-failures)
+ ""))))))
+
+(defun wl-summary-erase (&optional number)
+ "Erase message actually, without moving it to trash."
+ (interactive)
+ (if (elmo-folder-writable-p wl-summary-buffer-elmo-folder)
+ (let* ((buffer-num (wl-summary-message-number))
+ (msg-num (or number buffer-num)))
+ (if (null msg-num)
+ (message "No message.")
+ (let* ((msgdb (wl-summary-buffer-msgdb))
+ (entity (elmo-msgdb-overview-get-entity msg-num msgdb))
+ (subject (elmo-delete-char
+ ?\n (or (elmo-msgdb-overview-entity-get-subject
+ entity)
+ wl-summary-no-subject-message))))
+ (when (yes-or-no-p
+ (format "Erase \"%s\" without moving it to trash? "
+ (truncate-string subject 30)))
+ (wl-summary-unmark msg-num)
+ (wl-summary-erase-subr (list msg-num))))))
+ (message "Read-only folder.")))
+
+(defun wl-summary-target-mark-erase ()
+ (interactive)
+ (if (elmo-folder-writable-p wl-summary-buffer-elmo-folder)
+ (if (null wl-summary-buffer-target-mark-list)
+ (message "No marked message.")
+ (when (yes-or-no-p
+ "Erase all marked messages without moving them to trash? ")
+ (wl-summary-erase-subr wl-summary-buffer-target-mark-list)
+ (setq wl-summary-buffer-target-mark-list nil)))
+ (message "Read-only folder.")))
+
+(defun wl-summary-erase-subr (msgs)
+ (elmo-folder-move-messages wl-summary-buffer-elmo-folder msgs 'null)
+ (wl-summary-delete-messages-on-buffer msgs)
+ ;; 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)))
(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)
- (let (alist)
- (mapatoms
- (lambda (atom)
- (setq alist
- (cons (list (elmo-string
- (symbol-name atom))) alist)))
- wl-folder-entity-hashtb)
- alist)))
+ 'wl-folder-complete-folder
nil nil (or init wl-default-spec)
'wl-read-folder-hist)))
(if (or (string= fld wl-default-spec)
(setq c (+ c (char-width (following-char)))))
(and (> c len) (setq folder (concat " " folder)))
(setq rs (point))
- (put-text-property rs re 'invisible t)
+ (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)
(buffer-read-only nil)
visible
msg-num
- cur-mark
- score-mark)
+ cur-mark)
(if number
(setq visible (wl-summary-jump-to-msg number))
(setq visible t))
;; Delete mark on buffer.
(when visible
(setq cur-mark (wl-summary-temp-mark))
- (if (string= cur-mark " ")
- ()
+ (unless (string= cur-mark " ")
(delete-backward-char 1)
(or number
(setq number (wl-summary-message-number)))
- (if (setq score-mark (wl-summary-get-score-mark number))
- (insert score-mark)
- (insert " ")))
+ (insert (or (wl-summary-get-score-mark number)
+ " ")))
(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))
+ (wl-highlight-summary-current-line))
(set-buffer-modified-p nil))
;; Remove from temporal mark structure.
(and number
(defun wl-summary-refile-region (beg end)
- "Put copy mark on messages in the region specified by BEG and END."
+ "Put refile mark on messages in the region specified by BEG and END."
(interactive "r")
(wl-summary-refile-region-subr "refile" beg end))
wl-summary-pick-field-default)
"/"
(wl-summary-buffer-folder-name))
- 'update nil nil t)))
+ 'update nil nil t)
+ (run-hooks 'wl-summary-virtual-hook)))
(defun wl-summary-delete-all-temp-marks (&optional no-msg)
"Erase all temp marks from buffer."
(buffer-substring (- (point) 1) (point)))
(defun wl-summary-mark-line (mark)
- "Put MARK on current line. Return message number."
+ "Put MARK on current line."
(save-excursion
(beginning-of-line)
(let ((inhibit-read-only t)
(delete-backward-char 1)
(insert mark)
(if wl-summary-highlight
- (wl-highlight-summary-current-line nil nil t))
+ (wl-highlight-summary-current-line))
(set-buffer-modified-p nil))))
(defun wl-summary-target-mark-delete ()
(setq skipped (cons (car mlist) skipped)))
(setq mlist (cdr mlist)))
(setq wl-summary-buffer-target-mark-list skipped)
- (message "Prefetching... %d/%d message(s)." count length)
+ (message "Prefetching... %d/%d message(s)" count length)
(set-buffer-modified-p nil))))
(defun wl-summary-target-mark-refile-subr (copy-or-refile)
(delete-backward-char 1)
(insert " ")
(setq number (wl-summary-message-number))
- (wl-summary-mark-as-read number)
+ (setq mlist (append mlist (list number)))
(if wl-summary-highlight
(wl-highlight-summary-current-line))
(if 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-mark-as-read (car mlist))
- (setq wl-summary-buffer-target-mark-list
- (delq (car mlist) wl-summary-buffer-target-mark-list))
- (setq mlist (cdr mlist)))
- (wl-summary-count-unread)
- (wl-summary-update-modeline))))
+ (wl-summary-mark-as-read mlist)
+ ;; closed
+ (when (setq mlist wl-summary-buffer-target-mark-list)
+ (wl-summary-mark-as-read mlist)
+ (while mlist
+ (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-mark-as-unread ()
(interactive)
(when (string= (wl-summary-temp-mark) "*")
(delete-backward-char 1)
(insert " ")
- (setq number (wl-summary-mark-as-unread))
+ (setq number (wl-summary-message-number))
+ (setq mlist (append mlist (list number)))
(if wl-summary-highlight
(wl-highlight-summary-current-line))
(if 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-mark-as-unread (car mlist))
-;;; (wl-thread-msg-mark-as-unread (car mlist))
- (setq wl-summary-buffer-target-mark-list
- (delq (car mlist) wl-summary-buffer-target-mark-list))
- (setq mlist (cdr mlist)))
- (wl-summary-count-unread)
- (wl-summary-update-modeline))))
+ (wl-summary-mark-as-unread mlist)
+ ;; closed
+ (when (setq mlist wl-summary-buffer-target-mark-list)
+ (wl-summary-mark-as-unread mlist)
+ (while mlist
+ (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-mark-as-important ()
(interactive)
(interactive)
(wl-summary-pick wl-summary-buffer-target-mark-list 'delete))
-(defun wl-summary-mark-as-read (&optional number no-folder-mark)
+(defun wl-summary-mark-as-read (&optional number-or-numbers no-folder-mark)
(interactive)
(save-excursion
- (let ((buffer-read-only nil)
+ (let ((inhibit-read-only t)
+ (buffer-read-only nil)
(folder wl-summary-buffer-elmo-folder)
(msgdb (wl-summary-buffer-msgdb))
- (case-fold-search nil)
- cur-mark mark stat visible uncached new-mark marked)
- (setq number (or number (wl-summary-message-number))
- visible (if number
- (wl-summary-jump-to-msg number)
- ;; interactive
- t)
- mark (elmo-msgdb-get-mark msgdb number))
- (cond
- ((string= mark wl-summary-new-mark) ; N
- (setq stat 'new))
- ((string= mark wl-summary-unread-uncached-mark) ; U
- (setq stat 'unread))
- ((string= mark wl-summary-unread-cached-mark) ; !
- (setq stat 'unread))
- ((string= mark wl-summary-read-uncached-mark) ; u
- (setq stat 'read))
- (t
- ;; no need to mark server.
- (setq no-folder-mark t)))
- (setq new-mark
- (if (and (if (elmo-message-use-cache-p folder number)
- (not (elmo-folder-local-p folder)))
- (not (elmo-file-cache-exists-p
- (elmo-message-field wl-summary-buffer-elmo-folder
- number 'message-id))))
- wl-summary-read-uncached-mark
- nil))
- ;; folder mark.
- (unless no-folder-mark
- (setq marked (elmo-folder-mark-as-read folder (list number))))
- (when (or no-folder-mark marked)
- (cond ((eq stat 'unread)
- (setq wl-summary-buffer-unread-count
- (1- wl-summary-buffer-unread-count)))
- ((eq stat 'new)
- (setq wl-summary-buffer-new-count
- (1- wl-summary-buffer-new-count))))
+ number-list visible mark stat new-mark)
+ (setq number-list (or (and (numberp number-or-numbers)
+ (list number-or-numbers))
+ number-or-numbers ; list of numbers
+ (and (wl-summary-message-number) ; interactive
+ (list (wl-summary-message-number)))))
+ (if (null number-list)
+ (message "No message.")
+ (unless no-folder-mark
+ (elmo-folder-mark-as-read folder number-list))
+ (dolist (number number-list)
+ (setq visible (wl-summary-jump-to-msg number)
+ mark (elmo-msgdb-get-mark msgdb number))
+ (cond
+ ((string= mark wl-summary-new-mark) ; N
+ (setq stat 'new))
+ ((string= mark wl-summary-unread-uncached-mark) ; U
+ (setq stat 'unread))
+ ((string= mark wl-summary-unread-cached-mark) ; !
+ (setq stat 'unread))
+ ((string= mark wl-summary-read-uncached-mark) ; u
+ (setq stat 'read)))
+ (setq new-mark
+ (if (and (elmo-message-use-cache-p folder number)
+ (not (elmo-folder-local-p folder))
+ (not (elmo-file-cache-exists-p
+ (elmo-message-field wl-summary-buffer-elmo-folder
+ number 'message-id))))
+ wl-summary-read-uncached-mark
+ nil))
+ (cond ((eq stat 'unread)
+ (setq wl-summary-buffer-unread-count
+ (1- wl-summary-buffer-unread-count)))
+ ((eq stat 'new)
+ (setq wl-summary-buffer-new-count
+ (1- wl-summary-buffer-new-count))))
+ (when stat
+ (when visible
+ (unless (string= (wl-summary-persistent-mark) new-mark)
+ (delete-backward-char 1)
+ (insert (or new-mark " "))))
+ (unless (string= mark new-mark)
+ (elmo-msgdb-set-mark msgdb number new-mark))
+ (wl-summary-set-mark-modified))
+ (if (and visible wl-summary-highlight)
+ (wl-highlight-summary-current-line))
+ (if stat
+ (save-current-buffer ; assumed by remaining
+ (run-hooks 'wl-summary-unread-message-hook))))
(wl-summary-update-modeline)
(wl-folder-update-unread
(wl-summary-buffer-folder-name)
(+ wl-summary-buffer-unread-count
wl-summary-buffer-new-count))
- (when stat
- ;; set mark on buffer
- (when visible
- (unless (string= (wl-summary-persistent-mark) new-mark)
- (delete-backward-char 1)
- (insert (or new-mark " "))))
- ;; set msgdb mark.
- (unless (string= mark new-mark)
- (elmo-msgdb-set-mark msgdb number new-mark))
- (wl-summary-set-mark-modified))
- (if (and visible wl-summary-highlight)
- (wl-highlight-summary-current-line nil nil t)))
- (set-buffer-modified-p nil)
- (if stat
- (run-hooks 'wl-summary-unread-message-hook))
- number ;return value
- )))
+ (set-buffer-modified-p nil)
+ number-or-numbers ;return value
+ ))))
(defun wl-summary-mark-as-important (&optional number
mark
wl-summary-important-mark)))
(wl-summary-set-mark-modified)))
(if (and visible wl-summary-highlight)
- (wl-highlight-summary-current-line nil nil t))))
+ (wl-highlight-summary-current-line))))
(set-buffer-modified-p nil)
number)
(t (format "%dB" size)))
"")))
-(defvar wl-summary-line-subject-minimum-length nil)
(defun wl-summary-line-subject ()
(let (no-parent subject parent-raw-subject parent-subject)
(if (string= wl-thr-indent-string "")
(setq parent-subject
(if parent-raw-subject
(elmo-delete-char ?\n parent-raw-subject)))
- (setq subject
- (if (or no-parent
- (null parent-subject)
- (not (wl-summary-subject-equal
- subject parent-subject)))
- (funcall wl-summary-subject-function subject)
- ""))
- (when (and wl-summary-line-subject-minimum-length
- (< (string-width subject)
- wl-summary-line-subject-minimum-length))
- (while (< (string-width subject)
- wl-summary-line-subject-minimum-length)
- (setq subject (concat subject " "))))
- (if (and (not wl-summary-width)
- wl-summary-subject-length-limit)
- (truncate-string subject
- wl-summary-subject-length-limit)
- subject)))
+ (if (or no-parent
+ (null parent-subject)
+ (not (wl-summary-subject-equal
+ subject parent-subject)))
+ (funcall wl-summary-subject-function subject)
+ "")))
(defun wl-summary-line-from ()
(elmo-delete-char ?\n
(defun wl-summary-line-list-info ()
(let ((list-info (wl-summary-get-list-info wl-message-entity)))
- (if (and (car list-info) (cdr list-info))
- (format "(%s %05d)" (car list-info) (cdr list-info))
+ (if (car list-info)
+ (format (if (cdr list-info) "(%s %05.0f)" "(%s)")
+ (car list-info) (cdr list-info))
"")))
(defun wl-summary-line-list-count ()
(defun wl-summary-line-attached ()
(let ((content-type (elmo-msgdb-overview-entity-get-extra-field
- wl-message-entity "content-type")))
+ wl-message-entity "content-type"))
+ (case-fold-search t))
(if (and content-type
(string-match "multipart/mixed" content-type))
"@"
(wl-summary-delete-all-temp-marks)
(encode-coding-region
(point-min) (point-max)
- (or (mime-charset-to-coding-system charset 'LF)
+ (or (and wl-on-mule ; one in mcs-ltn1(apel<10.4) cannot take 2 arg.
+ (mime-charset-to-coding-system charset 'LF))
;; Mule 2 doesn't have `*ctext*unix'.
(mime-charset-to-coding-system charset)))
(write-region-as-binary (point-min)(point-max)
(select-window (get-buffer-window cur-buf))
(run-hooks 'wl-summary-toggle-disp-off-hook))
;;; (switch-to-buffer cur-buf)
- )))))
+ )))
+ (when wl-summary-lazy-highlight
+ (wl-highlight-summary-window))))
(defun wl-summary-next-line-content ()
"Show next line of the message."
(save-excursion
(set-buffer summary-buf)
(wl-summary-delete-all-temp-marks)))
+ (wl-draft-reply-position wl-draft-reply-default-position)
(run-hooks 'wl-mail-setup-hook)))
(defun wl-summary-reply-with-citation (&optional arg)
(when (wl-summary-reply arg t)
(goto-char (point-max))
(wl-draft-yank-original)
+ (wl-draft-reply-position wl-draft-reply-default-position)
(run-hooks 'wl-mail-setup-hook)))
(defun wl-summary-jump-to-msg-by-message-id (&optional id)
(wl-summary-buffer-folder-name) original 'no-sync))
(cond ((eq wl-summary-search-via-nntp 'confirm)
(require 'elmo-nntp)
- (message "Search message in nntp server \"%s\" <y/n/s(elect)>?"
+ (message "Search message in nntp server \"%s\" <y/n/s(elect)>? "
elmo-nntp-default-server)
- (setq schar (read-char))
+ (setq schar (let ((cursor-in-echo-area t)) (read-char)))
(cond ((eq schar ?y)
(wl-summary-jump-to-msg-by-message-id-via-nntp msgid))
((eq schar ?s)
msgid
(read-from-minibuffer "NNTP Server: ")))
(t
- (message errmsg)
+ (message "%s" errmsg)
nil)))
- (wl-summary-search-via-nntp
+ ((or (eq wl-summary-search-via-nntp 'force)
+ (and
+ (eq (elmo-folder-type-internal wl-summary-buffer-elmo-folder)
+ 'nntp)
+ wl-summary-search-via-nntp))
(wl-summary-jump-to-msg-by-message-id-via-nntp msgid))
(t
- (message errmsg)
+ (message "%s" errmsg)
nil))))))
(defun wl-summary-jump-to-msg-by-message-id-via-nntp (&optional id server-spec)
(defun wl-summary-jump-to-parent-message (arg)
(interactive "P")
(let ((cur-buf (current-buffer))
+ (disp-msg wl-summary-buffer-disp-msg)
(number (wl-summary-message-number))
(regexp "\\(<[^<>]*>\\)[ \t]*$")
(i -1) ;; xxx
(setq msg-id
(if (null arg) (nth 0 ref-list) ;; previous
(if (<= arg i) (nth (1- arg) ref-list)
- (nth i ref-list)))))))
- (set-buffer cur-buf)
+ (nth i ref-list))))))
+ (set-buffer cur-buf)
+ (or disp-msg (wl-summary-toggle-disp-msg 'off)))
(cond ((and (null msg-id) (null msg-num))
(message "No parent message!")
nil)
((and msg-id (wl-summary-jump-to-msg-by-message-id msg-id))
- (wl-summary-redisplay)
+ (if wl-summary-buffer-disp-msg (wl-summary-redisplay))
(message "Searching parent message...done")
t)
((and msg-num (wl-summary-jump-to-msg msg-num))
- (wl-summary-redisplay)
+ (if wl-summary-buffer-disp-msg (wl-summary-redisplay))
(message "Searching parent message...done")
t)
(t ; failed.
(wl-message-select-buffer wl-message-buffer)
(set-buffer mes-buf)
(goto-char (point-min))
- (unless wl-draft-use-frame
- (split-window-vertically)
- (other-window 1))
(when (setq mes-buf (wl-message-get-original-buffer))
(wl-draft-reply mes-buf arg summary-buf)
+ (wl-draft-reply-position wl-draft-reply-default-position)
(unless without-setup-hook
(run-hooks 'wl-mail-setup-hook)))
t)))
(wl-summary-redisplay-internal folder number))
(setq mes-buf wl-message-buffer)
(wl-message-select-buffer mes-buf)
- (unless wl-draft-use-frame
- (split-window-vertically)
- (other-window 1))
;; get original subject.
(if summary-buf
(save-excursion
(if downward
(forward-line 1)
(forward-line -1))
- (setq skip (or (string-match skip-tmark-regexp
+ (setq skip (or (string-match skip-tmark-regexp
(save-excursion
(wl-summary-temp-mark)))
(and skip-pmark-regexp
(if wl-summary-buffer-disp-msg
(wl-summary-redisplay))
(if interactive
- (if wl-summary-buffer-next-folder-function
- (funcall wl-summary-buffer-next-folder-function)
+ (cond
+ ((and (not downward) wl-summary-buffer-prev-folder-function)
+ (funcall wl-summary-buffer-prev-folder-function))
+ ((and downward wl-summary-buffer-next-folder-function)
+ (funcall wl-summary-buffer-next-folder-function))
+ (t
(when wl-auto-select-next
(setq next-entity
(if downward
'(lambda () (wl-summary-next-folder-or-exit next-entity))
(format
"No more messages. Type SPC to go to %s."
- (wl-summary-entity-info-msg next-entity finfo))))))))
+ (wl-summary-entity-info-msg next-entity finfo)))))))))
(defun wl-summary-prev (&optional interactive)
(interactive)
(defun wl-summary-supersedes-message ()
"Supersede current message."
(interactive)
+ (wl-summary-toggle-disp-msg 'off)
(let ((summary-buf (current-buffer))
message-buf from)
(wl-summary-set-message-buffer-or-redisplay)
projects / elisp / wanderlust.git / blobdiff