emacs-elpa-diffs
[Top][All Lists]
Advanced

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



reply via email to

[Prev in Thread] Current Thread [Next in Thread]