(defvar wl-message-buffer nil) ; message buffer.
-(defvar wl-message-buffer-cur-summary-buffer nil)
(defvar wl-message-buffer-cur-folder nil)
(defvar wl-message-buffer-cur-number nil)
-(defvar wl-message-buffer-cur-flag nil)
+(defvar wl-message-buffer-cur-display-type nil)
(defvar wl-message-buffer-cur-summary-buffer nil)
+(defvar wl-message-buffer-require-all-header nil)
(defvar wl-message-buffer-original-buffer nil) ; original buffer.
-(defvar wl-message-buffer-all-header-flag nil)
(defvar wl-message-buffer-mode-line-formatter nil)
+(defvar wl-message-buffer-flag-indicator nil)
(make-variable-buffer-local 'wl-message-buffer-cur-folder)
(make-variable-buffer-local 'wl-message-buffer-cur-number)
-(make-variable-buffer-local 'wl-message-buffer-cur-flag)
+(make-variable-buffer-local 'wl-message-buffer-cur-display-type)
(make-variable-buffer-local 'wl-message-buffer-cur-summary-buffer)
+(make-variable-buffer-local 'wl-message-buffer-require-all-header)
(make-variable-buffer-local 'wl-message-buffer-original-buffer)
-(make-variable-buffer-local 'wl-message-buffer-all-header-flag)
(make-variable-buffer-local 'wl-message-buffer-mode-line-formatter)
+(make-variable-buffer-local 'wl-message-buffer-flag-indicator)
(defvar wl-fixed-window-configuration nil)
"A major mode for original message buffer."
(setq major-mode 'wl-original-message-mode)
(setq buffer-read-only t)
- (elmo-set-buffer-multibyte nil)
+ (set-buffer-multibyte nil)
(setq mode-name "Wanderlust original message"))
(defun wl-original-message-buffer-get (name)
(setq mode-name "Message"))
(defun wl-message-exit ()
- "Move to summary buffer."
+ "Move to summary buffer or mother buffer."
(interactive)
- (let (summary-buf summary-win)
- (if (setq summary-buf wl-message-buffer-cur-summary-buffer)
- (if (setq summary-win (get-buffer-window summary-buf))
- (select-window summary-win)
- (switch-to-buffer summary-buf)
- (wl-message-select-buffer wl-message-buffer)
- (select-window (get-buffer-window summary-buf))))
+ (let (summary-buf summary-win mother-buffer)
+ (cond ((setq summary-buf wl-message-buffer-cur-summary-buffer)
+ (if (setq summary-win (get-buffer-window summary-buf))
+ (select-window summary-win)
+ (switch-to-buffer summary-buf)
+ (wl-message-select-buffer wl-message-buffer)
+ (select-window (get-buffer-window summary-buf))))
+ ((setq mother-buffer mime-mother-buffer)
+ (kill-buffer (current-buffer))
+ (switch-to-buffer mother-buffer)))
(run-hooks 'wl-message-exit-hook)))
(defun wl-message-toggle-disp-summary ()
(nth 3 entry) (match-string (nth 4 entry))))
(goto-char end)))))))
-(defun wl-message-redisplay (folder number flag &optional force-reload)
+;; display-type object definition.
+(defun wl-message-make-display-type (mime header)
+ (let (symbol)
+ (prog1
+ (setq symbol (intern (format "%s-%s-header" mime header)))
+ (put symbol
+ 'wl-message-display-type
+ (list :mime mime :header header)))))
+
+(defun wl-message-display-type-property (display-type prop)
+ (plist-get (get display-type 'wl-message-display-type) prop))
+
+(defun wl-message-mime-analysis-p (display-type &optional header-or-body)
+ (let ((mode (wl-message-display-type-property display-type :mime)))
+ (case header-or-body
+ (header
+ (memq mode '(mime header-only)))
+ (t
+ (eq mode 'mime)))))
+
+(defun wl-message-display-all-header-p (display-type)
+ (eq (wl-message-display-type-property display-type :header) 'all))
+
+(defun wl-message-buffer-display-type (&optional message-buffer)
+ (if message-buffer
+ (with-current-buffer message-buffer
+ wl-message-buffer-cur-display-type)
+ wl-message-buffer-cur-display-type))
+
+(defun wl-message-redisplay (folder number display-type &optional force-reload)
(let* ((default-mime-charset wl-mime-charset)
(buffer-read-only nil)
(summary-buf (current-buffer))
message-buf
strategy entity
cache-used
- summary-win delim)
+ summary-win delim flags)
(setq buffer-read-only nil)
(setq cache-used (wl-message-buffer-display
- folder number flag force-reload))
+ folder number display-type force-reload))
(setq wl-message-buffer (car cache-used))
(setq message-buf wl-message-buffer)
(wl-message-select-buffer wl-message-buffer)
(set-buffer message-buf)
+ (wl-deactivate-region)
(make-local-variable 'truncate-partial-width-windows)
(setq truncate-partial-width-windows nil)
(setq truncate-lines wl-message-truncate-lines)
(setq wl-message-buffer-cur-summary-buffer summary-buf)
(setq wl-message-buffer-cur-folder (elmo-folder-name-internal folder))
(setq wl-message-buffer-cur-number number)
+ (setq wl-message-buffer-flag-indicator
+ (if (setq flags (elmo-get-global-flags (elmo-message-flags
+ folder number)))
+ (let ((fl wl-summary-flag-alist)
+ flag-strings flag-string face)
+ (while fl
+ (when (memq (car (car fl)) flags)
+ (setq flag-string (capitalize
+ (symbol-name (car (car fl))))
+ flags (delq (car (car fl)) flags))
+ (when (facep (setq face
+ (intern
+ (format
+ "wl-highlight-summary-%s-flag-face"
+ (car (car fl))))))
+ (put-text-property 0 (length flag-string)
+ 'face face flag-string))
+ (setq flag-strings (nconc flag-strings
+ (list flag-string))))
+ (setq fl (cdr fl)))
+ (setq flag-strings
+ (nconc flag-strings
+ (mapcar (lambda (flag)
+ (capitalize (symbol-name flag)))
+ flags)))
+ (concat " (" (mapconcat 'identity flag-strings ", ") ")"))
+ ""))
(wl-line-formatter-setup
wl-message-buffer-mode-line-formatter
wl-message-mode-line-format
(when (re-search-forward "^$" nil t)
(wl-message-add-buttons-to-header (point-min) (point))
(wl-message-add-buttons-to-body (point) (point-max)))
- (when wl-message-use-header-narrowing
+ (when (and wl-message-use-header-narrowing
+ (not (wl-message-display-all-header-p display-type)))
(wl-message-header-narrowing))
(goto-char (point-min))
(ignore-errors (run-hooks 'wl-message-redisplay-hook))
cache-used))
;; Use message buffer cache.
-(defun wl-message-buffer-display (folder number flag
+(defun wl-message-buffer-display (folder number display-type
&optional force-reload unread)
(let* ((msg-id (ignore-errors (elmo-message-field folder number
'message-id)))
(widen)
(goto-char (point-min))
(ignore-errors (wl-message-narrow-to-page))
- (unless (eq wl-message-buffer-cur-flag flag)
+ (unless (eq wl-message-buffer-cur-display-type display-type)
(setq read t))))
;; delete tail and add new to the top.
(setq hit (wl-message-buffer-cache-add (list fname number msg-id)))
(set-buffer hit)
(setq
cache-used
- (wl-message-display-internal folder number flag
+ (wl-message-display-internal folder number display-type
force-reload unread))
- (setq wl-message-buffer-cur-flag flag))
+ (setq wl-message-buffer-cur-display-type display-type))
(quit
(wl-message-buffer-cache-delete)
(error "Display message %s/%s is quitted" fname number))
nil))) ;; will not be used
(cons hit cache-used)))
-(defun wl-message-display-internal (folder number flag
+(defun wl-message-display-internal (folder number display-type
&optional force-reload unread)
(let ((default-mime-charset wl-mime-charset)
(elmo-mime-charset wl-mime-charset))
- (setq wl-message-buffer-all-header-flag (eq flag 'all-header))
+ (setq wl-message-buffer-require-all-header
+ (wl-message-display-all-header-p display-type))
(prog1
- (if (eq flag 'as-is)
- (let (wl-highlight-x-face-function)
- (prog1 (elmo-mime-display-as-is folder number
- (current-buffer)
- (wl-message-get-original-buffer)
- 'wl-original-message-mode
- force-reload
- unread
- (wl-message-define-keymap))
- (let (buffer-read-only)
- (wl-highlight-message (point-min) (point-max) t))))
- (elmo-mime-message-display folder number
- (current-buffer)
- (wl-message-get-original-buffer)
- 'wl-original-message-mode
- force-reload
- unread
- (wl-message-define-keymap)))
+ (if (wl-message-mime-analysis-p display-type)
+ (elmo-mime-message-display folder number
+ (current-buffer)
+ (wl-message-get-original-buffer)
+ 'wl-original-message-mode
+ force-reload
+ unread
+ (wl-message-define-keymap))
+ (let* ((elmo-mime-display-header-analysis
+ (wl-message-mime-analysis-p display-type 'header))
+ (wl-highlight-x-face-function
+ (and elmo-mime-display-header-analysis
+ wl-highlight-x-face-function)))
+ (prog1 (elmo-mime-display-as-is folder number
+ (current-buffer)
+ (wl-message-get-original-buffer)
+ 'wl-original-message-mode
+ force-reload
+ unread
+ (wl-message-define-keymap))
+ (let (buffer-read-only)
+ (wl-highlight-message (point-min) (point-max) t)))))
(run-hooks 'wl-message-display-internal-hook)
(setq buffer-read-only t))))
-(defsubst wl-message-buffer-prefetch-p (folder &optional number)
+(defun wl-message-buffer-prefetch-p (folder &optional number)
(and (or (not number)
(elmo-message-file-p folder number)
(let ((size (elmo-message-field folder number 'size)))
(key (list (elmo-folder-name-internal folder)
number message-id))
(hit (wl-message-buffer-cache-hit key))
+ (display-type (wl-message-make-display-type
+ wl-summary-buffer-display-mime-mode
+ wl-summary-buffer-display-header-mode))
result time1 time2 sec micro)
(when wl-message-buffer-prefetch-debug
(message "%d: count %d, hit %s" number count (buffer-name hit)))
(setq time1 (current-time))
(message "Prefetching %d..." number))
(setq result (wl-message-buffer-display
- folder number 'mime nil 'unread))
+ folder number display-type nil 'unread))
(when wl-message-buffer-prefetch-debug
(setq time2 (current-time))
(setq sec (- (nth 1 time2)(nth 1 time1)))
(select-window (posn-window (event-start event)))
(let* ((win (selected-window))
(wpos (window-start win))
- (pos (posn-point (event-start event)))
+ (pos (mouse-set-point event))
(ovs (overlays-in (1- pos) (1+ pos))) ;; Uum...
ov)
(while (and ovs (not (overlayp ov)))
projects / elisp / wanderlust.git / blobdiff