>From e6f0ba57a65badba9cb37443efff5dbcb24f8fb8 Mon Sep 17 00:00:00 2001 From: Jonas Bernoulli 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