-;;; wl-message.el -- Message displaying modules for Wanderlust.
+;;; wl-message.el --- Message displaying modules for Wanderlust.
;; Copyright (C) 1998,1999,2000 Yuuichi Teranishi <teranisi@gohome.org>
;;
;;; Commentary:
-;;
+;;
;;; Code:
-;;
+;;
(require 'wl-vars)
(require 'wl-highlight)
(require 'elmo)
-(require 'elmo-mime) ; XXX should modify for tm.
+(require 'elmo-mime)
(eval-when-compile
- (if wl-use-semi
- (progn
- (require 'wl-mime)
- (require 'mime-view))
- (require 'tm-wl))
+ (require 'wl-mime)
+ (require 'mime-view)
(defalias-maybe 'event-window 'ignore)
(defalias-maybe 'posn-window 'ignore)
(defalias-maybe 'event-start 'ignore)
(defvar wl-message-buffer-prefetch-get-next-function
'wl-summary-default-get-next-msg)
-(defvar wl-message-buffer-prefetch-folder-type-list t)
-
-(defvar wl-message-buffer-prefetch-debug t)
+(defvar wl-message-buffer-prefetch-debug nil)
(defvar wl-message-buffer nil) ; message buffer.
(defvar wl-message-buffer-cur-flag nil)
(defvar wl-message-buffer-cur-summary-buffer nil)
(defvar wl-message-buffer-original-buffer nil) ; original buffer.
+(defvar wl-message-buffer-all-header-flag 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-summary-buffer)
(make-variable-buffer-local 'wl-message-buffer-original-buffer)
+(make-variable-buffer-local 'wl-message-buffer-all-header-flag)
(defvar wl-fixed-window-configuration nil)
(if window
(select-window window)
(when wl-fixed-window-configuration
- (delete-other-windows)
- (and wl-stay-folder-window
- (wl-summary-toggle-disp-folder)))
+ (delete-other-windows)
+ (and wl-stay-folder-window
+ (wl-summary-toggle-disp-folder)))
;; There's no buffer window. Search for message window and snatch it.
(if (setq window (wl-message-buffer-window))
(select-window window)
(setq arg (if arg (prefix-numeric-value arg) 0))
(save-excursion
(condition-case ()
- (forward-page -1) ; Beginning of current page.
+ (forward-page -1) ; Beginning of current page.
(beginning-of-buffer
(goto-char (point-min))))
(forward-char 1) ; for compatibility with emacs-19.28 and emacs-19.29
"Scroll down current message by LINES.
Returns non-nil if top of message."
(interactive)
- (if (buffer-live-p wl-message-buffer)
- (let ((cur-buf (current-buffer))
- top)
- (wl-message-select-buffer wl-message-buffer)
- (move-to-window-line 0)
- (if (and wl-break-pages
- (bobp)
- (not (save-restriction (widen) (bobp))))
- (progn
- (wl-message-narrow-to-page -1)
- (goto-char (point-max))
- (recenter))
- (if (not (bobp))
- (condition-case nil
- (scroll-down lines)
- (error))
- (setq top t)))
- (select-window (get-buffer-window cur-buf))
- top)))
+ (let (cur-buf top real-top)
+ (unless (eq major-mode 'mime-view-mode)
+ (when (buffer-live-p wl-message-buffer)
+ (setq cur-buf (current-buffer))
+ (wl-message-select-buffer wl-message-buffer)))
+ (move-to-window-line 0)
+ (if (and wl-break-pages
+ (bobp)
+ (not (setq real-top (save-restriction (widen) (bobp)))))
+ (progn
+ (wl-message-narrow-to-page -1)
+ (goto-char (point-max))
+ (recenter))
+ (if (not (bobp))
+ (condition-case nil
+ (scroll-down lines)
+ (error))
+ (setq top t)))
+ (if real-top
+ (let ((f (assq (mime-preview-original-major-mode)
+ mime-preview-over-to-previous-method-alist)))
+ (if f (funcall (cdr f))))
+ (when cur-buf
+ (select-window (get-buffer-window cur-buf))))
+ top))
(defun wl-message-next-page (&optional lines)
"Scroll up current message by LINES.
Returns non-nil if bottom of message."
(interactive)
- (if (buffer-live-p wl-message-buffer)
- (let ((cur-buf (current-buffer))
- bottom)
- (wl-message-select-buffer wl-message-buffer)
- (move-to-window-line -1)
- (if (save-excursion
- (end-of-line)
- (and (pos-visible-in-window-p)
- (eobp)))
- (if (or (null wl-break-pages)
- (save-excursion
- (save-restriction
- (widen) (forward-line) (eobp))))
- (setq bottom t)
- (wl-message-narrow-to-page 1)
- (setq bottom nil))
- (condition-case ()
- (static-if (boundp 'window-pixel-scroll-increment)
- ;; XEmacs 21.2.20 and later.
- (let (window-pixel-scroll-increment)
- (scroll-up lines))
- (scroll-up lines))
- (end-of-buffer
- (goto-char (point-max))))
+ (let (cur-buf bottom)
+ (unless (eq major-mode 'mime-view-mode)
+ (when (buffer-live-p wl-message-buffer)
+ (setq cur-buf (current-buffer))
+ (wl-message-select-buffer wl-message-buffer)))
+ (move-to-window-line -1)
+ (if (save-excursion
+ (end-of-line)
+ (and (pos-visible-in-window-p)
+ (eobp)))
+ (if (or (null wl-break-pages)
+ (save-excursion
+ (save-restriction
+ (widen) (forward-line) (eobp))))
+ (setq bottom t)
+ (wl-message-narrow-to-page 1)
(setq bottom nil))
- (select-window (get-buffer-window cur-buf))
- bottom)))
+ (condition-case ()
+ (static-if (boundp 'window-pixel-scroll-increment)
+ ;; XEmacs 21.2.20 and later.
+ (let (window-pixel-scroll-increment)
+ (scroll-up lines))
+ (scroll-up lines))
+ (end-of-buffer
+ (goto-char (point-max))))
+ (setq bottom nil))
+ (if (eobp)
+ (let ((f (assq (mime-preview-original-major-mode)
+ mime-preview-over-to-next-method-alist)))
+ (if f (funcall (cdr f))))
+ (when cur-buf
+ (select-window (get-buffer-window cur-buf))))
+ bottom))
(defun wl-message-follow-current-entity (buffer)
(let ((mail-reply-buffer buffer))
(wl-draft-yank-from-mail-reply-buffer nil)))
-;;
+;;
(defun wl-message-mode ()
"A major mode for message displaying."
(wl-message-select-buffer wl-message-buffer))
(wl-summary-goto-folder-subr wl-message-buffer-cur-folder 'no-sync
nil nil t)
- ; no summary-buf
+ ; no summary-buf
(let ((sum-buf (current-buffer)))
(wl-message-select-buffer wl-message-buffer)
(setq wl-message-buffer-cur-summary-buffer sum-buf)))))
"Get original buffer for current message buffer."
wl-message-buffer-original-buffer)
+(defun wl-message-add-buttons-to-body (start end)
+ (save-excursion
+ (save-restriction
+ (narrow-to-region start end)
+ (let ((case-fold-search t)
+ (alist wl-message-body-button-alist)
+ entry)
+ (while alist
+ (setq entry (car alist)
+ alist (cdr alist))
+ (goto-char (point-min))
+ (while (re-search-forward (car entry) (+ (point) (nth 4 entry)) t)
+ (unless (get-text-property (point) 'keymap)
+ (wl-message-add-button
+ (match-beginning (nth 1 entry))
+ (match-end (nth 1 entry))
+ (nth 2 entry)
+ (match-string (nth 3 entry))))))))))
+
+(defun wl-message-add-buttons-to-header (start end)
+ (save-excursion
+ (save-restriction
+ (narrow-to-region start end)
+ (let ((case-fold-search t)
+ (alist wl-message-header-button-alist)
+ entry)
+ (while alist
+ (setq entry (car alist)
+ alist (cdr alist))
+ (goto-char (point-min))
+ (while (re-search-forward (car entry) nil t)
+ (setq start (match-beginning 0)
+ end (if (re-search-forward "^[^ \t]" nil t)
+ (match-beginning 0)
+ (point-max)))
+ (goto-char start)
+ (while (re-search-forward (nth 1 entry) end t)
+ (goto-char (match-end 0))
+ (wl-message-add-button
+ (match-beginning (nth 2 entry))
+ (match-end (nth 2 entry))
+ (nth 3 entry) (match-string (nth 4 entry))))
+ (goto-char end)))))))
+
(defun wl-message-redisplay (folder number flag &optional force-reload)
(let* ((default-mime-charset wl-mime-charset)
(buffer-read-only nil)
message-buf
strategy entity
cache-used
- header-end real-fld-num summary-win)
+ header-end real-fld-num summary-win delim)
(setq buffer-read-only nil)
(setq cache-used (wl-message-buffer-display
folder number flag force-reload))
(wl-message-select-buffer wl-message-buffer)
(set-buffer message-buf)
+ (make-local-variable 'truncate-partial-width-windows)
+ (setq truncate-partial-width-windows nil)
+ (setq truncate-lines wl-message-truncate-lines)
(setq buffer-read-only nil)
(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)
- (wl-message-overload-functions)
(setq mode-line-buffer-identification
(format "Wanderlust: << %s / %s >>"
(if (memq 'modeline wl-use-folder-petname)
(error nil)); ignore errors.
(setq cache-used (cdr cache-used))
(goto-char (point-min))
+ (when (re-search-forward "^$" nil t)
+ (wl-message-add-buttons-to-header (point-min) (point))
+ (wl-message-add-buttons-to-body (point) (point-max)))
+ (goto-char (point-min))
(unwind-protect
(save-excursion
(run-hooks 'wl-message-redisplay-hook))
(defun wl-message-display-internal (folder number flag
&optional force-reload unread)
- (let ((elmo-message-ignored-field-list
- (if (eq flag 'all-header)
- nil
- wl-message-ignored-field-list))
- (elmo-message-visible-field-list wl-message-visible-field-list)
- (elmo-message-sorted-field-list wl-message-sort-field-list)
- (elmo-message-fetch-threshold wl-fetch-confirm-threshold))
- (prog1
+ (let ((default-mime-charset wl-mime-charset))
+ (setq wl-message-buffer-all-header-flag (eq flag 'all-header))
+ (prog1
(if (eq flag 'as-is)
(let (wl-highlight-x-face-function)
- (elmo-mime-display-as-is folder number
- (current-buffer)
- (wl-message-get-original-buffer)
- 'wl-original-message-mode
- force-reload
- unread))
+ (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))
+ unread
+ (wl-message-define-keymap)))
+ (run-hooks 'wl-message-display-internal-hook)
(setq buffer-read-only t))))
(defsubst wl-message-buffer-prefetch-p (folder &optional number)
- (cond
- ((eq wl-message-buffer-prefetch-folder-type-list t)
- t)
- ((and number wl-message-buffer-prefetch-folder-type-list)
- (memq (elmo-folder-type-internal
- (elmo-message-folder folder number))
- wl-message-buffer-prefetch-folder-type-list))
- (wl-message-buffer-prefetch-folder-type-list
- (let ((list wl-message-buffer-prefetch-folder-type-list)
- type)
- (catch 'done
- (while (setq type (pop list))
- (if (elmo-folder-contains-type folder type)
- (throw 'done t))))))
- ((consp wl-message-buffer-prefetch-folder-type-list)
- (wl-string-match-member (elmo-folder-name-internal folder)
- wl-message-buffer-prefetch-folder-type-list))
- (t wl-message-buffer-prefetch-folder-type-list)))
-
+ (or (cond
+ ((eq wl-message-buffer-prefetch-folder-type-list t)
+ t)
+ ((and number wl-message-buffer-prefetch-folder-type-list)
+ (memq (elmo-folder-type-internal
+ (elmo-message-folder folder number))
+ wl-message-buffer-prefetch-folder-type-list))
+ (wl-message-buffer-prefetch-folder-type-list
+ (let ((list wl-message-buffer-prefetch-folder-type-list)
+ type)
+ (catch 'done
+ (while (setq type (pop list))
+ (if (elmo-folder-contains-type folder type)
+ (throw 'done t)))))))
+ (cond
+ ((consp wl-message-buffer-prefetch-folder-list)
+ (wl-string-match-member (elmo-folder-name-internal folder)
+ wl-message-buffer-prefetch-folder-list))
+ (t wl-message-buffer-prefetch-folder-list))))
(defvar wl-message-buffer-prefetch-timer nil)
number message-id)))
(let* ((size (elmo-message-field folder number 'size)))
(when (or (elmo-message-file-p folder number)
- (not
+ (not
(and (integerp size)
elmo-message-fetch-threshold
(>= size
(if (wl-summary-jump-to-msg-by-message-id data)
(wl-summary-redisplay)))
-(defun wl-message-refer-article-or-url (e)
- "Read article specified by message-id around point.
-If failed, attempt to execute button-dispatcher."
- (interactive "e")
- (let ((window (get-buffer-window (current-buffer)))
- mouse-window point beg end msg-id)
- (unwind-protect
- (progn
- (mouse-set-point e)
- (setq mouse-window (get-buffer-window (current-buffer)))
- (setq point (point))
- (setq beg (save-excursion (beginning-of-line) (point)))
- (setq end (save-excursion (end-of-line) (point)))
- (search-forward ">" end t) ;Move point to end of "<....>".
- (if (and (re-search-backward "\\(<[^<> \t\n]+@[^<> \t\n]+>\\)"
- beg t)
- (not (string-match "mailto:"
- (setq msg-id (wl-match-buffer 1)))))
- (progn
- (goto-char point)
- (switch-to-buffer-other-window
- wl-message-buffer-cur-summary-buffer)
- (if (wl-summary-jump-to-msg-by-message-id msg-id)
- (wl-summary-redisplay)))
- (wl-message-button-dispatcher-internal e)))
- (if (eq mouse-window (get-buffer-window (current-buffer)))
- (select-window window)))))
-
(defun wl-message-uu-substring (buf outbuf &optional first last)
(save-excursion
(set-buffer buf)
projects / elisp / wanderlust.git / blobdiff