(wl-xmas-setup-message-toolbar): Define as function.
(wl-setup-message): Define as alias for wl-xmas-setup-message-toolbar.
(wl-message-overload-functions): Abolished.
(wl-message-define-keymap): New function.
* wl-vars.el (wl-message-display-internal-hook): New variable.
(wl-message-header-button-alist): New variable (Renamed from
wl-highlight-message-header-button-alist).
(wl-message-body-button-alist): Ditto.
* wl-mule.el (wl-message-define-keymap): New function.
(wl-message-overload-functions): Abolished.
* wl-message.el (wl-message-add-buttons-to-body): New function.
(wl-message-redisplay): Don't call wl-message-overload-functions;
Call wl-message-add-buttons-to-header and
wl-message-add-buttons-to-body.
(wl-message-display-internal): Set keymap argument for
elmo-mime-display-as-is, elmo-mime-message-display;
Run wl-message-display-internal-hook.
(wl-message-refer-article-or-url): Abolished.
* wl-highlight.el (wl-highlight-headers): Don't call
wl-highlight-message-add-buttons-to-header.
(wl-highlight-message-add-buttons-to-header): Abolished.
* wl-e21.el (wl-message-display-internal-hook): Define.
(wl-e21-setup-toolbar): Deleted duplicated binding.
(wl-e21-setup-message-toolbar): Define as function.
(wl-setup-message): Define as alias for wl-e21-setup-message-toolbar.
(wl-message-define-keymap): New function.
(wl-message-overload-functions): Abolished.
* elmo-mime.el (elmo-mime-message-display): Added argument keymap;
Set 4th argument of mime-display-message.
(elmo-mime-display-as-is): Ditto.
+2001-10-02 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * elmo-mime.el (elmo-mime-message-display): Added argument keymap;
+ Set 4th argument of mime-display-message.
+ (elmo-mime-display-as-is): Ditto.
+
2001-10-01 Yuuichi Teranishi <teranisi@gohome.org>
* elmo-nmz.el (toplevel): Require 'mime-edit.
rawbuf))
(defun elmo-mime-message-display (folder number viewbuf rawbuf original-mode
- &optional ignore-cache unread)
+ &optional ignore-cache unread keymap)
"Display MIME message.
A message in the FOLDER with NUMBER is displayed on the VIEWBUF using RAWBUF.
VIEWBUF is a view buffer and RAWBUF is a raw buffer.
'elmo-buffer)
(elmo-make-mime-message-location
folder number strategy rawbuf unread))
- viewbuf nil nil original-mode)
+ viewbuf nil keymap
+ original-mode)
(if strategy
(or (elmo-fetch-strategy-use-cache strategy)
(eq (elmo-fetch-strategy-entireness strategy)
'section)))))
(defun elmo-mime-display-as-is (folder number viewbuf rawbuf original-mode
- &optional ignore-cache unread)
+ &optional ignore-cache unread keymap)
"Display MIME message.
A message in the FOLDER with NUMBER is displayed on the VIEWBUF using RAWBUF.
VIEWBUF is a view buffer and RAWBUF is a raw buffer.
'elmo-buffer
(elmo-make-mime-message-location
folder number strategy rawbuf unread))
- viewbuf nil nil original-mode)
+ viewbuf nil keymap original-mode)
(elmo-fetch-strategy-use-cache strategy)))
;; Replacement of mime-display-message.
+2001-10-02 Yuuichi Teranishi <teranisi@gohome.org>
+
+ * wl-xmas.el (wl-message-display-internal-hook): Define.
+ (wl-xmas-setup-message-toolbar): Define as function.
+ (wl-setup-message): Define as alias for wl-xmas-setup-message-toolbar.
+ (wl-message-overload-functions): Abolished.
+ (wl-message-define-keymap): New function.
+
+ * wl-vars.el (wl-message-display-internal-hook): New variable.
+ (wl-message-header-button-alist): New variable (Renamed from
+ wl-highlight-message-header-button-alist).
+ (wl-message-body-button-alist): Ditto.
+
+ * wl-mule.el (wl-message-define-keymap): New function.
+ (wl-message-overload-functions): Abolished.
+
+ * wl-message.el (wl-message-add-buttons-to-body): New function.
+ (wl-message-redisplay): Don't call wl-message-overload-functions;
+ Call wl-message-add-buttons-to-header and
+ wl-message-add-buttons-to-body.
+ (wl-message-display-internal): Set keymap argument for
+ elmo-mime-display-as-is, elmo-mime-message-display;
+ Run wl-message-display-internal-hook.
+ (wl-message-refer-article-or-url): Abolished.
+
+ * wl-highlight.el (wl-highlight-headers): Don't call
+ wl-highlight-message-add-buttons-to-header.
+ (wl-highlight-message-add-buttons-to-header): Abolished.
+
+
+ * wl-e21.el (wl-message-display-internal-hook): Define.
+ (wl-e21-setup-toolbar): Deleted duplicated binding.
+ (wl-e21-setup-message-toolbar): Define as function.
+ (wl-setup-message): Define as alias for wl-e21-setup-message-toolbar.
+ (wl-message-define-keymap): New function.
+ (wl-message-overload-functions): Abolished.
+
2001-10-01 Yuuichi Teranishi <teranisi@gohome.org>
* wl-draft.el (wl-draft-queue-flush): Call elmo-folder-open-internal
(add-hook 'wl-summary-mode-hook 'wl-setup-summary)
+(add-hook 'wl-message-display-internal-hook 'wl-setup-message)
+
(defvar wl-use-toolbar (image-type-available-p 'xpm))
(defvar wl-plugged-image nil)
(defvar wl-unplugged-image nil)
:color-symbols (("backgroundToolBarColor" . "None"))
:file))
(success t)
- icon up down disabled name success)
+ icon up down disabled name)
(while bar
(setq icon (aref (pop bar) 0))
(unless (boundp icon)
(wl-e21-make-toolbar-buttons wl-summary-mode-map wl-summary-toolbar)))
(eval-when-compile
- (defsubst wl-e21-setup-message-toolbar (keymap)
- (when (wl-e21-setup-toolbar wl-message-toolbar)
- (wl-e21-make-toolbar-buttons keymap wl-message-toolbar)))
-
(defsubst wl-e21-setup-draft-toolbar ()
(when (wl-e21-setup-toolbar wl-draft-toolbar)
(wl-e21-make-toolbar-buttons wl-draft-mode-map wl-draft-toolbar))))
+(defun wl-e21-setup-message-toolbar ()
+ (when (wl-e21-setup-toolbar wl-message-toolbar)
+ (wl-e21-make-toolbar-buttons (current-local-map) wl-message-toolbar)))
+
(defvar wl-folder-toggle-icon-list
'((wl-folder-opened-image . wl-opened-group-folder-icon)
(wl-folder-closed-image . wl-closed-group-folder-icon)))
(defalias 'wl-setup-summary 'wl-e21-setup-summary-toolbar)
-(defun wl-message-overload-functions ()
- (let ((keymap (current-local-map)))
- (when keymap
- (wl-e21-setup-message-toolbar keymap)
- (define-key keymap "l" 'wl-message-toggle-disp-summary)
- (define-key keymap [mouse-2] 'wl-message-refer-article-or-url)
- (define-key keymap [mouse-4] 'wl-message-wheel-down)
- (define-key keymap [mouse-5] 'wl-message-wheel-up)
- (define-key keymap [S-mouse-4] 'wl-message-wheel-down)
- (define-key keymap [S-mouse-5] 'wl-message-wheel-up)
- (set-keymap-parent wl-message-button-map keymap)
- (define-key wl-message-button-map
- [mouse-2] 'wl-message-button-dispatcher))))
+(defvar widget-keymap)
+(defun wl-message-define-keymap ()
+ (let ((keymap (make-sparse-keymap)))
+ (define-key keymap "l" 'wl-message-toggle-disp-summary)
+ (define-key keymap [mouse-4] 'wl-message-wheel-down)
+ (define-key keymap [mouse-5] 'wl-message-wheel-up)
+ (define-key keymap [S-mouse-4] 'wl-message-wheel-down)
+ (define-key keymap [S-mouse-5] 'wl-message-wheel-up)
+ (when (and (get 'mime-button 'widget-type) ; mime-button is defined.
+ (boundp 'widget-keymap))
+ (set-keymap-parent keymap widget-keymap))
+ (set-keymap-parent wl-message-button-map keymap)
+ (define-key wl-message-button-map
+ [mouse-2] 'wl-message-button-dispatcher)
+ keymap))
+
+(defalias 'wl-setup-message 'wl-e21-setup-message-toolbar)
(defun wl-message-wheel-up (event)
(interactive "e")
(point-max))))
(wl-highlight-message beg end nil)
(unless for-draft
- (wl-highlight-message-add-buttons-to-header beg end)
(when wl-highlight-x-face-function
(funcall wl-highlight-x-face-function)))
(run-hooks 'wl-highlight-headers-hook)))
-(defun wl-highlight-message-add-buttons-to-header (start end)
- (save-excursion
- (save-restriction
- (narrow-to-region start end)
- (let ((case-fold-search t)
- (alist wl-highlight-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-highlight-body-all ()
(wl-highlight-message (point-min) (point-max) t t))
"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) nil 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))
(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))
(wl-message-get-original-buffer)
'wl-original-message-mode
force-reload
- unread)
+ unread
+ (wl-message-define-keymap))
(let (buffer-read-only)
(wl-highlight-message (point-min) (point-max) t))))
(elmo-mime-message-display folder number
(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)
wl-message-buffer-prefetch-folder-type-list))
(t wl-message-buffer-prefetch-folder-type-list)))
-
(defvar wl-message-buffer-prefetch-timer nil)
(defun wl-message-buffer-prefetch-next (folder number &optional
(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)
(defun wl-plugged-set-folder-icon (folder string)
string)
-(defun wl-message-overload-functions ()
- (local-set-key "l" 'wl-message-toggle-disp-summary)
- (local-set-key [mouse-2] 'wl-message-refer-article-or-url)
- (local-set-key [mouse-4] 'wl-message-wheel-down)
- (local-set-key [mouse-5] 'wl-message-wheel-up)
- (local-set-key [S-mouse-4] 'wl-message-wheel-down)
- (local-set-key [S-mouse-5] 'wl-message-wheel-up)
- (if (fboundp 'set-keymap-parent)
- (set-keymap-parent wl-message-button-map (current-local-map)))
- (define-key wl-message-button-map [mouse-2]
- 'wl-message-button-dispatcher))
+(defvar widget-keymap)
+(defun wl-message-define-keymap ()
+ (let ((keymap (make-sparse-keymap)))
+ (define-key keymap "l" 'wl-message-toggle-disp-summary)
+ (define-key keymap [mouse-4] 'wl-message-wheel-down)
+ (define-key keymap [mouse-5] 'wl-message-wheel-up)
+ (define-key keymap [S-mouse-4] 'wl-message-wheel-down)
+ (define-key keymap [S-mouse-5] 'wl-message-wheel-up)
+ (when (fboundp 'set-keymap-parent)
+ (when (and (get 'mime-button 'widget-type) ; mime-button is defined.
+ (boundp 'widget-keymap))
+ (set-keymap-parent keymap widget-keymap))
+ (set-keymap-parent wl-message-button-map keymap))
+ (define-key wl-message-button-map [mouse-2]
+ 'wl-message-button-dispatcher))
(defun wl-message-wheel-up (event)
(interactive "e")
"A hook called when summary line is inserted.")
(defvar wl-summary-insert-headers-hook nil
"A hook called when insert header for search header.")
+(defvar wl-message-display-internal-hook nil
+ "A hook called when message buffer is created and message is displayed.
+This hook may contain the functions `wl-setup-message' for
+reasons of system internal to accord facilities for the Emacs variants.")
(defvar wl-thread-update-children-number-hook nil
"A hook called when children number is updated.")
(defvar wl-folder-update-access-group-hook nil
:group 'wl-pref
:group 'wl-setting)
+(defcustom wl-message-header-button-alist
+ (` (("^\\(References\\|Message-Id\\|In-Reply-To\\):"
+ "<[^>]+>"
+ 0 wl-message-button-refer-article 0)
+ ("^[^:]+:"
+ "\\(<\\(url: \\)?news:\\([^>\n ]*\\)>\\)"
+ 1 wl-message-button-refer-article 3)))
+ "Alist of headers and regexps to match buttons in message headers."
+ :type '(repeat
+ (list (regexp :tag "Header")
+ regexp
+ (integer :tag "Button")
+ (function :tag "Callback")
+ (repeat :tag "Data"
+ :inline t
+ (integer :tag "Regexp group"))))
+ :group 'wl-pref)
+
+(defcustom wl-message-body-button-alist
+ '(("<mailto:[^>]+>" 0 'ignore 0)
+ ("<[^>]+@[^>]+>" 0 wl-message-button-refer-article 0))
+ "Alist of regexps to match buttons in message body."
+ :type '(repeat
+ (list regexp
+ (integer :tag "Button")
+ (function :tag "Callback")
+ (repeat :tag "Data"
+ :inline t
+ (integer :tag "Regexp group"))))
+ :group 'wl-pref)
+
(defcustom wl-folder-window-width 20
"*Width of folder window."
:type 'integer
:type '(repeat (cons regexp face))
:group 'wl-highlight)
-(defcustom wl-highlight-message-header-button-alist
- (` (("^\\(References\\|Message-Id\\|In-Reply-To\\):" "<[^>]+>"
- 0 wl-message-button-refer-article 0)
- ("^[^:]+:" "\\(<\\(url: \\)?news:\\([^>\n ]*\\)>\\)"
- 1 wl-message-button-refer-article 3)))
- "Alist of headers and regexps to match buttons in message headers."
- :type '(repeat
- (list (regexp :tag "Header")
- regexp
- (integer :tag "Button")
- (function :tag "Callback")
- (repeat :tag "Data"
- :inline t
- (integer :tag "Regexp group"))))
- :group 'wl-highlight)
-
(defcustom wl-highlight-citation-prefix-regexp
"^[>|:} ]*[>|:}]\\([^ \n>]*>\\)?\\|^[^ <\n>]*>"
"All lines that match this regexp will be highlighted with
(add-hook 'wl-summary-mode-hook 'wl-setup-summary)
+(add-hook 'wl-message-display-internal-hook 'wl-setup-message)
+
(defvar wl-use-toolbar (if (featurep 'toolbar) 'default-toolbar nil))
(defvar wl-plugged-glyph nil)
(defvar wl-unplugged-glyph nil)
(set-specifier (symbol-value wl-use-toolbar)
(cons (current-buffer) wl-summary-toolbar))))
- (defsubst wl-xmas-setup-message-toolbar ()
- (and wl-use-toolbar
- (wl-xmas-setup-toolbar wl-message-toolbar)
- (set-specifier (symbol-value wl-use-toolbar)
- (cons (current-buffer) wl-message-toolbar))))
-
(defsubst wl-xmas-setup-draft-toolbar ()
(and wl-use-toolbar
(wl-xmas-setup-toolbar wl-draft-toolbar)
(set-specifier (symbol-value wl-use-toolbar)
(cons (current-buffer) wl-draft-toolbar)))))
+(defun wl-xmas-setup-message-toolbar ()
+ (and wl-use-toolbar
+ (wl-xmas-setup-toolbar wl-message-toolbar)
+ (set-specifier (symbol-value wl-use-toolbar)
+ (cons (current-buffer) wl-message-toolbar))))
+
(defvar wl-folder-toggle-icon-list
'((wl-folder-opened-glyph . wl-opened-group-folder-icon)
(wl-folder-closed-glyph . wl-closed-group-folder-icon)))
(set-specifier scrollbar-height (cons (current-buffer) 0)))
(wl-xmas-setup-summary-toolbar))
-(defun wl-message-overload-functions ()
- (wl-xmas-setup-message-toolbar)
- (local-set-key "l" 'wl-message-toggle-disp-summary)
- (local-set-key 'button2 'wl-message-refer-article-or-url)
- (local-set-key 'button4 'wl-message-wheel-down)
- (local-set-key 'button5 'wl-message-wheel-up)
- (local-set-key [(shift button4)] 'wl-message-wheel-down)
- (local-set-key [(shift button5)] 'wl-message-wheel-up)
- (set-keymap-parent wl-message-button-map (current-local-map))
- (define-key wl-message-button-map 'button2
- 'wl-message-button-dispatcher))
+(defalias 'wl-setup-message 'wl-xmas-setup-message-toolbar)
+
+(defun wl-message-define-keymap ()
+ (let ((keymap (make-sparse-keymap)))
+ (define-key keymap "l" 'wl-message-toggle-disp-summary)
+ (define-key keymap 'button4 'wl-message-wheel-down)
+ (define-key keymap 'button5 'wl-message-wheel-up)
+ (define-key keymap [(shift button4)] 'wl-message-wheel-down)
+ (define-key keymap [(shift button5)] 'wl-message-wheel-up)
+ (set-keymap-parent wl-message-button-map keymap)
+ (define-key wl-message-button-map 'button2
+ 'wl-message-button-dispatcher)
(defun wl-message-wheel-up (event)
(interactive "e")
projects / elisp / wanderlust.git / commitdiff