(eval-when-compile (mapc #'require '(hsettings hmouse-drv hmouse-sh)))

(defvar hyperbole-mode-map) ; "hyperbole.el"

(declare-function hkey-initialize "hyperbole")

(declare-function hmouse-get-bindings "hmouse-sh")

(declare-function hmouse-unshifted-setup "hmouse-sh")

(declare-function hmouse-shifted-setup "hmouse-sh")

(declare-function hkey-set-key "hyperbole")

(defvar hmouse-bindings nil

"List of (key . binding) pairs for Hyperbole mouse keys.")

(defvar hmouse-bindings-flag nil

"Non-nil means Hyperbole mouse bindings are in use, else nil.")

(defvar hmouse-previous-bindings nil

"List of prior (key . binding) pairs for mouse keys rebound by Hyperbole.")

(defun hmouse-check-action-key ()

"After Action Mouse Key use, ensure both depress and release events are bound.

(and (or (and (eventp action-key-depress-args) (eventp action-key-release-args))

(not (or action-key-depress-args action-key-release-args)))

(where-is-internal 'action-key-depress-emacs hyperbole-mode-map t)

(where-is-internal 'action-mouse-key-emacs hyperbole-mode-map t)))

(defun hmouse-check-assist-key ()

"After Assist Mouse Key use, ensure both depress and release events are bound.

(and (or (and (eventp assist-key-depress-args) (eventp assist-key-release-args))

(not (or assist-key-depress-args assist-key-release-args)))

(where-is-internal 'assist-key-depress-emacs hyperbole-mode-map t)

(where-is-internal 'assist-mouse-key-emacs hyperbole-mode-map t)))

(defun hmouse-set-bindings (key-binding-list)

"Set mouse keys used as Smart Keys to bindings in KEY-BINDING-LIST.

(cond

;; Do nothing when running in batch mode.

(noninteractive)

;;

;; GNU Emacs or InfoDock

(t

(mapcar

(lambda (key-and-binding)

(hkey-set-key (car key-and-binding) (cdr key-and-binding)))

key-binding-list))))

(defun hmouse-install (&optional arg)

"Initialize Hyperbole mouse buttons.

(interactive "P")

(unless hmouse-middle-flag

(setq hmouse-middle-flag (or arg (and (boundp 'infodock-version)

infodock-version))))

;; Replace any original mouse bindings before installing Hyperbole bindings and

;; then force reinitialization of hmouse-previous-bindings.

(if (and hmouse-bindings-flag hmouse-previous-bindings)

(hmouse-set-bindings hmouse-previous-bindings))

(setq hmouse-bindings-flag nil

hmouse-previous-bindings nil)

;; This function does the actual binding of the Hyperbole mouse keys

;; and the setup of the mouse-set-point command via `hmouse-set-point-command'.

(hmouse-shifted-setup hmouse-middle-flag)

(if (called-interactively-p 'interactive)

;; Assume emacs has support for 3 mouse keys.

(message "%s the Action Mouse Key; {Shift-Mouse-3} invokes the Assist Mouse Key."

(if hmouse-middle-flag "{Mouse-2} and {Shift-Mouse-2} invoke"

"{Shift-Mouse-2} invokes"))))

(defun hmouse-add-unshifted-smart-keys ()

"Bind \\`mouse-2' to the Action Key and \\`mouse-3' to the Assist Key."

(interactive)

(require 'hyperbole)

(hmouse-unshifted-setup))

(defun hmouse-toggle-bindings ()

"Toggle between Smart Mouse Key settings and their prior bindings.

(interactive)

(let ((key-binding-list (if hmouse-bindings-flag

hmouse-previous-bindings

hmouse-bindings))

(other-bindings-var (if hmouse-bindings-flag

'hmouse-bindings

'hmouse-previous-bindings)))

(if key-binding-list

(progn

(set other-bindings-var (hmouse-get-bindings nil))

(hmouse-set-bindings key-binding-list)

(setq hmouse-bindings-flag (not hmouse-bindings-flag))

(if (called-interactively-p 'interactive)

(message "%s mouse bindings are now in use."

(if hmouse-bindings-flag "Hyperbole" "Non-Hyperbole"))))

(error "(hmouse-toggle-bindings): `%s' is empty"

(if hmouse-bindings-flag 'hmouse-previous-bindings 'hmouse-bindings)))))

(defun hmouse-update-smart-keys ()

"Reload the contexts and actions associated with the Smart Keys.

(interactive)

(let ((load-prefer-newer t)

(ftrs '(hui-mouse hui-window hibtypes hactypes)))

(load "hui-mini")

(hkey-initialize)

(makunbound 'hkey-alist)

(makunbound 'hmouse-alist)

(mapc (lambda (feature)

(setq features (delq feature features)))

ftrs)

(mapc #'require ftrs)

(message "Hyperbole Smart Keys and menus have been updated")))

(provide 'hmouse-key)