Function: hkey-help
hkey-help is an interactive and byte-compiled function defined in
hmouse-drv.el.
Signature
(hkey-help &optional ASSISTING)
Documentation
Display help for the Action Key command in current context.
With optional ASSISTING prefix arg non-nil, display help for the Assist Key command. Return non-nil iff associated help documentation is found.
Key Bindings
Source Code
;; Defined in ~/.emacs.d/elpa/hyperbole-20260822.1645/hmouse-drv.el
(defun hkey-help (&optional assisting)
"Display help for the Action Key command in current context.
With optional ASSISTING prefix arg non-nil, display help for the
Assist Key command. Return non-nil iff associated help
documentation is found."
(interactive "P")
(hattr:clear 'hbut:current)
(let* ((mouse-flag (when (mouse-event-p last-command-event)
(or action-key-depress-position assist-key-depress-position)))
(mouse-drag-flag (hmouse-drag-p))
(hkey-forms (if mouse-flag hmouse-alist hkey-alist))
(hrule:action #'actype:identity)
(assist-flag assisting)
(pred-point (point-marker))
(saved-but nil)
hkey-form pred pred-value call calls cmd-sym def doc)
;; Next line suppresses warning since var is referenced only as a quoted
;; symbol
(ignore saved-but)
(unwind-protect
(while (and (null pred-value) (setq hkey-form (car hkey-forms)))
(or (setq pred (car hkey-form)
pred-value (hypb:eval-debug pred))
(setq hkey-forms (cdr hkey-forms)))
;; Any Smart Key predicate should leave point unchanged.
;; Trigger an error if not.
(unless (equal (point-marker) pred-point)
(hypb:error "(Hyperbole): `%s' predicate left point at %s and failed to restore it to %s" pred (point) pred-point)))
(set-marker pred-point nil))
(if pred-value
(setq call (if assisting
(cddr hkey-form)
(cadr hkey-form))
cmd-sym (if (eq (car call) #'funcall)
(cadr call)
(car call)))
(setq cmd-sym (if assisting assist-key-default-function action-key-default-function)
call cmd-sym))
(if (and (consp call) (eq (car call) 'call-interactively))
(when (consp (cadr call))
(setq cmd-sym (if (memq (caadr call) '(function quote))
(cadadr call)
(caadr call)))))
(setq calls (if (and (consp call) (memq (car call) '(or ignore-errors)))
(mapcar #'identity (cdr call))
(list cmd-sym)))
(unless (or action-key-depressed-flag action-key-help-flag)
(action-key-clear-variables))
(unless (or assist-key-depressed-flag assist-key-help-flag)
(assist-key-clear-variables))
(setq hkey-help-msg
(if (and cmd-sym (symbolp cmd-sym))
(progn
(let* ((actype (or (actype:elisp-symbol
(hattr:get 'hbut:current 'actype))
(hattr:get 'hbut:current 'actype)))
(actype-doc-flag (and (symbolp actype)
(fboundp actype)
(documentation actype)))
(assist-function-flag (and assisting
actype-doc-flag))
(condition (car hkey-form))
(temp-buffer-show-hook
(lambda (buf)
(set-buffer buf)
(help-mode)
(let ((owind (selected-window)))
(if (br-in-browser)
(save-excursion
(br-to-view-window)
(select-window (previous-window))
(display-buffer buf 'other-win))
(display-buffer buf 'other-win))
(select-window
(if (bound-and-true-p help-window-select)
(get-buffer-window buf)
owind)))))
(temp-buffer-show-function temp-buffer-show-hook))
(with-output-to-temp-buffer
(hypb:help-buf-name
(format "%s %sKey"
(if assisting "Assist" "Action")
(if mouse-flag "Mouse " "")))
;; Print Hyperbole button attributes
(when (memq cmd-sym '(hui:hbut-act hui:hbut-help))
(let* ((lbl-key (hattr:get 'hbut:current 'lbl-key))
(categ (hattr:get 'hbut:current 'categ))
(attributes (nthcdr 2 (hattr:list 'hbut:current)))
(but-def-symbol (htype:def-symbol
(if (eq categ 'explicit) actype categ)))
(wikiword-referent
(when (eq (htype:def-symbol actype) 'link-to-wikiword)
(hywiki-get-referent
(hattr:get 'hbut:current 'lbl-key)))))
(when wikiword-referent
(hattr:set 'hbut:current 'referent-type
(car wikiword-referent))
(hattr:set 'hbut:current 'referent-value
(cdr wikiword-referent)))
(princ (format "%s %s SPECIFICS:\n"
(or but-def-symbol
(htype:def-symbol actype))
(cond ((eq categ 'explicit)
"EXPLICIT BUTTON")
(categ
"IMPLICIT BUTTON")
(t "ACTION TYPE"))))
;; (when (and assisting
;; (not (eq categ (ibtype:elisp-symbol 'action)))
;; (or (plist-member attributes 'actype)
;; (plist-member attributes 'action)))
;; (setq attributes (copy-sequence attributes))
;; (hypb:remove-from-plist attributes 'actype)
;; (hypb:remove-from-plist attributes 'action))
(hattr:report attributes)
(when lbl-key
(unwind-protect
;; Need to save and restore 'hbut:current here
;; since hywiki-get-definition overwrites it
(progn (hattr:copy 'hbut:current 'saved-but)
(setq def (hywiki-get-definition
(ibut:key-to-label lbl-key)))
(when (stringp def)
(terpri)
(princ def)))
(hattr:copy 'saved-but 'hbut:current)))
(unless (or assisting
(eq categ 'explicit)
(null categ)
(not (fboundp categ))
(null (documentation categ)))
;; Include implicit button's ibtype doc
(princ (format "\n%s ACTION KEY SPECIFICS:\n"
(htype:names 'ibtypes categ)))
(princ (format "%s\n"
(replace-regexp-in-string "^" " " (documentation categ)
nil t))))
(when assisting
(let* ((ibtype-name (htype:names 'ibtypes categ))
(custom-help-func (when (stringp ibtype-name)
(intern-soft
(concat ibtype-name ":help"))))
(type-help-func (or (and custom-help-func
(fboundp custom-help-func)
custom-help-func)
'hbut:report)))
(princ (format "\n%s ASSIST KEY SPECIFICS:\n%s\n"
type-help-func
(replace-regexp-in-string
"^" " " (documentation type-help-func)
nil t)))))
;; Display possibly custom actype :help documentation for
;; an Action button
(when (or (not assisting)
(eq (htype:def-symbol categ) 'action))
(let* ((actype-name (or (htype:names 'actypes actype)
(symbol-name actype)))
(custom-help-func (when (stringp actype-name)
(intern-soft
(concat actype-name ":help"))))
(type-help-func (or (and custom-help-func
(fboundp custom-help-func)
custom-help-func)
actype)))
(princ (format "\n%s ACTYPE SPECIFICS:\n%s\n"
(or (htype:names 'actypes type-help-func)
(symbol-name type-help-func))
(replace-regexp-in-string
"^" " " (documentation type-help-func)
nil t)))))
(terpri)))
;; Print Emacs push-button attributes
(when (memq cmd-sym '(smart-push-button smart-push-button-help))
(let* ((button (button-at (point)))
(attributes (when button (hattr:list button))))
(when attributes
(princ (format "%s BUTTON SPECIFICS:\n"
(button-label button)))
(hattr:report attributes)
;; text-property buttons are represented as markers
(unless (markerp button)
(princ (format "\n%s ACTION SPECIFICS:\n%s\n"
(plist-get attributes 'action)
(replace-regexp-in-string "^" " " (actype:doc button t)
nil t))))
(terpri))))
(unless assist-function-flag
(princ (format "A %s of the %s %sKey"
(if mouse-flag
(if mouse-drag-flag "DRAG" "CLICK")
"PRESS")
(if assisting "Assist" "Action")
(if mouse-flag "Mouse " "")))
(terpri)
(princ "WHEN ")
(princ
(or condition
"there is no matching context"))
(terpri)
(mapc (lambda (c)
(when (and (> (length calls) 1)
(not (eq (car calls) c)))
;; Is an 'or' set of calls
(princ "OR "))
(princ "CALLS ") (princ (if (consp c) c (list c)))
(when (and (fboundp (setq call (if (consp c) (car c) c)))
(setq doc (documentation call)))
(princ " WHICH")
(princ (if (string-match "\\`[a-zA-Z]*[a-rt-zA-RT-Z]+s[ [:punct:]]" doc)
":" " WILL:"))
(terpri) (terpri)
(princ (replace-regexp-in-string "^" " " doc nil t))
(terpri) (terpri)))
calls))))
"")
(message "No %s Key command for current context."
(if assisting "Assist" "Action"))))
doc))