Function: ebut:operate
ebut:operate is a byte-compiled function defined in hbut.el.
Signature
(ebut:operate CURR-LABEL NEW-LABEL)
Documentation
Create an in-buffer ebutton named CURR-LABEL. Modify if NEW-LABEL is given.
If CURR-LABEL is nil, the text in the active region is used as the button label, if any, otherwise, an error is signaled.
Return instance string appended to label to form a per-buffer unique label; nil if label is already unique. Signal an error when no such button is found in the current buffer.
Source Code
;; Defined in ~/.emacs.d/elpa/hyperbole-20260414.325/hbut.el
(defun ebut:operate (curr-label new-label)
"Create an in-buffer ebutton named CURR-LABEL. Modify if NEW-LABEL is given.
If CURR-LABEL is nil, the text in the active region is used as the
button label, if any, otherwise, an error is signaled.
Return instance string appended to label to form a per-buffer unique
label; nil if label is already unique. Signal an error when no such
button is found in the current buffer."
(let* ((lbl-key (ebut:label-to-key curr-label))
(lbl-regexp (ebut:label-regexp lbl-key))
(new-lbl-key (ebut:label-to-key new-label))
(modify new-label)
(new-instance-flag))
(when (and new-label (or (not (stringp new-label)) (string-empty-p new-label)))
(hypb:error "(ebut:operate): 'new-label' value must be a non-empty string, not: '%s'"
new-label))
(when (and (null curr-label) (not (use-region-p)))
(hypb:error "(ebut:operate): region must be active when 'curr-label' is nil"))
;; Error when on a read-only part of a buffer's text
(when (plist-member (text-properties-at (point)) 'read-only)
(hypb:error "(ebut:operate): Point must not be on a read-only Org element"))
;; Error when on an implicit button
(when (or (eq (hattr:get 'hbut:current 'categ) 'implicit)
(string-prefix-p "ibtypes::" (symbol-name (hattr:get 'hbut:current 'categ))))
(hypb:error "(ebut:operate): Point must not be on an implicit button: %s"
(ibut:label-to-key (hattr:get 'hbut:current 'lbl-key))))
;; Error when on an Emacs push-button
(when (plist-member (text-properties-at (point)) 'button)
(hypb:error "(ebut:operate): Point must not be on an Emacs push-button: %s"
(button-label (button-at (point)))))
;; Error when in read-only contexts of an Org file
(when (hsys-org-at-read-only-p)
(hypb:error "(ebut:operate): Point must not be in a read-only Org context"))
(unless new-label
(setq new-label curr-label))
(hattr:set 'hbut:current 'lbl-key (ebut:label-to-key new-label))
(save-excursion
(when (setq new-instance-flag
(if modify (ebut:edit lbl-key nil new-lbl-key) (ebut:create)))
(when (hmail:editor-p)
(hmail:msg-narrow))))
(cond (modify
;; Rename all occurrences of button - those with same label
(let* ((but-key-and-pos (ebut:label-p nil nil nil 'pos))
(at-but (equal (car but-key-and-pos)
(ebut:label-to-key new-label))))
(when at-but
(ebut:delimit (nth 1 but-key-and-pos)
(nth 2 but-key-and-pos)
new-instance-flag))
(cond ((ebut:map
(lambda (_lbl start end)
(delete-region start end)
(ebut:delimit
(point)
(progn (insert new-label) (point))
new-instance-flag))
lbl-regexp 'include-delims))
(at-but)
((hypb:error "(ebut:operate): No button matching: %s" curr-label)))))
(new-instance-flag
;; Add a new button recording its start and end positions
(let (start end mark prev-point buf-lbl)
(cond ((not curr-label)
(setq start (point))
(insert new-label)
(setq end (point)))
((and (hmouse-use-region-p)
(if (hyperb:stack-frame
'(hui:ebut-create hui:ebut-edit hui:ebut-edit-region
hui:ebut-link-create hui:gbut-create
hui:gbut-edit ebut:program
hui:ibut-create hui:ibut-edit
hui:ibut-link-create ibut:program))
;; Ignore action-key-depress-prev-point
(progn (setq mark (marker-position (mark-marker))
start (region-beginning)
end (region-end)
buf-lbl (buffer-substring-no-properties start end))
(equal buf-lbl curr-label))
;; Utilize any action-key-depress-prev-point
(setq mark (marker-position (mark-marker)))
(setq prev-point (and action-key-depress-prev-point
(marker-position action-key-depress-prev-point)))
(setq start (if (and prev-point mark (<= prev-point mark))
prev-point
(region-beginning))
end (if (and prev-point mark (> prev-point mark))
prev-point
(region-end))
buf-lbl (buffer-substring-no-properties start end))
(equal buf-lbl curr-label)))
nil)
((progn (when start (goto-char start))
(looking-at (regexp-quote curr-label)))
(setq start (point)
end (match-end 0)))
(t (setq start (point))
(insert curr-label)
(setq end (point))))
(ebut:delimit start end new-instance-flag)
(goto-char start)))
(t (hypb:error
"(ebut:operate): Operation failed. Check button attribute permissions: %s"
hattr:filename)))
;; Append any new-instance-flag string to the button label
(when (stringp new-instance-flag)
(setq new-label (concat new-label new-instance-flag))
(hattr:set 'hbut:current 'lbl-key (ebut:label-to-key new-label)))
;; Position point
(let ((new-key (ebut:label-to-key new-label)))
(cond ((equal (ebut:label-p) new-key)
;; In case right before the start of the desired
;; button's delimiters.
(forward-char 2) (search-backward ebut:label-start nil t)
(goto-char (match-end 0)))
((let ((regexp (ebut:label-regexp new-key)))
(or (re-search-forward regexp nil t)
(re-search-backward regexp nil t)))
(goto-char (+ (match-beginning 0) (length ebut:label-start))))))
(when (or (not (hypb:buffer-file-name)) (hmail:editor-p) (hmail:reader-p))
(widen)
(hmail:msg-narrow))
;; new-instance-flag might be 't which we don't want to return.
(when (stringp new-instance-flag) new-instance-flag)))