* 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.

diff --git a/wl/ChangeLog b/wl/ChangeLog
index e54683d..63aad23 100644 (file)
--- a/wl/ChangeLog
+++ b/wl/ChangeLog
@@ -1,5 +1,24 @@
 2000-08-28   Daiki Ueno  <ueno@unixuser.org>
 
+       * 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  <ueno@unixuser.org>
+
        * 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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")