From: teranisi Date: Mon, 1 Oct 2001 16:58:08 +0000 (+0000) Subject: * wl-xmas.el (wl-message-display-internal-hook): Define. X-Git-Tag: wl-2_7_5~23 X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=4c0926c573fd336d678d1795bd3ef84792e076da;p=elisp%2Fwanderlust.git * 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. * elmo-mime.el (elmo-mime-message-display): Added argument keymap; Set 4th argument of mime-display-message. (elmo-mime-display-as-is): Ditto. --- diff --git a/elmo/ChangeLog b/elmo/ChangeLog index 81fc922..94ab728 100644 --- a/elmo/ChangeLog +++ b/elmo/ChangeLog @@ -1,3 +1,9 @@ +2001-10-02 Yuuichi Teranishi + + * 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 * elmo-nmz.el (toplevel): Require 'mime-edit. diff --git a/elmo/elmo-mime.el b/elmo/elmo-mime.el index cd2fa19..7705677 100644 --- a/elmo/elmo-mime.el +++ b/elmo/elmo-mime.el @@ -210,7 +210,7 @@ value is used." 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. @@ -235,14 +235,15 @@ Return non-nil if not entire message was fetched." '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. @@ -267,7 +268,7 @@ Return non-nil if cache is used." '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. diff --git a/wl/ChangeLog b/wl/ChangeLog index 909cc79..4cde40e 100644 --- a/wl/ChangeLog +++ b/wl/ChangeLog @@ -1,3 +1,40 @@ +2001-10-02 Yuuichi Teranishi + + * 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 * wl-draft.el (wl-draft-queue-flush): Call elmo-folder-open-internal diff --git a/wl/wl-e21.el b/wl/wl-e21.el index 242323f..cc48f90 100644 --- a/wl/wl-e21.el +++ b/wl/wl-e21.el @@ -92,6 +92,8 @@ corresponding to the mode line clicked." (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) @@ -191,7 +193,7 @@ corresponding to the mode line clicked." :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) @@ -243,14 +245,14 @@ corresponding to the mode line clicked." (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))) @@ -534,19 +536,23 @@ corresponding to the mode line clicked." (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") diff --git a/wl/wl-highlight.el b/wl/wl-highlight.el index de046e9..3d60312 100644 --- a/wl/wl-highlight.el +++ b/wl/wl-highlight.el @@ -1032,36 +1032,10 @@ This function is defined for `window-scroll-functions'" (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)) diff --git a/wl/wl-message.el b/wl/wl-message.el index 3a4f5f2..1ed057e 100644 --- a/wl/wl-message.el +++ b/wl/wl-message.el @@ -365,6 +365,50 @@ Returns non-nil if bottom of message." "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) @@ -372,7 +416,7 @@ Returns non-nil if bottom of message." 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)) @@ -386,7 +430,6 @@ Returns non-nil if bottom of message." (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) @@ -401,6 +444,10 @@ Returns non-nil if bottom of message." (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)) @@ -467,7 +514,8 @@ Returns non-nil if bottom of message." (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 @@ -475,7 +523,9 @@ Returns non-nil if bottom of message." (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) @@ -498,7 +548,6 @@ Returns non-nil if bottom of message." 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 @@ -585,34 +634,6 @@ Returns non-nil if bottom of message." (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) diff --git a/wl/wl-mule.el b/wl/wl-mule.el index 7b14bd1..045c983 100644 --- a/wl/wl-mule.el +++ b/wl/wl-mule.el @@ -99,17 +99,21 @@ Special commands: (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") diff --git a/wl/wl-vars.el b/wl/wl-vars.el index a80a2aa..ce28358 100644 --- a/wl/wl-vars.el +++ b/wl/wl-vars.el @@ -524,6 +524,10 @@ reasons of system internal to accord facilities for the Emacs variants.") "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 @@ -1204,6 +1208,37 @@ Each elements are regexp of field-name." :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 + '(("]+>" 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 @@ -2082,22 +2117,6 @@ list : reserved specified permanent marks." :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 diff --git a/wl/wl-xmas.el b/wl/wl-xmas.el index 3b5e3bc..4f59155 100644 --- a/wl/wl-xmas.el +++ b/wl/wl-xmas.el @@ -48,6 +48,8 @@ (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) @@ -177,18 +179,18 @@ (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))) @@ -438,17 +440,18 @@ (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")