Subject: Re: bug#12817: 24.2; The button library does not work on the header line

From: Jonas Bernoulli <[email-masked]>
Date: Wed, 05 Dec 2012 21:39:15 +0100

The attached patch allows inserting buttons into the header-line as well
as the mode-line.  I haven't tested it much but it appears to work.

As you suggested it doesn't use a function such as
`header-button-format'.  Instead `make-text-button' was changed to
return a useful value when BEG is a string: the propertized string.

,----
| (setq header-line-format
|       (make-text-button "test" nil
|                         'action (lambda (button)
|                                   (message "Button: %s" button))))
`----

The above is enough now to insert a button in the header-line or
mode-line.  No need for an intermediate variable to hold the string.
Additionally the following changes are needed so that clicking the
button actually does something.

Add an additional kind of "button object" that is used internally and
passed to the button action function: "area buttons" (analogously to
`posn-area').  Normally these have the form (STRING . STRING-POS), where
STRING is the propertized string and STRING-POS is list of the form
returned by `event-start'.  STRING-POS might be useful in actions but
isn't used internally.  Area button objects can also be just a string.

[mode-line mouse-2] and [header-line mouse-2] are bound to push-button
just like [mouse-2].  [follow-link] is not actually used at all.  (I
think it was used instead of [mouse-2] in the past, but I might be
wrong).

I don't know whether binding these events might cause problems for
regular buttons, but it does not appear to be the case.

(Maybe using follow-link instead and extending it to work in the
header-line and mode-line would be better; but I know to little about
that.  The little I do know tells me doing so would probably not be
worth the effort.)

`push-button', `button-get', `button-put', `button-label' are taught to
deal with area buttons.  Using `button-start', `button-end' and
`button-at' with an area button causes an error.  Of the "button
creating functions" only `make-text-button' is useful for area buttons.
`[next|previous|forward|backward]-button' also cannot be used.

The patch is against 24.3.50 from a few days ago but if necessary I can
redo it against a different version.

>From e6f0ba57a65badba9cb37443efff5dbcb24f8fb8 Mon Sep 17 00:00:00 2001
From: Jonas Bernoulli <[email-masked]>
Date: Wed, 5 Dec 2012 21:00:30 +0100
Subject: [PATCH] lisp/button.el: allow inserting buttons into mode-line and
 header-line

* lisp/button.el (make-text-button): if BEG is a string return it;
  previously 0 was returned in that case (bugfix)
* lisp/button.el (button-map): bind [mode-line mouse-2] and
  [header-line mouse-2] to push-button
* lisp/button.el (button-activate): mention area (mode-line and
  header-line) buttons, also add general documentation about action
  invocation
* lisp/button.el (push-button): mention button-activate in doc-string
* lisp/button.el (button-get, button-put, button-label): support
  area buttons
* lisp/button.el: add functions button-area-button-p and
  button-area-button-string
---
 button.el | 87 ++++++++++++++++++++++++++++++++++++++++++++++-----------------
 1 file changed, 64 insertions(+), 23 deletions(-)

diff --git a/button.el b/button.el
index 3cf38fa..7c76587 100644
--- a/button.el
+++ b/button.el
@@ -64,6 +64,8 @@
     ;; might get converted to ^M when building loaddefs.el
     (define-key map [(control ?m)] 'push-button)
     (define-key map [mouse-2] 'push-button)
+    (define-key map [mode-line mouse-2] 'push-button)
+    (define-key map [header-line mouse-2] 'push-button)
     map)
   "Keymap used by buttons.")
 
@@ -184,10 +186,12 @@ changes to a supertype are not reflected in its subtypes)."
 
 (defun button-get (button prop)
   "Get the property of button BUTTON named PROP."
-  (if (overlayp button)
-      (overlay-get button prop)
-    ;; Must be a text-property button.
-    (get-text-property button prop)))
+  (cond ((overlayp button)
+	 (overlay-get button prop))
+	((button-area-button-p button)
+	 (get-text-property 0 prop (button-area-button-string button)))
+	(t ; Must be a text-property button.
+	 (get-text-property button prop))))
 
 (defun button-put (button prop val)
   "Set BUTTON's PROP property to VAL."
@@ -202,21 +206,32 @@ changes to a supertype are not reflected in its subtypes)."
 	 ;; Disallow updating the `category' property directly.
 	 (error "Button `category' property may not be set directly")))
   ;; Add the property.
-  (if (overlayp button)
-      (overlay-put button prop val)
-    ;; Must be a text-property button.
-    (put-text-property
-     (or (previous-single-property-change (1+ button) 'button)
-	 (point-min))
-     (or (next-single-property-change button 'button)
-	 (point-max))
-     prop val)))
+  (cond ((overlayp button)
+	 (overlay-put button prop val))
+	((button-area-button-p button)
+	 (setq button (button-area-button-string button))
+	 (put-text-property 0 (length button) prop val button))
+	(t ; Must be a text-property button.
+	 (put-text-property
+	  (or (previous-single-property-change (1+ button) 'button)
+	      (point-min))
+	  (or (next-single-property-change button 'button)
+	      (point-max))
+	  prop val))))
 
 (defsubst button-activate (button &optional use-mouse-action)
   "Call BUTTON's action property.
 If USE-MOUSE-ACTION is non-nil, invoke the button's mouse-action
 instead of its normal action; if the button has no mouse-action,
-the normal action is used instead."
+the normal action is used instead.
+
+The action can either be a marker or a function.  If it's a
+marker then goto it.  Otherwise it it is a function then it is
+called with BUTTON as only argument.  BUTTON is either an
+overlay, a buffer position, or for buttons in the mode-line or
+header-line a cons (STRING . STRING-POS); where STRING-POS is a
+list of the form returned by the `event-start' and `event-end'
+functions."
   (let ((action (or (and use-mouse-action (button-get button 'mouse-action))
 		    (button-get button 'action))))
     (if (markerp action)
@@ -228,7 +243,10 @@ the normal action is used instead."
 
 (defun button-label (button)
   "Return BUTTON's text label."
-  (buffer-substring-no-properties (button-start button) (button-end button)))
+  (if (button-area-button-p button)
+      (substring-no-properties (button-area-button-string button))
+    (buffer-substring-no-properties (button-start button)
+				    (button-end button))))
 
 (defsubst button-type (button)
   "Return BUTTON's button-type."
@@ -238,6 +256,26 @@ the normal action is used instead."
   "Return t if BUTTON has button-type TYPE, or one of TYPE's subtypes."
   (button-type-subtype-p (button-get button 'type) type))
 
+(defun button-area-button-p (button)
+  "Return t if BUTTON is an area button.
+An area button is a cons (STRING . STRING-POS) or a string.
+STRING-POS is a list of the form returned by the `event-start'
+and `event-end' functions.  Such area buttons are used for
+buttons in the mode-line and header-line."
+  (or (stringp button)
+      (and (stringp (car-safe button))
+	   (posnp (cdr-safe button)))))
+
+(defun button-area-button-string (button)
+  "Return area button BUTTON's button-string.
+That is either BUTTON itself or it's car if
+it is a cons (STRING . STRING-POS)."
+  (cond ((stringp button) button)
+	((button-area-button-p button) (car button))
+	(t
+	 (signal 'wrong-type-argument
+		 (list 'button-area-button-p button)))))
+
 
 ;; Creating overlay buttons
 
@@ -324,7 +362,7 @@ Also see `insert-text-button'."
                          (cons 'button (cons (list t) properties))
                          object)
     ;; Return something that can be used to get at the button.
-    beg))
+    (or object beg)))
 
 (defun insert-text-button (label &rest properties)
   "Insert a button with the label LABEL.
@@ -405,23 +443,26 @@ POS may be either a buffer position or a mouse-event.  If
 USE-MOUSE-ACTION is non-nil, invoke the button's mouse-action
 instead of its normal action; if the button has no mouse-action,
 the normal action is used instead.  The action may be either a
-function to call or a marker to display.
+function to call or a marker to display and is invoked using
+`button-activate' (which see).
+
 POS defaults to point, except when `push-button' is invoked
 interactively as the result of a mouse-event, in which case, the
-mouse event is used.
-If there's no button at POS, do nothing and return nil, otherwise
-return t."
+mouse event is used.  If there's no button at POS, do nothing and
+return nil, otherwise return t."
   (interactive
    (list (if (integerp last-command-event) (point) last-command-event)))
   (if (and (not (integerp pos)) (eventp pos))
       ;; POS is a mouse event; switch to the proper window/buffer
       (let ((posn (event-start pos)))
 	(with-current-buffer (window-buffer (posn-window posn))
-	  (push-button (posn-point posn) t)))
+	  (if (posn-area posn)
+	      ;; mode-line or header-line event
+	      (button-activate (cons (car (posn-string posn)) posn) t)
+	    (push-button (posn-point posn)) t)))
     ;; POS is just normal position
     (let ((button (button-at (or pos (point)))))
-      (if (not button)
-	  nil
+      (when button
 	(button-activate button use-mouse-action)
 	t))))
 
-- 
1.8.0.1