and (2) sender address is yours.
See also variable `wl-use-petname'."
- (let (retval tos ng)
- (unless
- (and (eq major-mode 'wl-summary-mode)
+ (let ((translator (if wl-use-petname
+ (lambda (string)
+ (or (funcall wl-summary-get-petname-function string)
+ (car (std11-extract-address-components string))
+ string))
+ #'identity))
+ to ng)
+ (or (and (eq major-mode 'wl-summary-mode)
(stringp wl-summary-showto-folder-regexp)
(string-match wl-summary-showto-folder-regexp
(wl-summary-buffer-folder-name))
(wl-address-user-mail-address-p from)
(cond
- ((and (setq tos (elmo-message-entity-field
- wl-message-entity 'to t))
- (not (string= "" tos)))
- (setq retval
- (concat "To:"
- (mapconcat
- (function
- (lambda (to)
- (eword-decode-string
- (if wl-use-petname
- (or
- (funcall
- wl-summary-get-petname-function to)
- (car
- (std11-extract-address-components to))
- to)
- to))))
- (wl-parse-addresses tos)
- ","))))
- ((setq ng (elmo-message-entity-field
- wl-message-entity 'newsgroups))
- (setq retval (concat "Ng:" ng)))))
- (if wl-use-petname
- (setq retval (or (funcall wl-summary-get-petname-function from)
- (car (std11-extract-address-components from))
- from))
- (setq retval from)))
- retval))
+ ((setq to (elmo-message-entity-field wl-message-entity 'to))
+ (concat "To:" (mapconcat translator to ",")))
+ ((setq ng (elmo-message-entity-field wl-message-entity
+ 'newsgroups))
+ (concat "Ng:" ng))))
+ (funcall translator from))))
(defun wl-summary-simple-from (string)
(if wl-use-petname
(setq folder (wl-folder-get-elmo-folder folder)))
(setq wl-summary-buffer-elmo-folder folder)
(make-local-variable 'wl-message-buffer)
- (setq wl-summary-buffer-mime-charset (or (wl-get-assoc-list-value
- wl-folder-mime-charset-alist
- (elmo-folder-name-internal folder))
- wl-mime-charset))
+ (setq wl-summary-buffer-mime-charset (wl-folder-mime-charset
+ (elmo-folder-name-internal folder)))
(setq wl-summary-buffer-weekday-name-lang
(or (wl-get-assoc-list-value
wl-folder-weekday-name-lang-alist
(defun wl-summary-overview-entity-compare-by-date (x y)
"Compare entity X and Y by date."
(condition-case nil
- (string<
- (timezone-make-date-sortable
- (elmo-message-entity-field x 'date))
- (timezone-make-date-sortable
- (elmo-message-entity-field y 'date)))
+ (elmo-time<
+ (elmo-message-entity-field x 'date)
+ (elmo-message-entity-field y 'date))
(error))) ;; ignore error.
(defun wl-summary-overview-entity-compare-by-number (x y)
(defun wl-summary-overview-entity-compare-by-from (x y)
"Compare entity X and Y by from."
(string<
- (or (elmo-message-entity-field x 'from t)
+ (or (elmo-message-entity-field x 'from)
wl-summary-no-from-message)
- (or (elmo-message-entity-field y 'from t)
+ (or (elmo-message-entity-field y 'from)
wl-summary-no-from-message)))
(defun wl-summary-overview-entity-compare-by-subject (x y)
(defun wl-summary-get-list-info (entity)
"Returns (\"ML-name\" . ML-count) of ENTITY."
- (let (sequence ml-name ml-count subject return-path delivered-to mailing-list)
- (setq sequence (elmo-message-entity-field entity 'x-sequence)
- ml-name (or (elmo-message-entity-field entity 'x-ml-name)
- (and sequence
- (car (split-string sequence " "))))
- ml-count (or (elmo-message-entity-field entity 'x-mail-count)
- (elmo-message-entity-field entity 'x-ml-count)
- (and sequence
- (cadr (split-string sequence " ")))))
- (and (setq subject (elmo-message-entity-field entity 'subject t))
- (setq subject (elmo-delete-char ?\n subject))
- (string-match "^\\s(\\(\\S)+\\)[ :]\\([0-9]+\\)\\s)[ \t]*" subject)
- (progn
- (or ml-name (setq ml-name (match-string 1 subject)))
- (or ml-count (setq ml-count (match-string 2 subject)))))
- (and (setq return-path
- (elmo-message-entity-field entity 'return-path))
- (string-match "^<\\([^@>]+\\)-return-\\([0-9]+\\)-" return-path)
- (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-message-entity-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-message-entity-field entity 'mailing-list))
- ;; *-help@, *-owner@, etc.
- (string-match "\\(^\\|; \\)contact \\([^@]+\\)-[^-@]+@" mailing-list)
- (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)))))
+ (or (elmo-message-entity-field entity 'ml-info)
+ (let (sequence ml-name ml-count subject
+ return-path delivered-to mailing-list
+ list-post list-id)
+ (setq sequence (elmo-message-entity-field entity 'x-sequence)
+ ml-name (or (elmo-message-entity-field entity 'x-ml-name)
+ (and sequence
+ (car (split-string sequence " "))))
+ ml-count (or (elmo-message-entity-field entity 'x-mail-count)
+ (elmo-message-entity-field entity 'x-ml-count)
+ (and sequence
+ (cadr (split-string sequence " ")))))
+ (and (setq subject (elmo-message-entity-field entity 'subject))
+ (setq subject (elmo-delete-char ?\n subject))
+ (string-match "^\\s(\\(\\S)+\\)[ :]\\([0-9]+\\)\\s)[ \t]*"
+ subject)
+ (progn
+ (or ml-name (setq ml-name (match-string 1 subject)))
+ (or ml-count (setq ml-count (match-string 2 subject)))))
+ (and (setq return-path
+ (elmo-message-entity-field entity 'return-path))
+ (string-match "^<\\([^@>]+\\)-return-\\([0-9]+\\)-" return-path)
+ (progn
+ (or ml-name (setq ml-name (match-string 1 return-path)))
+ (or ml-count (setq ml-count (match-string 2 return-path)))))
+ (or ml-name
+ (and (setq list-post (elmo-message-entity-field entity 'list-post))
+ (string-match "<mailto:\\(.+\\)@" list-post)
+ (setq ml-name (match-string 1 list-post))))
+ (or ml-name
+ (and (setq list-id (elmo-message-entity-field entity 'list-id))
+ (or (string-match "<\\([^.]+\\)\\." list-id)
+ (string-match "^\\([^.]+\\)\\." list-id))
+ (setq ml-name (match-string 1 list-id))))
+ (or ml-name
+ (and (setq delivered-to
+ (elmo-message-entity-field entity 'delivered-to))
+ (string-match "^mailing list \\([^@]+\\)@" delivered-to)
+ (setq ml-name (match-string 1 delivered-to))))
+ (or ml-name
+ (and (setq mailing-list
+ (elmo-message-entity-field entity 'mailing-list))
+ ;; *-help@, *-owner@, etc.
+ (string-match "\\(^\\|; \\)contact \\([^@]+\\)-[^-@]+@"
+ mailing-list)
+ (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))))))
(defun wl-summary-overview-entity-compare-by-list-info (x y)
"Compare entity X and Y by mailing-list info."
(interactive "P")
(wl-summary-rescan "size" reverse))
+(defun wl-summary-sort-function-from-spec (spec reverse)
+ (let (funtion)
+ (when (string-match "^!\\(.+\\)$" spec)
+ (setq spec (match-string 1 spec)
+ reverse (not reverse)))
+ (setq funtion
+ (intern (format "wl-summary-overview-entity-compare-by-%s" spec)))
+ (if reverse
+ `(lambda (x y) (not (,funtion x y)))
+ funtion)))
+
+(defun wl-summary-sort-messages (numbers sort-by reverse)
+ (let* ((functions (mapcar
+ (lambda (spec)
+ (wl-summary-sort-function-from-spec spec reverse))
+ (if (listp sort-by) sort-by (list sort-by))))
+ (predicate (if (= (length functions) 1)
+ (car functions)
+ (lambda (x y)
+ (let ((functions functions))
+ (catch 'done
+ (dolist (function functions)
+ (when (funcall function x y)
+ (throw 'done t))
+ (when (funcall function y x)
+ (throw 'done nil)))))))))
+ (mapcar #'elmo-message-entity-number
+ (sort (mapcar (lambda (number)
+ (elmo-message-entity
+ wl-summary-buffer-elmo-folder
+ number))
+ numbers)
+ predicate))))
+
(defun wl-summary-rescan (&optional sort-by reverse disable-killed disable-thread)
"Rescan current folder without updating."
(interactive)
(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))
- (predicate (and sort-by
- (intern (format "wl-summary-overview-entity-compare-by-%s"
- sort-by))))
- (sort-label (if reverse "Reverse sorting" "Sorting"))
(i 0)
num
expunged)
(erase-buffer)
(message "Re-scanning...")
- (when sort-by
- (message "%s by %s..." sort-label sort-by)
- (setq numbers
- (sort numbers
- (lambda (x y)
- (funcall
- predicate
- (elmo-message-entity wl-summary-buffer-elmo-folder x)
- (elmo-message-entity wl-summary-buffer-elmo-folder y)))))
- (if reverse (setq numbers (nreverse numbers)))
- (message "%s by %s...done" sort-label sort-by))
+ (when (and sort-by numbers)
+ (let ((action (if reverse "Reverse sorting" "Sorting")))
+ (message "%s by %s..." action sort-by)
+ (setq numbers (wl-summary-sort-messages numbers sort-by reverse))
+ (message "%s by %s...done" action sort-by)))
(setq num (length numbers))
(setq wl-thread-entity-hashtb (elmo-make-hash (* num 2))
wl-thread-entity-list nil
(defun wl-summary-rescan-message (number &optional reparent)
"Rescan current message without updating."
- (interactive (list (wl-summary-message-number)))
+ (interactive (list (wl-summary-message-number) current-prefix-arg))
(let ((start-number (wl-summary-message-number))
(start-column (current-column)))
(when (wl-summary-jump-to-msg number)
(inhibit-read-only t))
(if (eq wl-summary-buffer-view 'thread)
(let* ((thread-entity (wl-thread-get-entity number))
- (descendant (wl-thread-entity-get-descendant thread-entity))
(thread-parent (wl-thread-entity-get-parent thread-entity))
(entity-parent (elmo-message-entity-number
(elmo-message-entity-parent folder entity)))
(progn
(wl-thread-entity-set-linked thread-entity nil)
(wl-thread-update-line-on-buffer-sub nil number))
- (wl-thread-delete-message number 'deep 'update)
- (dolist (number (cons number descendant))
- (setq update-top-list
- (nconc
- update-top-list
- (wl-summary-insert-thread
- (elmo-message-entity folder number)
- folder
- 'update))))
- (when update-top-list
- (wl-thread-update-indent-string-thread
- (elmo-uniq-list update-top-list)))))
+ (let ((replacements
+ (cons number
+ (wl-thread-entity-get-descendant thread-entity))))
+ (wl-thread-delete-message number 'deep 'update)
+ (wl-thread-cleanup-symbols replacements)
+ (dolist (number replacements)
+ (setq update-top-list
+ (nconc
+ update-top-list
+ (wl-summary-insert-thread
+ (elmo-message-entity folder number)
+ folder
+ 'update))))
+ (when update-top-list
+ (wl-thread-update-indent-string-thread
+ (elmo-uniq-list update-top-list))))))
(delete-region (point-at-bol) (1+ (point-at-eol)))
(wl-summary-insert-line
(wl-summary-create-line entity nil
(or
(elmo-message-entity-field
wl-message-entity
- 'from t)
+ 'from)
"??")))))
" ]")
size))))
(defun wl-summary-sort (reverse)
"Sort summary lines into the selected order; argument means descending order."
(interactive "P")
- (wl-summary-rescan
- (completing-read
- (format "%s by (%s): "
- (if reverse "Reverse sort" "Sort")
- (symbol-name wl-summary-default-sort-spec))
- (mapcar (lambda (spec)
- (list (symbol-name spec)))
- wl-summary-sort-specs)
- nil t nil nil (symbol-name wl-summary-default-sort-spec))
- reverse))
+ (let ((default-value (symbol-name wl-summary-default-sort-spec)))
+ (wl-summary-rescan
+ (wl-completing-read-multiple
+ (format "%s by (%s): " (if reverse "Reverse sort" "Sort") default-value)
+ (nconc
+ (mapcar (lambda (spec) (list (symbol-name spec)))
+ wl-summary-sort-specs)
+ (mapcar (lambda (spec) (list (concat "!" (symbol-name spec))))
+ wl-summary-sort-specs))
+ nil t nil nil
+ default-value)
+ reverse)))
(defun wl-summary-get-available-flags (&optional include-specials)
(let ((flags (elmo-uniq-list
(wl-append update-top-list update-thread))
(if elmo-use-database
(elmo-database-msgid-put
- (car entity) (elmo-folder-name-internal folder)
+ (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))
(funcall wl-summary-buffer-mode-line-formatter)))
(defun wl-summary-jump-to-msg (&optional number beg end)
- (interactive "NJump to Number:")
- (let ((num (or number
- (string-to-int
- (read-from-minibuffer "Jump to Message(No.): "))))
- (pos (point))
- regexp)
- (setq regexp (concat "\r" (int-to-string num) "[^0-9]"))
- (if (and beg end (or (< pos beg) (< end pos)))
- (progn
- (goto-char beg)
- (if (re-search-forward regexp end t)
- (progn (backward-char 1) (beginning-of-line) t)
- (goto-char pos)
- nil))
- (beginning-of-line)
- (if (or (and (re-search-forward regexp end t)
- (progn (backward-char 1) t))
- (re-search-backward regexp beg t))
- (progn (beginning-of-line) t)
- nil))))
+ (interactive "NJump to Message (No.): ")
+ (when number
+ (let ((pos (point))
+ regexp)
+ (setq regexp (concat "\r" (int-to-string number) "[^0-9]"))
+ (if (and beg end (or (< pos beg) (< end pos)))
+ (progn
+ (goto-char beg)
+ (if (re-search-forward regexp end t)
+ (progn (backward-char 1) (beginning-of-line) t)
+ (goto-char pos)
+ nil))
+ (beginning-of-line)
+ (if (or (and (re-search-forward regexp end t)
+ (progn (backward-char 1) t))
+ (re-search-backward regexp beg t))
+ (progn (beginning-of-line) t)
+ nil)))))
(defun wl-summary-highlight-msgs (msgs)
(save-excursion
(save-excursion (end-of-line)(point))
'mouse-face nil))
(insert line "\n")
+ (save-excursion
+ (forward-line -1)
+ (let* ((number (wl-summary-message-number))
+ (mark-info (wl-summary-registered-temp-mark number)))
+ (when (and mark-info (nth 2 mark-info))
+ (wl-summary-print-argument number (nth 2 mark-info)))))
(if wl-use-highlight-mouse-line
;; remove 'mouse-face of current line.
(put-text-property
(` (elmo-get-hash-val (format "#%d" (wl-count-lines))
wl-summary-alike-hashtb)))
-(defun wl-summary-insert-headers (folder func mime-decode)
+(defun wl-summary-insert-headers (folder func &optional mime-decode)
(let ((numbers (elmo-folder-list-messages folder 'visible t))
ov this last alike)
(buffer-disable-undo (current-buffer))
(function
(lambda (x)
(funcall wl-summary-subject-filter-function
- (elmo-message-entity-field x 'subject))))
- t)
+ (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
- 'decode)))
+ (elmo-message-entity-field entity 'subject)))
(if (string= match "")
(setq match "\n"))
(goto-char (point-max))
(if (and parent-number
wl-summary-divide-thread-when-subject-changed
(not (wl-summary-subject-equal
- (or (elmo-message-entity-field entity
- 'subject t) "")
+ (or (elmo-message-entity-field entity 'subject) "")
(or (elmo-message-entity-field parent-entity
- 'subject t) ""))))
+ 'subject) ""))))
(setq parent-number nil))
(setq retval
(wl-thread-insert-message entity
(elmo-delete-char ?\n
(or (elmo-message-entity-field
wl-message-entity
- 'subject t)
+ 'subject)
wl-summary-no-subject-message)))
(setq parent-raw-subject
- (elmo-message-entity-field wl-parent-message-entity
- 'subject t))
+ (elmo-message-entity-field wl-parent-message-entity 'subject))
(setq parent-subject
(if parent-raw-subject
(elmo-delete-char ?\n parent-raw-subject)))
(if (or no-parent
(null parent-subject)
- (not (wl-summary-subject-equal
- subject parent-subject)))
+ (not (wl-summary-subject-equal subject parent-subject)))
(funcall wl-summary-subject-function subject)
"")))
(funcall wl-summary-from-function
(elmo-message-entity-field
wl-message-entity
- 'from t))))
+ 'from))))
(defun wl-summary-line-list-info ()
(let ((list-info (wl-summary-get-list-info wl-message-entity)))
wl-cached))
(elmo-mime-charset wl-summary-buffer-mime-charset)
(elmo-lang wl-summary-buffer-weekday-name-lang)
- (wl-datevec (or (ignore-errors (timezone-fix-time
- (elmo-message-entity-field
- wl-message-entity
- 'date)
- nil
- wl-summary-fix-timezone))
- (make-vector 5 0)))
+ (wl-datevec (or (elmo-time-to-datevec
+ (elmo-message-entity-field wl-message-entity 'date)
+ wl-summary-fix-timezone)
+ (make-vector 7 0)))
(entity wl-message-entity) ; backward compatibility.
line mark)
(if (and wl-thr-indent-string
wl-summary-buffer-elmo-folder
(wl-summary-message-number))))
(wl-ps-subject
- (and entity
- (or (elmo-message-entity-field entity 'subject t)
- "")))
+ (or (elmo-message-entity-field entity 'subject 'string)
+ ""))
(wl-ps-from
- (and entity
- (or (elmo-message-entity-field entity 'from t) "")))
+ (or (elmo-message-entity-field entity 'from 'string)
+ ""))
(wl-ps-date
- (and entity
- (or (elmo-message-entity-field entity 'date) ""))))
+ (or (elmo-message-entity-field entity 'date 'string)
+ "")))
(run-hooks 'wl-ps-preprint-hook)
(set-buffer wl-message-buffer)
(copy-to-buffer buffer (point-min) (point-max))
projects / elisp / wanderlust.git / blobdiff