Function: ibtypes::action

ibtypes::action is a byte-compiled function defined in hibtypes.el.

Signature

(ibtypes::action)

Documentation

The Action Button type.

At point, activate any of: an Elisp variable, a Hyperbole action-type, an Elisp function call or an Ert test name surrounded by <> rather than (). Evaluate the expression and display the result in the minibuffer.

There may not be any <> characters within the expression. The first identifier in the expression must be an Elisp variable, action type, function symbol to call or test to execute, i.e.
'<'actype-or-elisp-symbol arg1 ... argN '>'. For example,
<mail nil "user@somewhere.org">.

Source Code

;; Defined in ~/.emacs.d/elpa/hyperbole-20260414.325/hibtypes.el
(defib action ()
  "The Action Button type.
At point, activate any of: an Elisp variable, a Hyperbole
action-type, an Elisp function call or an Ert test name
surrounded by <> rather than ().  Evaluate the expression
and display the result in the minibuffer.

There may not be any <> characters within the expression.  The
first identifier in the expression must be an Elisp variable,
action type, function symbol to call or test to execute, i.e.
'<'actype-or-elisp-symbol arg1 ... argN '>'.  For example,
<mail nil \"user@somewhere.org\">."
  (let ((lbl-key (hattr:get 'hbut:current 'lbl-key))
	(start-pos (hattr:get 'hbut:current 'lbl-start))
	(end-pos  (hattr:get 'hbut:current 'lbl-end)))
    (when (and lbl-key
               (eq (char-after start-pos) ?\<)
               (eq (char-before end-pos) ?\>))
      (let ((hbut:max-len 0)
	    (name (hattr:get 'hbut:current 'name))
	    (testing-flag (when (bound-and-true-p ert--running-tests) t))
            actname actype actype-sym action args is-var lbl sep var-flag)

        ;; Continue only if there if there is one of:
        ;;  1. `ert--running-tests' is non-nil
        ;;  2. character after start-delim is not a whitespace character
        (when (and (or testing-flag
		       (not (memq (if (char-after (1+ start-pos))
				      (char-syntax (char-after (1+ start-pos)))
				    0)
				  '(?\  ?\>)))))
          (setq lbl (ibut:key-to-label lbl-key))
          ;; Handle $ preceding var name in cases where same name is
          ;; bound as a function symbol
          (when (string-match "\\`\\$" lbl)
            (setq var-flag t
                  lbl (substring lbl 1)))
          (setq actname (if (setq sep (cl-position ?\  lbl)) (substring lbl 0 sep) lbl)
                actype-sym (or (actype:elisp-symbol actname) (intern-soft actname))
                ;; Must ignore that (boundp nil) would be t here.
                actype (and actype-sym
			    (or (fboundp actype-sym)
                                (setq is-var (boundp actype-sym))
                                (special-form-p actype-sym)
                                (ert-test-boundp actype-sym))
			    actype-sym))
          (when (and actype (or (null is-var)
                                ;; is a variable so can't have arguments
                                (equal actname lbl)))
	    ;; For <hynote> buttons, need to double quote each argument so
	    ;; 'read' does not change the idstamp 02 to 2.
	    (when (and (memq actype '(hy hynote))
		       (string-match-p " " lbl))
	      (setq lbl (replace-regexp-in-string "\"\\(.*\\)\\'" "\\1\""
                                                  (combine-and-quote-strings
                                                   (split-string lbl) "\" \""))))
            (setq action (ignore-errors (read (concat "(" lbl ")")))
                  args (cdr action))
	    ;; Ensure action uses an fboundp symbol if executing a
	    ;; Hyperbole actype.
	    (when (and (car action) (symbolp (car action)))
	      (setcar action (or (symtable:hyperbole-actype-p (car action))
                                 (car action))))
	    (unless assist-flag
              (cond ((and (symbolp actype) (fboundp actype)
                          (string-match "-p\\'" (symbol-name actype)))
		     ;; Is a function with a boolean result
		     (setq actype #'display-boolean
                           args `(',action)))
		    ((and (null args) (symbolp actype) (boundp actype)
                          (or var-flag (not (fboundp actype))))
		     ;; Is a variable, display its value as the action
		     (setq args `(,actype)
                           actype #'display-variable))
		    ((and (null args) (symbolp actype) (ert-test-boundp actype))
		     ;; Is an ert-deftest, display the value from executing it
		     (setq actype #'display-value
                           args `((hypb-ert-run-test ,lbl))))
		    (t
		     ;; All other expressions, display the action result in the minibuffer
		     (if (string-match "\\b\\(delete\\|kill\\)-region\\'"
				       (symbol-name actype-sym))
                         ;; With `delete-region' and `kill-region'
                         ;; actions, if no args, either use any active
                         ;; region or when none, use the region of the
                         ;; action button itself, removing it from the
                         ;; buffer.  The latter action is largely used
                         ;; only in internal HyWiki tests.
                         (progn (setq actype #'display-value)
                                (if (= 1 (length action)) ;; No args
				    (if (use-region-p)
                                        ;; Apply function to the active region
                                        (setq args `((,actype-sym (region-beginning) (region-end))))
				      ;; Apply function to region of the action button itself,
				      ;; including delimiters
				      (setq args `((,actype-sym ,start-pos
                                                                ,end-pos))))
                                  (setq args `(',action))))
		       (if testing-flag
                           ;; Delete action button after activation when
                           ;; running an ert test or in a string (so can
                           ;; test this behavior interactively),
                           (setq actype #'display-value-and-remove-region
                                 args `(,action ,start-pos ,end-pos))
                         (setq actype #'display-value
			       args `(,action)))))))

	    ;; Create implicit button object and store in symbol hbut:current.
	    (ibut:label-set lbl)
	    (ibut:create :name name :lbl-key lbl-key :lbl-start start-pos
                         :lbl-end end-pos :categ 'ibtypes::action :actype actype
                         :args args)

            ;; Necessary so can return a null value, which actype:act cannot.
            (let ((hrule:action
                   (if (eq hrule:action #'actype:identity)
                       #'actype:identity
                     #'actype:eval)))
              (if (eq hrule:action #'actype:identity)
                  `(hact ',actype ,@args)
                `(hact ',actype ,@(mapcar #'eval args))))))))))