From 4588f36fab47506c73c66dcccd48f55ebd1e0acf Mon Sep 17 00:00:00 2001 From: ueno Date: Mon, 28 Aug 2000 07:18:10 +0000 Subject: [PATCH] * wl-xmas.el (wl-message-overload-functions): Initialize `wl-message-button-map'. * wl-mule.el (wl-message-overload-functions): Initialize `wl-message-button-map'. * wl-vars.el (wl-highlight-message-header-button-alist): New. * wl-message.el (wl-message-button-map): New keymap. (wl-message-add-button): New function. (wl-message-button-dispatcher): New function. (wl-message-button-refer-article): New function. * wl-highlight.el (wl-highlight-message-add-buttons-to-header): New function. (wl-highlight-headers): Use it. --- wl/ChangeLog | 19 +++++++++++++++++++ wl/wl-highlight.el | 24 ++++++++++++++++++++++++ wl/wl-message.el | 28 ++++++++++++++++++++++++++++ wl/wl-mule.el | 5 ++++- wl/wl-vars.el | 16 ++++++++++++++++ wl/wl-xmas.el | 5 ++++- 6 files changed, 95 insertions(+), 2 deletions(-) diff --git a/wl/ChangeLog b/wl/ChangeLog index e54683d..63aad23 100644 --- a/wl/ChangeLog +++ b/wl/ChangeLog @@ -1,5 +1,24 @@ 2000-08-28 Daiki Ueno + * wl-xmas.el (wl-message-overload-functions): Initialize + `wl-message-button-map'. + + * wl-mule.el (wl-message-overload-functions): Initialize + `wl-message-button-map'. + + * wl-vars.el (wl-highlight-message-header-button-alist): New. + + * wl-message.el (wl-message-button-map): New keymap. + (wl-message-add-button): New function. + (wl-message-button-dispatcher): New function. + (wl-message-button-refer-article): New function. + + * wl-highlight.el + (wl-highlight-message-add-buttons-to-header): New function. + (wl-highlight-headers): Use it. + +2000-08-28 Daiki Ueno + * wl-summary.el (wl-summary-default-from): Use `wl-address-get-petname-1'. (wl-summary-simple-from): Ditto. diff --git a/wl/wl-highlight.el b/wl/wl-highlight.el index 3bb83a5..216ac44 100644 --- a/wl/wl-highlight.el +++ b/wl/wl-highlight.el @@ -1014,10 +1014,34 @@ interpreted as cited text.)" (end (or (save-excursion (re-search-forward "^$" nil t)) (point-max)))) (wl-highlight-message beg end nil) + (wl-highlight-message-add-buttons-to-header beg end) (and wl-highlight-x-face-func (funcall wl-highlight-x-face-func beg end)) (run-hooks 'wl-highlight-headers-hook))) +(defun wl-highlight-message-add-buttons-to-header (start end) + (save-restriction + (narrow-to-region start end) + (let ((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 e74bf6e..1096310 100644 --- a/wl/wl-message.el +++ b/wl/wl-message.el @@ -555,6 +555,34 @@ ret-val ))) +(defvar wl-message-button-map (make-sparse-keymap)) + +(defun wl-message-add-button (from to function &optional data) + "Create a button between FROM and TO with callback FUNCTION and DATA." + (add-text-properties + from to + (nconc '(mouse-face highlight) + (list 'local-map wl-message-button-map) + (list 'wl-message-button-callback function) + (if data + (list 'wl-message-button-data data))))) + +(defun wl-message-button-dispatcher (event) + "Select the button under point." + (interactive "@e") + (mouse-set-point event) + (let ((callback (get-text-property (point) 'wl-message-button-callback)) + (data (get-text-property (point) 'wl-message-button-data))) + (if callback + (funcall callback data)))) + +(defun wl-message-button-refer-article (data) + "Read article specified by Message-ID DATA at point." + (switch-to-buffer-other-window + wl-message-buffer-cur-summary-buffer) + (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." diff --git a/wl/wl-mule.el b/wl/wl-mule.el index 48cff6f..dc47d2a 100644 --- a/wl/wl-mule.el +++ b/wl/wl-mule.el @@ -118,7 +118,10 @@ Special commands: (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)) + (local-set-key [S-mouse-5] 'wl-message-wheel-up) + (set-keymap-parent wl-message-button-map (current-local-map)) + (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 332678b..d3159e3 100644 --- a/wl/wl-vars.el +++ b/wl/wl-vars.el @@ -1815,6 +1815,22 @@ list : reserved specified permanent marks." :type '(repeat (cons regexp face)) :group 'wl-highlight) +(defcustom wl-highlight-message-header-button-alist + `(("^\\(References\\|Message-I[Dd]\\):" "<[^>]+>" + 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 51c70a3..49bcd0c 100644 --- a/wl/wl-xmas.el +++ b/wl/wl-xmas.el @@ -382,7 +382,10 @@ (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)) + (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)) (defun wl-message-wheel-up (event) (interactive "e") -- 1.7.10.4