(require 'cl)
;;;
;;; Playing with stuff for Intel
;;;
(defvar *action-button-attribute* 3 "Attribute for action buttons")
(set-attribute-global 3 "black" "grey")

(defun create-action-button (start end string action)
"Create an action button from START to END, with message STRING and function ACTION. ACTION will be called with a mouse-data argument."
  (add-button start end *action-button-attribute*
    (list 'action-button string action)
  )
)

(defun act-on-button (flag mdata)
"Arguments are FLAG and MOUSE-DATA. Checks for a button at MOUSE-ARG. If it's an action button, then if FLAG is nil, the message is displayed, else FLAG is non-nil, and the action (assumed to be a callable function) is invoked."
  (let
    ( b data )
    ;; Pop over to the clicked buffer and extract the button information
    (save-excursion
      (set-buffer (nth 1 mdata))
      (setq
	b (button-at (car mdata))
	data (and (buttonp b) (button-data b))
      )
    )
    ;; Now we're back, deal with the button
    (if (and data (eq 'action-button (car data))) ;it's one of our buttons
      (if flag				;if set, do the action
	(progn
	  (message "")			;clear the message
	  (funcall (nth 2 data) mdata)	;execute the action
	)
	;; ELSE just plot the message
	(message (nth 1 data))
      )
      ;; ELSE not one of our buttons - clear the message line
      (message "")
    )
  )
)

;;; functions in the mouse maps get called with a MOUSE-DATA of
;;; (POINT BUFFER WINDOW SCREEN) as their sole argument.

(global-set-mouse mouse-left mouse-control
  (function (lambda (mdata) (act-on-button nil mdata)))
)
(global-set-mouse mouse-left mouse-control-up
  (function (lambda (mdata) (act-on-button t mdata)))
)


;;; Example use
(save-excursion
  (goto-char (point-min))
  (if (re-search-forward "act-on-button" nil t)
    (create-action-button (match-beginning 0) (match-end 0)
      "Goto start of file" 
      (function (lambda (ignored) (goto-char (point-min))))
    )
  )
)
;;; this should put a button on the "act-on-button" above. To use it,
;;; hold down control and click the left mouse button. It should plot the
;;; message on the press, and then clear it and go to the start of the
;;; file on the release. The ignored arg is of the form
;;; (POINT BUFFER WINDOW SCREEN) for the mouse click.
