[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] externals/hyperbole 790a9c81ee: Add hui:ibut-modify and fix buffe
From: |
ELPA Syncer |
Subject: |
[elpa] externals/hyperbole 790a9c81ee: Add hui:ibut-modify and fix buffer setting in hui mod functions |
Date: |
Mon, 24 Jan 2022 01:57:37 -0500 (EST) |
branch: externals/hyperbole
commit 790a9c81ee3ecdd738bd72709b3e8a817ff2ee05
Author: Bob Weiner <rsw@gnu.org>
Commit: Bob Weiner <rsw@gnu.org>
Add hui:ibut-modify and fix buffer setting in hui mod functions
---
ChangeLog | 11 +++++-
hact.el | 4 +-
hbut.el | 49 +++++++++++++++---------
hui-mini.el | 3 +-
hui.el | 121 +++++++++++++++++++++++++++++++++++++++++++++++++++---------
5 files changed, 149 insertions(+), 39 deletions(-)
diff --git a/ChangeLog b/ChangeLog
index ba826d9738..73f703a4bf 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,8 +1,17 @@
2022-01-23 Bob Weiner <rsw@gnu.org>
+* hbut.el (gbut:label-p): Add to return global button label point is on if nay.
+ Use in 'hui:gbut-modify'.
+
* Makefile (test-all): Add conditionals to always run GUI Emacs if DISPLAY is
set.
-* hui.el (hui:gbut-create, hui:gibut-create): Move position of 'set-buffer'
call after
+* hui-mini.el (hui:menus): Add named Ibut/Modify.
+* hui.el (hui:ebut-modify, hui:gbut-modify): Interactively if on a button,
still allow
+ choice of another button.
+ (hui:ibut-modify): Add named ibut modification.
+ (hui:ebut-modify, hui:gbut-modify): Add 2nd save-excursion so point
does
+ not move within the source buffer.
+ (hui:gbut-create, hui:gibut-create): Move position of 'set-buffer'
call after
'hui:buf-writable-err' call so they do not interfere with each other,
causing buttons
to be written to the wrong buffer.
diff --git a/hact.el b/hact.el
index 1a417139bf..db8d5e176e 100644
--- a/hact.el
+++ b/hact.el
@@ -51,7 +51,7 @@ The type categories are either 'actypes or 'ibtypes.")
"Inline the return of the symtable for TYPE-CATEGORY, one of 'actypes or
'ibtypes."
(plist-get symtable:category-plist type-category))
-(defun symtable:operate (operation symbol-or-name symtable)
+(defun symtable:operate (operation symbol-or-name symtable)
"Call hash-table function OPERATION with Hyperbole SYMBOL-OR-NAME as key
upon SYMTABLE.
Trigger an error if SYMBOL-OR-NAME cannot be mapped to an existing Elisp
symbol or if SYMTABLE is invalid."
@@ -423,7 +423,7 @@ performing ACTION."
(hhist:add hist-elt))))))
;; Return the full Elisp symbol for ACTYPE, which may be a string or symbol.
-(defalias 'actype:elisp-symbol #'symtable:actype-p)
+(defalias 'actype:elisp-symbol #'symtable:actype-p)
(defun actype:def-symbol (actype)
"Return the abbreviated symbol for ACTYPE used in its `defact'.
diff --git a/hbut.el b/hbut.el
index 1494e8f113..3397fc31aa 100644
--- a/hbut.el
+++ b/hbut.el
@@ -621,6 +621,25 @@ Insert INSTANCE-FLAG after END, before ending delimiter."
Return entry deleted (a list of attribute values) or nil."
(hbut:delete lbl-key nil gbut:file))
+(defun gbut:ebut-program (label actype &rest args)
+ "Programmatically create a global explicit Hyperbole button at point from
LABEL, ACTYPE (action type), and optional actype ARGS.
+Insert LABEL text at the end of the personal/global button file
+surrounded by <( )> delimiters, adding any necessary instance
+number of the button after the LABEL. ACTYPE may be a Hyperbole
+action type name (from defact) or an Emacs Lisp function,
+followed by a list of arguments for the actype, aside from the
+button LABEL which is automatically provided as the first
+argument.
+
+For interactive creation, use `hui:gbut-create' instead."
+ (save-excursion
+ (with-current-buffer (find-file-noselect (expand-file-name hbmap:filename
hbmap:dir-user))
+ (save-excursion
+ (goto-char (point-max))
+ (when (not (bolp))
+ (insert "\n"))
+ (eval `(ebut:program ',label ',actype ,@args))))))
+
(defun gbut:get (&optional lbl-key)
"Return global Hyperbole button symbol given by optional LBL-KEY if found in
gbut:file.
@@ -648,24 +667,20 @@ Return nil if no matching button is found."
"Return list of global button labels."
(mapcar #'hbut:key-to-label (gbut:key-list)))
-(defun gbut:ebut-program (label actype &rest args)
- "Programmatically create a global explicit Hyperbole button at point from
LABEL, ACTYPE (action type), and optional actype ARGS.
-Insert LABEL text at the end of the personal/global button file
-surrounded by <( )> delimiters, adding any necessary instance
-number of the button after the LABEL. ACTYPE may be a Hyperbole
-action type name (from defact) or an Emacs Lisp function,
-followed by a list of arguments for the actype, aside from the
-button LABEL which is automatically provided as the first
-argument.
+(defun gbut:label-p (&optional as-label start-delim end-delim pos-flag
two-lines-flag)
+ "Return key for the Hyperbole global button label that point is within, else
nil.
+This is the normalized key form of the explicit button's label.
-For interactive creation, use `hui:gbut-create' instead."
- (save-excursion
- (with-current-buffer (find-file-noselect (expand-file-name hbmap:filename
hbmap:dir-user))
- (save-excursion
- (goto-char (point-max))
- (when (not (bolp))
- (insert "\n"))
- (eval `(ebut:program ',label ',actype ,@args))))))
+Assume point is within the first line of any button label. All
+following arguments are optional. If AS-LABEL is non-nil, return
+label rather than the key derived from the label. START-DELIM
+and END-DELIM are strings that override default button
+delimiters. With POS-FLAG non-nil, return the list of label-or-key,
+but-start-position, but-end-position. Positions include
+delimiters. With TWO-LINES-FLAG non-nil, constrain label search
+to two lines."
+ (when (equal buffer-file-name gbut:file)
+ (hbut:label-p as-label start-delim end-delim pos-flag two-lines-flag)))
(defun gbut:to (lbl-key)
"Find the global button with LBL-KEY (a label or label key) within the
visible portion of the global button file.
diff --git a/hui-mini.el b/hui-mini.el
index 1295d9bb5d..8db7c62982 100644
--- a/hui-mini.el
+++ b/hui-mini.el
@@ -648,7 +648,7 @@ constructs. If not given, the top level Hyperbole menu is
used."
("Info"
(id-info "(hyperbole)Explicit Buttons")
"Displays manual section on explicit buttons.")
- ("Modify" hui:ebut-modify "Modifies any desired button attributes.")
+ ("Modify" hui:ebut-modify "Modifies explicit button attributes.")
("Rename" hui:ebut-rename "Relabels an explicit button.")
("Search" hui:ebut-search
"Locates and displays personally created buttons in context.")
@@ -693,6 +693,7 @@ constructs. If not given, the top level Hyperbole menu is
used."
"Displays manual section on implicit buttons.")
("Label" hui:ibut-label-create
"Creates an implicit button label preceding an existing implicit
button at point, if any.")
+ ("Modify" hui:ibut-modify "Modifies named implicit button
attributes.")
("Rename" hui:ibut-rename
"Modifies a label preceding an implicit button in the current
buffer.")
("Types" (hui:htype-help 'ibtypes 'no-sort)
diff --git a/hui.el b/hui.el
index 6e80cb1fb0..ca6a527302 100644
--- a/hui.el
+++ b/hui.el
@@ -195,11 +195,15 @@ a new button is created interactively with the region as
the default label."
Signal an error when no such button is found in the current buffer."
(interactive (list (save-excursion
(hui:buf-writable-err (current-buffer) "ebut-modify")
- (or (ebut:label-p)
- (ebut:label-to-key
- (hargs:read-match "Button to modify: "
- (ebut:alist) nil t
- nil 'ebut))))))
+ (ebut:label-to-key
+ (hargs:read-match "Button to modify: "
+ (ebut:alist) nil t
+ (ebut:label-p t) 'ebut)))))
+ (unless (stringp lbl-key)
+ (if (called-interactively-p)
+ (error "(hui:ebut-modify): No explicit button to modify")
+ (error "(hui:ebut-modify): 'lbl-key' argument must be a string, not
'%s'" lbl-key)))
+
(let ((lbl (ebut:key-to-label lbl-key))
(but-buf (current-buffer))
actype but new-lbl)
@@ -227,8 +231,10 @@ Signal an error when no such button is found in the
current buffer."
(hattr:set 'hbut:current 'actype actype)
(hattr:set 'hbut:current 'args (hargs:actype-get actype t))
(hattr:set 'hbut:current 'action
- (and hui:ebut-prompt-for-action (hui:action actype))))
- (ebut:operate lbl new-lbl)
+ (and hui:ebut-prompt-for-action (hui:action actype)))
+ (set-buffer but-buf)
+ (save-excursion
+ (ebut:operate lbl new-lbl)))
(when (called-interactively-p 'interactive)
(hui:ebut-message t))))
@@ -347,8 +353,8 @@ See `hui:gibut-create' for details."
but-buf (find-file-noselect gbut:file))
(hui:buf-writable-err but-buf "gbut-create")
;; This prevents movement of point which might be useful to user.
+ (set-buffer but-buf)
(save-excursion
- (set-buffer but-buf)
(goto-char (point-max))
(unless (bolp)
(insert "\n"))
@@ -392,7 +398,13 @@ modification Signal an error when no such button is
found."
(hbut:label-to-key
(hargs:read-match "Global button to modify: "
(mapcar #'list (gbut:label-list))
- nil t nil 'gbut)))))
+ nil t (gbut:label-p t) 'gbut)))))
+ (unless (stringp lbl-key)
+ (if (called-interactively-p)
+ (error "(hui:gbut-modify): No global button to modify")
+ (error "(hui:gbut-modify): 'lbl-key' argument must be a string, not
'%s'" lbl-key)))
+
+
(let ((lbl (hbut:key-to-label lbl-key))
(interactive-flag (called-interactively-p 'interactive))
(but-buf (find-file-noselect gbut:file))
@@ -427,12 +439,13 @@ modification Signal an error when no such button is
found."
(hattr:set 'hbut:current 'action
(and hui:ebut-prompt-for-action (hui:action actype)))
(set-buffer but-buf)
- (ebut:operate lbl new-lbl)
+ (save-excursion
+ (ebut:operate lbl new-lbl))
(when interactive-flag
(save-buffer)))
;; Implicit buttons
- (save-excursion
- (with-current-buffer but-buf
+ (with-current-buffer but-buf
+ (save-excursion
(ibut:to lbl-key)
(if (and interactive-flag (ibut:at-p))
(progn
@@ -485,8 +498,8 @@ Use `hui:gbut-create' to create a global explicit button."
but-buf (find-file-noselect gbut:file))
(hui:buf-writable-err but-buf "gibut-create")
;; This prevents movement of point which might be useful to user.
+ (set-buffer but-buf)
(save-excursion
- (set-buffer but-buf)
(goto-char (point-max))
(unless (bolp)
(insert "\n"))
@@ -692,6 +705,75 @@ its buttons, the label is simply inserted at point."
(hui:ibut-message nil)))
(t (error "(hui:ibut-label-create): To add a label, point must be
within the text of an implicit button")))))
+(defun hui:ibut-modify (lbl-key)
+ "Modify a named implicit Hyperbole button given by LBL-KEY.
+Signal an error when no such button is found in the current buffer."
+ (interactive (list (save-excursion
+ (hui:buf-writable-err (current-buffer) "ibut-modify")
+ (ibut:label-to-key
+ (hargs:read-match "Button to modify: "
+ (ibut:alist) nil t
+ (ibut:label-p t) 'ibut)))))
+ (unless (stringp lbl-key)
+ (if (called-interactively-p)
+ (error "(hui:ibut-modify): No named implicit button to modify")
+ (error "(hui:ibut-modify): 'lbl-key' argument must be a string, not
'%s'" lbl-key)))
+
+ (let ((lbl (ibut:key-to-label lbl-key))
+ (interactive-flag (called-interactively-p 'interactive))
+ (but-buf (current-buffer))
+ actype args but new-lbl)
+ (hattr:set 'hbut:current 'loc (hui:key-src but-buf))
+ (hattr:set 'hbut:current 'dir (hui:key-dir but-buf))
+ (save-excursion
+ (unless (called-interactively-p 'interactive)
+ (hui:buf-writable-err but-buf "ibut-modify"))
+
+ (unless (setq but (ibut:get lbl-key but-buf))
+ (pop-to-buffer but-buf)
+ (hypb:error "(ibut-modify): Invalid button, no data for '%s'" lbl))
+
+ (setq new-lbl
+ (hargs:read
+ "Change button name to: "
+ (lambda (lbl)
+ (and (not (string-equal lbl "")) (<= (length lbl)
(hbut:max-len))))
+ lbl
+ (format "(ibut-modify): Enter a string of at most %s chars."
+ (hbut:max-len))
+ 'string))
+
+ ;; Implicit buttons
+ (with-current-buffer but-buf
+ (save-excursion
+ (ibut:to lbl-key)
+ (if (and interactive-flag (ibut:at-p))
+ (progn
+ ;; lbl-start and lbl-end mark the text of the ibut, not
+ ;; its name.
+ (when (hattr:get 'hbut:current 'lbl-end)
+ (let* ((start (hattr:get 'hbut:current 'lbl-start))
+ (end (hattr:get 'hbut:current 'lbl-end))
+ (old-text (buffer-substring start end))
+ (new-text (read-string "Modify ibut text: "
old-text)))
+ (save-excursion
+ (goto-char start)
+ (delete-region start end)
+ (insert new-text))
+ (hattr:set 'hbut:current 'lbl-key (ibut:label-to-key
new-lbl))))
+ ;; Have to do name change after lbl-start/lbl-end are
+ ;; used so buffer positions do not change.
+ (ibut:rename lbl new-lbl)
+ (save-buffer)
+ (hui:ibut-message t))
+ (when (and interactive-flag
+ (ibut:rename lbl new-lbl))
+ (save-buffer)
+ (message "Button renamed to %s%s%s"
+ ibut:label-start
+ new-lbl
+ ibut:label-end))))))))
+
(defun hui:ibut-rename (lbl-key)
"Rename a label preceding a Hyperbole implicit button in the current buffer
given by LBL-KEY.
Signal an error when no such button is found in the current buffer."
@@ -850,17 +932,20 @@ See also documentation for `hui:link-possible-types'."
act)))
(defun hui:actype (&optional default-actype prompt)
- "Using optional DEFAULT-ACTYPE, PROMPT for a button action type.
+ "Using optional DEFAULT-ACTYPE, PROMPT for and return a button action type.
DEFAULT-ACTYPE may be a valid symbol or symbol name."
(when (and default-actype (symbolp default-actype))
(setq default-actype (symbol-name default-actype)
default-actype (actype:def-symbol default-actype)
default-actype (when default-actype (symbol-name default-actype))))
(if (or (null default-actype) (stringp default-actype))
- (actype:elisp-symbol
- (hargs:read-match (or prompt "Button's action type: ")
- (mapcar #'list (htype:names 'actypes))
- nil t default-actype 'actype))
+ (let ((actype-name
+ (hargs:read-match (or prompt "Button's action type: ")
+ (nconc
+ (mapcar #'list (htype:names 'actypes))
+ (mapcar #'list (all-completions "" obarray)))
+ nil t default-actype 'actype)))
+ (or (actype:def-symbol actype-name) (intern actype-name)))
(hypb:error "(actype): Invalid default action type received")))
(defun hui:buf-writable-err (but-buf func-name)
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [elpa] externals/hyperbole 790a9c81ee: Add hui:ibut-modify and fix buffer setting in hui mod functions,
ELPA Syncer <=