;;; Code:
;;
(eval-when-compile (require 'cl))
+(eval-when-compile (require 'static))
(require 'wl-vars)
(require 'wl-highlight)
'wl-summary-default-get-next-msg)
(defvar wl-message-buffer-prefetch-debug nil)
-(defvar wl-message-buffer-prefetch-timer nil)
(defvar wl-message-buffer nil) ; message buffer.
With association ((\"folder\" message \"message-id\") . cache-buffer).")
(defmacro wl-message-buffer-cache-buffer-get (entry)
- (` (cdr (, entry))))
+ `(cdr ,entry))
(defmacro wl-message-buffer-cache-folder-get (entry)
- (` (car (car (, entry)))))
+ `(car (car ,entry)))
(defmacro wl-message-buffer-cache-message-get (entry)
- (` (cdr (car (, entry)))))
+ `(cdr (car ,entry)))
(defmacro wl-message-buffer-cache-entry-make (key buf)
- (` (cons (, key) (, buf))))
+ `(cons ,key ,buf))
(defmacro wl-message-buffer-cache-hit (key)
"Return value assosiated with key."
- (` (wl-message-buffer-cache-buffer-get
- (assoc (, key) wl-message-buffer-cache))))
+ `(wl-message-buffer-cache-buffer-get
+ (assoc ,key wl-message-buffer-cache)))
(defun wl-message-buffer-cache-sort (entry)
"Move ENTRY to the top of `wl-message-buffer-cache'."
(setq wl-message-buffer-cache
(cons entry (delete entry wl-message-buffer-cache))))
-; (let* ((pointer (cons nil wl-message-buffer-cache))
-; (top pointer))
-; (while (cdr pointer)
-; (if (equal (car (cdr pointer)) entry)
-; (setcdr pointer (cdr (cdr pointer)))
-; (setq pointer (cdr pointer))))
-; (setcdr pointer (list entry))
-; (setq wl-message-buffer-cache (cdr top))))
+;;; (let* ((pointer (cons nil wl-message-buffer-cache))
+;;; (top pointer))
+;;; (while (cdr pointer)
+;;; (if (equal (car (cdr pointer)) entry)
+;;; (setcdr pointer (cdr (cdr pointer)))
+;;; (setq pointer (cdr pointer))))
+;;; (setcdr pointer (list entry))
+;;; (setq wl-message-buffer-cache (cdr top))))
(defconst wl-original-message-buffer-name " *Original*")
(mes (cdr wl-message-window-size))
whi)
(when (and window
- (not (eq (save-excursion (set-buffer (window-buffer window))
- wl-message-buffer-cur-summary-buffer)
+ (not (eq (with-current-buffer (window-buffer window)
+ wl-message-buffer-cur-summary-buffer)
(current-buffer))))
(delete-window window)
(run-hooks 'wl-message-window-deleted-hook)
(interactive)
(let (summary-buf summary-win mother-buffer)
(cond ((setq summary-buf wl-message-buffer-cur-summary-buffer)
+ (unless (buffer-live-p summary-buf)
+ (error "Summary buffer not found: %s"
+ wl-message-buffer-cur-folder))
(if (setq summary-win (get-buffer-window summary-buf))
(select-window summary-win)
(switch-to-buffer summary-buf)
(select-window (get-buffer-window summary-buf))))
((setq mother-buffer mime-mother-buffer)
(kill-buffer (current-buffer))
- (switch-to-buffer mother-buffer)))
+ (when (buffer-live-p mother-buffer)
+ (switch-to-buffer mother-buffer))))
(run-hooks 'wl-message-exit-hook)))
(defun wl-message-toggle-disp-summary ()
(defun wl-message-display-all-header-p (display-type)
(eq (wl-message-display-type-property display-type :header) 'all))
+(defun wl-message-display-no-merge-p (display-type)
+ (eq (wl-message-display-type-property display-type :mime) 'no-merge))
+
(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-flag-indicator (flags)
+ (let ((flags (elmo-get-global-flags flags)))
+ (if (null flags)
+ ""
+ (concat
+ " ("
+ (mapconcat
+ (lambda (flag)
+ (let ((indicator (capitalize (symbol-name flag)))
+ face)
+ (when (and (assq flag wl-summary-flag-alist)
+ (facep
+ (setq face (intern
+ (format "wl-highlight-summary-%s-flag-face"
+ flag)))))
+ (put-text-property 0 (length indicator) 'face face indicator))
+ indicator))
+ (sort flags
+ (lambda (l r)
+ (> (length (memq (assq l wl-summary-flag-alist)
+ wl-summary-flag-alist))
+ (length (memq (assq r wl-summary-flag-alist)
+ wl-summary-flag-alist)))))
+ ", ")
+ ")"))))
+
(defun wl-message-redisplay (folder number display-type &optional force-reload)
(let* ((default-mime-charset wl-mime-charset)
(buffer-read-only nil)
(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-message-flag-indicator (elmo-message-flags folder number)))
(wl-line-formatter-setup
wl-message-buffer-mode-line-formatter
wl-message-mode-line-format
wl-message-mode-line-format-spec-alist)
(setq mode-line-buffer-identification
(funcall wl-message-buffer-mode-line-formatter))
- ;; highlight body
-; (when wl-highlight-body-too
-; (wl-highlight-body))
+;;; ;; highlight body
+;;; (when wl-highlight-body-too
+;;; (wl-highlight-body))
(ignore-errors (wl-message-narrow-to-page))
(goto-char (point-min))
(when (re-search-forward "^$" nil t)
(setq redisplay t))
(when (or force-reload redisplay)
(condition-case err
- (save-excursion
- (set-buffer hit)
+ (with-current-buffer hit
(when (or force-reload
(null entity)
(not (elmo-mime-entity-display-p
entity
(if (wl-message-mime-analysis-p display-type)
'mime
- 'as-is))))
+ 'as-is)))
+ (if (wl-message-display-no-merge-p display-type)
+ (elmo-mime-entity-reassembled-p entity)
+ (elmo-mime-entity-fragment-p entity)))
(setq entity (elmo-message-mime-entity
folder
number
(wl-message-get-original-buffer)
+ (and wl-message-auto-reassemble-message/partial
+ (not (wl-message-display-no-merge-p
+ display-type)))
force-reload
unread
(not (wl-message-mime-analysis-p display-type)))))
(t wl-message-buffer-prefetch-folder-list)))))
(defsubst wl-message-buffer-prefetch-clear-timer ()
-;;; cannot use for the bug of fsf-compat package (1.09).
-;;; (cancel-function-timers 'wl-message-buffer-prefetch-subr)
+;;; cannot use for the bug of fsf-compat package (1.09).
+;;; (cancel-function-timers 'wl-message-buffer-prefetch-subr)
(if (fboundp 'run-with-idle-timer)
(if (featurep 'xemacs)
(let ((p itimer-list))
(when wl-message-buffer-prefetch-debug
(message "Buffer Cached Messages: %s"
(mapconcat
- '(lambda (cache)
- (if (numberp (nth 1 (car cache)))
- (if (string=
- (nth 0 (car cache))
- (elmo-folder-name-internal folder))
- (format "%d"
- (nth 1 (car cache)))
- (format "*%d" (nth 1 (car cache))))
- "-"))
+
+ (lambda (cache)
+ (if (numberp (nth 1 (car cache)))
+ (if (string=
+ (nth 0 (car cache))
+ (elmo-folder-name-internal folder))
+ (format "%d"
+ (nth 1 (car cache)))
+ (format "*%d" (nth 1 (car cache))))
+ "-"))
wl-message-buffer-cache " "))) )))
(defvar wl-message-button-map (make-sparse-keymap))
(wl-summary-redisplay)))
(defun wl-message-uu-substring (buf outbuf &optional first last)
- (save-excursion
- (set-buffer buf)
+ (with-current-buffer buf
(search-forward "\n\n")
(let ((sp (point))
ep filename case-fold-search)
(setq filename (buffer-substring (match-beginning 1)(match-end 1)))
(throw 'done nil)))
(re-search-forward "^M.*$" nil t)) ; uuencoded string
- (beginning-of-line)
- (setq sp (point))
+ (setq sp (point-at-bol))
(goto-char (point-max))
(if last
(re-search-backward "^end" sp t)
(re-search-backward "^M.*$" sp t)) ; uuencoded string
(forward-line 1)
(setq ep (point))
- (set-buffer outbuf)
- (goto-char (point-max))
- (insert-buffer-substring buf sp ep)
- (set-buffer buf)
+ (with-current-buffer outbuf
+ (goto-char (point-max))
+ (insert-buffer-substring buf sp ep))
filename))))
;;; Header narrowing courtesy of Hideyuki Shirai.
projects / elisp / wanderlust.git / blobdiff