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-20260414.325/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))
	 hkey-form pred pred-value call calls cmd-sym doc)
      (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* ((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* ((actype (or (actype:elisp-symbol (hattr:get 'hbut:current 'actype))
					 (hattr:get 'hbut:current 'actype)))
			     ;; (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))))

			(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
				   (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)
			(unless (or assisting
				    (eq categ 'explicit)
				    (null categ)
				    (not (fboundp categ))
				    (null (documentation categ)))
			  ;; Include implicit button's ibtype doc
			  (princ (format "\n%s\n"
					 (replace-regexp-in-string "^" "  " (documentation categ)
								   nil t))))
			(if 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))))
			  (when (and (symbolp actype)
				     (fboundp actype)
				     (documentation actype))
			    (princ (format "\n%s ACTION KEY SPECIFICS:\n%s\n"
					   (or (actype:def-symbol actype) actype)
					   (replace-regexp-in-string "^" "  " (documentation actype)
								     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))))

		    (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))