Function: ibut:create

ibut:create is an interactive and byte-compiled function defined in hbut.el.

Signature

(ibut:create &optional &key BUT-SYM NAME LBL-KEY LBL-START LBL-END LOC DIR CATEG ACTYPE ARGS ACTION)

Documentation

Create an in-memory representation of an implicit button.

If successful, return button instance num string or t for first instance; otherwise, return nil. See hbdata:ibut-instance for details.

If BUT-SYM is given, take button's arguments from its property list. Otherwise, button arguments can be given individually or if CATEG and following arguments are not given, create the button object from the implicit button at point, if any; in which case, return nil if no implicit button is found at point.

If a new button is created, store its attributes in the symbol,
'hbut:current.

Key Bindings

Source Code

;; Defined in ~/.emacs.d/elpa/hyperbole-20260414.325/hbut.el
(cl-defun ibut:create (&optional &key but-sym name lbl-key lbl-start lbl-end
				 loc dir categ actype args action)
  "Create an in-memory representation of an implicit button.

If successful, return button instance num string or t for first
instance; otherwise, return nil.  See `hbdata:ibut-instance' for
details.

If BUT-SYM is given, take button's arguments from its property
list.  Otherwise, button arguments can be given individually or
if CATEG and following arguments are not given, create the button
object from the implicit button at point, if any; in which case,
return nil if no implicit button is found at point.

If a new button is created, store its attributes in the symbol,
\\='hbut:current."
  (interactive)
  ;; :args is ignored unless :categ or :action is also given.

  ;; `lbl-key' attribute will be set from `but-sym' if any, the button
  ;; `name' if any; and, otherwise, from its text.

  ;; `lbl-start' and `lbl-end' will be set from `but-sym' if any; and,
  ;; otherwise, the start and end of the ibut text, excluding
  ;; delimiters, not of its name.

  (let* ((but-sym-flag (not (null but-sym)))
	 (types (htype:category 'ibtypes))
	 ;; Global var used in (hact) function, don't delete.
	 (hrule:action #'actype:identity)
	 (opoint (point-marker))
	 (itype)
	 (is-type categ)
	 (name-and-lbl-key-flag)
	 (text-start)
	 (text-end)
	 (ibtype-point))
    (unwind-protect
	(progn
	  (unless but-sym
	    ;; Set attributes of button at point, if any
	    (setq name-and-lbl-key-flag (ibut:set-name-and-label-key-p))

	    (when but-sym-flag
	      (setq name-and-lbl-key-flag nil))
	    ;; Since the Smart Keys handle end-of-line and end-of-buffer
	    ;; separately from whether point is within an implicit button,
	    ;; always report not within one when point is at the end of a line
	    ;; except when there is a `flymake-mode' issue annotation there.
	    ;; -- RSW  02-16-2020, 07-17-2022 and 12-31-2023
	    (unless (or is-type (smart-eolp) (eobp))
	      (unwind-protect
		  (progn (when (or but-sym-flag name-and-lbl-key-flag)
			   (setq text-start (or (hattr:get 'hbut:current 'lbl-start)
						(point))
				 text-end (hattr:get 'hbut:current 'lbl-end))
			   (unless (and text-start
					(<= text-start (point))
					text-end
					(>= text-end (point)))
			     ;; Move to text of ibut before trying to activate it
			     ;; (may be on name)
			     (goto-char (+ (or text-start (point)) 2))))
			 (setq ibtype-point (point-marker))
			 (while (and (not is-type) types)
			   (setq itype (car types))
			   (when (condition-case err
				     (and itype (setq args (funcall itype)))
				   (error (progn (message "%S: %S" itype err)
						 ;; Show full stack trace
						 (debug))))
			     (setq is-type itype))
			   ;; Any implicit button type check should leave point
			   ;; unchanged.  Trigger an error if not.
			   (unless (equal ibtype-point (point-marker))
			     (hypb:error "(Hyperbole): ibtype %s improperly moved point from %s to %s"
					 itype ibtype-point (point-marker)))
			   (setq types (cdr types))))
		(set-marker ibtype-point nil)
		(goto-char opoint)))
	    (set-marker opoint nil))

	  (when (or is-type but-sym)
	    (unless but-sym
	      (setq but-sym 'hbut:current))
	    (let ((current-categ      (hattr:get but-sym 'categ))
		  (current-name       (hattr:get but-sym 'name))
		  (current-name-start (hattr:get but-sym 'name-start))
		  (current-name-end   (hattr:get but-sym 'name-end))
		  (current-lbl-key    (hattr:get but-sym 'lbl-key))
		  (current-lbl-start  (hattr:get but-sym 'lbl-start))
		  (current-lbl-end    (hattr:get but-sym 'lbl-end))
		  (current-loc        (hattr:get but-sym 'loc))
		  (current-dir        (hattr:get but-sym 'dir))
		  (current-action     (hattr:get but-sym 'action))
		  (current-actype     (hattr:get but-sym 'actype))
		  (current-args       (hattr:get but-sym 'args))
		  name-start
		  name-end)

	      (when (and current-name (or but-sym-flag (null name)))
		(setq name current-name))
	      (when name
		(hattr:set 'hbut:current 'name name))

	      (when (and current-name-start (or but-sym-flag (null name-start)))
		(setq name-start current-name-start))
	      (when name-start
		(hattr:set 'hbut:current 'name-start name-start))

	      (when (and current-name-end (or but-sym-flag (null name-end)))
		(setq name-end current-name-end))
	      (when name-end
		(hattr:set 'hbut:current 'name-end name-end))

	      (when (and current-lbl-key (or but-sym-flag (null lbl-key)))
		(setq lbl-key current-lbl-key))
	      (when lbl-key
		(hattr:set 'hbut:current 'lbl-key lbl-key))

	      (when (and current-lbl-start (or but-sym-flag (null lbl-start)))
		(setq lbl-start current-lbl-start))
	      (when lbl-start
		(hattr:set 'hbut:current 'lbl-start lbl-start))

	      (when (and current-lbl-end (or but-sym-flag (null lbl-end)))
		(setq lbl-end current-lbl-end))
	      (when lbl-end
		(hattr:set 'hbut:current 'lbl-end lbl-end))

	      (when (and current-loc (or but-sym-flag (null loc)))
		(setq loc (or (save-excursion
				(hbut:to-key-src 'full))
			      current-loc)))
	      (when loc
		(hattr:set 'hbut:current 'loc loc))

	      (when (and current-dir (or but-sym-flag (null dir)))
		(setq dir (or (hui:key-dir (current-buffer))
			      current-dir)))
	      (when dir
		(hattr:set 'hbut:current 'dir dir))

	      (when (and current-action (or but-sym-flag (null action)))
		(setq action current-action))
	      (when action
		(hattr:set 'hbut:current 'action action))

	      (cond ((and current-categ but-sym-flag)
		     (setq categ current-categ))
		    ((null categ)
		     (setq categ (or is-type current-categ 'implicit))))
	      (when categ
		(hattr:set 'hbut:current 'categ categ))

	      (if (not categ)
		  (setq args nil)
		(unless action
		  (cond ((and but-sym-flag current-args)
			 (setq args current-args))
			(args)
			(current-args
			 (setq args current-args))))
		(setq args (copy-sequence args))
		(when (eq (car args) #'hact)
		  (setq args (cdr args))))

	      (when (and current-actype (or but-sym-flag (null actype)))
		(setq actype current-actype))
	      (unless actype
		(setq actype (or
			      ;; Hyperbole action type
			      (symtable:actype-p (car args))
			      ;; Regular Emacs Lisp function symbol
			      (car args))))
	      (hattr:set 'hbut:current 'actype actype)

	      (when args
		(hattr:set 'hbut:current 'args (if actype (cdr args) args)))

	      (when (and lbl-key (eq actype #'hywiki-find-referent))
		;; If a HyWikiWord ibut, save its referent as an attribute
		(let ((referent (hywiki-get-referent lbl-key)))
		  (hattr:set 'hbut:current 'referent-type (car referent))
		  (hattr:set 'hbut:current 'referent-value (cdr referent))))
	      (when lbl-key
		(when (called-interactively-p 'any)
		  (let (help-window-select)
		    (hbut:report)))))

	    (hbdata:ibut-instance-next (ibut:label-to-key name))))
      (set-marker opoint nil))))