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

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[elpa] externals/hyperbole 8e4a92341e 3/6: Fix hypb-ert.el compilation e


From: ELPA Syncer
Subject: [elpa] externals/hyperbole 8e4a92341e 3/6: Fix hypb-ert.el compilation error; improve ibut:operate
Date: Mon, 17 Jul 2023 09:58:38 -0400 (EDT)

branch: externals/hyperbole
commit 8e4a92341e50c6191e108dae29ba118b08843cf8
Author: Bob Weiner <rsw@gnu.org>
Commit: Bob Weiner <rsw@gnu.org>

    Fix hypb-ert.el compilation error; improve ibut:operate
---
 .gitignore    |   1 +
 ChangeLog     |  16 ++++++++
 hargs.el      |   6 +--
 hbut.el       | 119 +++++++++++++++++++++++++++++++++-------------------------
 hib-social.el |  23 ++++++++----
 hmouse-drv.el |  15 ++++----
 hui.el        |  10 +++--
 hypb-ert.el   |   4 +-
 8 files changed, 118 insertions(+), 76 deletions(-)

diff --git a/.gitignore b/.gitignore
index 4fa7d9afce..eeb068dfbb 100644
--- a/.gitignore
+++ b/.gitignore
@@ -32,3 +32,4 @@ TODO*
 
 # Video Demos
 videos
+*.el
diff --git a/ChangeLog b/ChangeLog
index 82557466c6..f9206b135a 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,21 @@
+2023-07-17  Bob Weiner  <rsw@gnu.org>
+
+* hypb-ert.el (require): Wrap 'eval-and-compile' call around this to force 
require
+    of "hbut" which defines 'defal' and prevents compilation error when 
"hibtypes"
+    tries to load this.
+
 2023-07-09  Bob Weiner  <rsw@gnu.org>
 
+* hbut.el (ibut:delimit): Add name separator after delimiting name if not 
already
+    there but ensure point stays at end of the delimited name.
+          (ibut:operate): Update doc string with caller responsibilities.
+         (ibut:program): Fix to send 'edit-flag' to 'ibut:operate' call when 
point
+    is on an existing ibutton.  Remove 'cannot nest error' since 
'ibut:operate' will
+    now modify the existing ibutton.
+          (ibut:insert-text): Don't insert name separator if looking at one in 
the buffer.
+         (ibut:operate): Fix to not trigger an error when adding a name to an 
ibut
+    that does not have one.
+
 * hypb-ert.el (hypb-ert-*): Change all calls of 'ert' to disable ert's messages
     so that any test's message is displayed after an hypb-ert test case run.
               (hypb-ert): Change 'ert' calls to use 'hypb-ert' and centralize
diff --git a/hargs.el b/hargs.el
index ca1ab5a866..bf6b812415 100644
--- a/hargs.el
+++ b/hargs.el
@@ -3,7 +3,7 @@
 ;; Author:       Bob Weiner
 ;;
 ;; Orig-Date:    31-Oct-91 at 23:17:35
-;; Last-Mod:      5-Jul-23 at 00:45:15 by Bob Weiner
+;; Last-Mod:     16-Jul-23 at 23:29:46 by Bob Weiner
 ;;
 ;; SPDX-License-Identifier: GPL-3.0-or-later
 ;;
@@ -366,8 +366,8 @@ Handles all of the interactive argument types that 
`hargs:iform-read' does."
         ;; Event occurred within the minibufer-contents and return
         ;; just the contents before point so that those after are
         ;; deleted and more completions are shown.
-        (setq mini (minibuffer-contents-no-properties))
-        (list (substring mini 0 (max (- (point) (point-max)) (- (length 
mini)))) nil))
+        (let ((mini (minibuffer-contents-no-properties)))
+          (list (substring mini 0 (max (- (point) (point-max)) (- (length 
mini)))) nil)))
        ((and (eq hargs:reading-type 'kcell)
              (eq major-mode 'kotl-mode)
              (not (looking-at "^$")))
diff --git a/hbut.el b/hbut.el
index ec56853ba0..2f26608232 100644
--- a/hbut.el
+++ b/hbut.el
@@ -3,7 +3,7 @@
 ;; Author:       Bob Weiner
 ;;
 ;; Orig-Date:    18-Sep-91 at 02:57:09
-;; Last-Mod:      9-Jul-23 at 02:09:54 by Bob Weiner
+;; Last-Mod:     15-Jul-23 at 23:22:28 by Bob Weiner
 ;;
 ;; SPDX-License-Identifier: GPL-3.0-or-later
 ;;
@@ -1950,9 +1950,12 @@ Insert INSTANCE-FLAG after END, before ending delimiter."
     ;; Insert any comment delimiter before the start marker.
     (set-marker-insertion-type start t)
     (hbut:comment start end)
-    (when (fboundp 'hproperty:but-add)
-      (hproperty:but-add start end hproperty:ibut-face))
-    (goto-char end)
+    (let ((delim-end (point)))
+      (unless (looking-at ibut:label-separator-regexp)
+       (insert ibut:label-separator))
+      (when (fboundp 'hproperty:but-add)
+       (hproperty:but-add start end hproperty:ibut-face))
+      (goto-char delim-end))
     (move-marker start nil)
     (move-marker end nil)
     t))
@@ -2018,8 +2021,8 @@ arguments).  If delimiters are given as arguments, return 
the key form
 of the implicit button text at point between those delimiters.
 
 Use `ibut:at-p' instead to test if point is on either the
-implicit button text itself or the label. Assume point is within the
-first line of any button label.
+implicit button text itself or the name. Assume point is within the
+first line of any button.
 
 All following arguments are optional.  If AS-LABEL is non-nil, label is
 returned rather than the key derived from the label.  START-DELIM and
@@ -2172,6 +2175,12 @@ move to the first occurrence of the button."
 
 (defun    ibut:operate (&optional new-name edit-flag)
   "Insert/modify an ibutton based on `hbut:current' in current buffer.
+
+Caller must either call `hbut:at-p' or manually set the attributes of
+`hbut:current' prior to invoking this function.  If point is on an existing
+Hyperbole button, `edit-flag' must be set to t; otherwise, this may create
+a new ibutton inserted within the prior one, making the prior one unusable.
+
 Optional non-nil NEW-NAME is new name to give button.  With optional
 EDIT-FLAG non-nil, modify an existing in-buffer ibutton rather
 than creating a new one.
@@ -2187,19 +2196,19 @@ Summary of operations based on inputs (name arg comes 
from \\='hbut:current attr
 
|----+------+----------+--------+------+-----------------------------------------------|
 |  # | name | new-name | region | edit | operation                             
        |
 
|----+------+----------+--------+------+-----------------------------------------------|
-|  1 | nil  | nil      | nil    | nil  | create: unnamed ibut from 
hbut:current attrs  |
-|  2 | nil  | new-name | nil    | nil  | ERROR: create can't rename without 
edit flag  |
-|  3 | name | nil      | nil    | nil  | create: ibut with name                
        |
-|  4 | name | new-name | nil    | nil  | ERROR: create can't have name and 
new-name    |
-|  5 | name | new-name | region | nil  | ERROR: create can't have name and 
new-name    |
+|* 1 | nil  | nil      | nil    | nil  | create: unnamed ibut from 
hbut:current attrs  |
+|  2 | nil  | new-name | nil    | nil  | ERROR: edit-flag must be t to set 
new-name    |
+|* 3 | name | nil      | nil    | nil  | create: ibut with name                
        |
+|* 4 | name | new-name | nil    | nil  | ERROR: create can't have name and 
new-name    |
+|* 5 | name | new-name | region | nil  | ERROR: create can't have name and 
new-name    |
 |  6 | name | nil      | region | nil  | create: ibut with name (ignore 
region)        |
-|  7 | nil  | nil      | region | nil  | create: region named ibut             
        |
-|  8 | nil  | new-name | region | nil  | create: ibut with new-name (ignore 
region)    |
+|* 7 | nil  | nil      | region | nil  | create: region named ibut             
        |
+|  8 | nil  | new-name | region | nil  | ERROR: edit-flag must be t to set 
new-name    |
 
|----+------+----------+--------+------+-----------------------------------------------|
-|  9 | nil  | nil      | nil    | t    | mod: remove any name from ibut        
        |
-| 10 | nil  | new-name | nil    | t    | mod: set ibut's name to new-name      
        |
-| 11 | name | nil      | nil    | t    | mod: name of ibut from hbut:current 
attrs     |
-| 12 | name | new-name | nil    | t    | mod: rename ibut with name to 
new-name        |
+|* 9 | nil  | nil      | nil    | t    | mod: remove any name from ibut        
        |
+|*10 | nil  | new-name | nil    | t    | mod: add new-name as ibut's name 
attribute    |
+|*11 | name | nil      | nil    | t    | mod: name of ibut from hbut:current 
attrs     |
+|*12 | name | new-name | nil    | t    | mod: rename ibut with name to 
new-name        |
 | 13 | name | new-name | region | t    | ERROR: Can't use region to mod 
existing ibut  |
 | 14 | name | nil      | region | t    | ERROR: Can't use region to mod 
existing ibut  |
 | 15 | nil  | nil      | region | t    | ERROR: Can't use region to mod 
existing ibut  |
@@ -2211,13 +2220,14 @@ Summary of operations based on inputs (name arg comes 
from \\='hbut:current attr
         (region-flag (hmouse-use-region-p))
         (instance-flag))
     (unless actype
-      (hypb:error "(ibut:operate): hbut:current ibut actype (%s) must be 
non-nil"
-                 actype))
+      (hypb:error "(ibut:operate): hbut:current actype must be non-nil"))
     (when (and new-name (or (not (stringp new-name)) (string-empty-p 
new-name)))
       (hypb:error "(ibut:operate): 'new-name' value must be a non-empty 
string, not: '%s'"
                  new-name))
     (when (and name new-name (not edit-flag))
       (hypb:error "(ibut:operate): 'edit-flag' must be t to rename a button 
(hbut:current name and new-name both given)"))
+    (when (and new-name (not edit-flag))
+      (hypb:error "(ibut:operate): 'edit-flag' must be t to rename a button"))
     (when (and region-flag edit-flag)
       (hypb:error "(ibut:operate): 'edit-flag' must be nil when region is 
highlighted to use region as new button name"))
 
@@ -2257,8 +2267,7 @@ Summary of operations based on inputs (name arg comes 
from \\='hbut:current attr
                                 (progn (insert new-name) (point))
                                 instance-flag))
                              name-regexp 'include-delims))
-                           (at-but)
-                           ((hypb:error "(ibut:operate): No button matching: 
%s" name)))))
+                           (at-but))))
                   (new-name
                    ;; Add new-name to nameless button at point
                    (goto-char (or (hattr:get 'hbut:current 'lbl-start) 
(point)))
@@ -2352,8 +2361,7 @@ Summary of operations based on inputs (name arg comes 
from \\='hbut:current attr
                  (ibut:at-p)) ;; Sets lbl-key for non-delimited ibtypes
          (setq lbl-key (hattr:get 'hbut:current 'lbl-key))))
       (unless (and (stringp lbl-key) (not (string-empty-p lbl-key)))
-       (hypb:error "(ibut:operate): hbut:current ibut lbl-key '%s' must be 
non-nil"
-                   lbl-key)))
+       (hypb:error "(ibut:operate): hbut:current lbl-key must be non-nil")))
 
     (run-hooks (if edit-flag 'ibut-edit-hook 'ibut-create-hook))
 
@@ -2362,8 +2370,10 @@ Summary of operations based on inputs (name arg comes 
from \\='hbut:current attr
 
 (defun    ibut:insert-text (ibut)
   "Space, delimit and insert the activatable text of IBUT."
-  (when (not (string-empty-p (or (hattr:get ibut 'name) "")))
-    (insert ibut:label-separator))
+  (cond ((looking-at ibut:label-separator-regexp)
+        (goto-char (match-end 0)))
+       ((not (or (string-empty-p (or (hattr:get ibut 'name) ""))))
+        (insert ibut:label-separator)))
   (let* ((orig-actype (or (hattr:get ibut 'actype)
                          (hattr:get ibut 'categ)))
         (actype (or (actype:elisp-symbol orig-actype)
@@ -2464,33 +2474,38 @@ function, followed by a list of arguments for the 
actype, aside from
 the button NAME which is automatically provided as the first argument.
 
 For interactive creation, use `hui:ibut-create' instead."
-  ;; Throw an error if on a named or delimited Hyperbole button since
-  ;; cannot create another button within such contexts.
-  (when (hbut:at-p)
-    (let ((name (hattr:get 'hbut:current 'name))
-         (lbl (hbut:key-to-label (hattr:get 'hbut:current 'lbl-key)))
-         (lbl-start (hattr:get 'hbut:current 'lbl-start))
-         (lbl-end (hattr:get 'hbut:current 'lbl-end)))
-      (when (or name lbl (and lbl-start lbl-end))
-       (error "(ibut:program): Cannot nest an ibut within the existing button: 
%s"
-              (or name lbl (buffer-substring-no-properties lbl-start 
lbl-end))))))
-  (save-excursion
-    (let ((but-buf (current-buffer))
-         (actype-sym (actype:action actype)))
-      (hui:buf-writable-err but-buf "ibut:program")
-      (hattr:clear 'hbut:current)
-      (hattr:set 'hbut:current 'name name)
-      (hattr:set 'hbut:current 'categ 'implicit)
-      (hattr:set 'hbut:current 'loc (hui:key-src but-buf))
-      (hattr:set 'hbut:current 'dir (hui:key-dir but-buf))
-      (if (or (and actype-sym (fboundp actype-sym))
-             (functionp actype))
-         (hattr:set 'hbut:current 'actype actype)
-       (error "actype arg must be a bound symbol (not a string): %S" actype))
-      (hattr:set 'hbut:current 'args args)
-      (condition-case err
-         (ibut:operate)
-       (error "(ibut:program): name: %S actype: %S args: %S - %S" name actype 
args err)))))
+  (hui:buf-writable-err (current-buffer) "ibut:program")
+  (when (ebut:at-p)
+    (error "(ibut:program): Move off explicit button at point to create an 
implicit button"))
+  (let ((ibut (ibut:at-p)))
+    ;; Throw an error if on a named or delimited Hyperbole button since
+    ;; cannot create another button within such contexts.
+    (when ibut
+      (let ((name (hattr:get ibut 'name))
+           (lbl (hbut:key-to-label (hattr:get ibut 'lbl-key)))
+           (lbl-start (hattr:get ibut 'lbl-start))
+           (lbl-end (hattr:get ibut 'lbl-end)))
+       (when (or name lbl (and lbl-start lbl-end))
+         (error "(ibut:program): Cannot nest an ibut within the existing 
button: '%s'"
+                (or name lbl (buffer-substring-no-properties lbl-start 
lbl-end))))))
+
+    (save-excursion
+      (let ((but-buf (current-buffer))
+           (actype-sym (actype:action actype)))
+       (hui:buf-writable-err but-buf "ibut:program")
+       (hattr:clear 'hbut:current)
+       (hattr:set 'hbut:current 'name name)
+       (hattr:set 'hbut:current 'categ 'implicit)
+       (hattr:set 'hbut:current 'loc (hui:key-src but-buf))
+       (hattr:set 'hbut:current 'dir (hui:key-dir but-buf))
+       (if (or (and actype-sym (fboundp actype-sym))
+               (functionp actype))
+           (hattr:set 'hbut:current 'actype actype)
+         (error "actype arg must be a bound symbol (not a string): %S" actype))
+       (hattr:set 'hbut:current 'args args)
+       (condition-case err
+           (ibut:operate)
+         (error "(ibut:program): name: %S actype: %S args: %S - %S" name 
actype args err))))))
 
 (defun    ibut:rename (old-lbl new-lbl)
   "Change an implicit button name in the current buffer from OLD-LBL to 
NEW-LBL.
diff --git a/hib-social.el b/hib-social.el
index 55d38d3531..b2fd25dd7a 100644
--- a/hib-social.el
+++ b/hib-social.el
@@ -3,7 +3,7 @@
 ;; Author:       Bob Weiner
 ;;
 ;; Orig-Date:    20-Jul-16 at 22:41:34
-;; Last-Mod:      2-Jul-23 at 04:19:57 by Bob Weiner
+;; Last-Mod:     16-Jul-23 at 23:24:13 by Bob Weiner
 ;;
 ;; SPDX-License-Identifier: GPL-3.0-or-later
 ;;
@@ -193,31 +193,38 @@
 
 (defcustom hibtypes-social-display-function #'browse-url
   "Function of one arg, url, to display when activating a social media 
reference."
-  :type 'function)
+  :type 'function
+  :group 'hyperbole-buttons)
 
 (defcustom hibtypes-git-default-project nil
   "Default project name to associate with any local git commit link."
-  :type 'string)
+  :type 'string
+  :group 'hyperbole-buttons)
 
 (defcustom hibtypes-git-use-magit-flag nil
   "Non-nil means use `magit' rather than `dired' for a git directory button."
-  :type 'boolean)
+  :type 'boolean
+  :group 'hyperbole-buttons)
 
 (defcustom hibtypes-github-default-project nil
   "Default project name to associate with any Github commit link."
-  :type 'string)
+  :type 'string
+  :group 'hyperbole-buttons)
 
 (defcustom hibtypes-github-default-user nil
   "Default user name to associate with any Github commit link."
-  :type 'string)
+  :type 'string
+  :group 'hyperbole-buttons)
 
 (defcustom hibtypes-gitlab-default-project nil
   "Default project name to associate with any Github commit link."
-  :type 'string)
+  :type 'string
+  :group 'hyperbole-buttons)
 
 (defcustom hibtypes-gitlab-default-user nil
   "Default user name to associate with any Github commit link."
-  :type 'string)
+  :type 'string
+  :group 'hyperbole-buttons)
 
 ;;; ************************************************************************
 ;;; Public declarations
diff --git a/hmouse-drv.el b/hmouse-drv.el
index 5d5cef6258..d76ea35700 100644
--- a/hmouse-drv.el
+++ b/hmouse-drv.el
@@ -3,7 +3,7 @@
 ;; Author:       Bob Weiner
 ;;
 ;; Orig-Date:    04-Feb-90
-;; Last-Mod:      4-Jul-23 at 15:36:51 by Bob Weiner
+;; Last-Mod:     16-Jul-23 at 23:41:02 by Bob Weiner
 ;;
 ;; SPDX-License-Identifier: GPL-3.0-or-later
 ;;
@@ -789,12 +789,13 @@ buffer to the end window.  The selected window does not 
change."
                   (if (fboundp #'aw-select) ;; ace-window selection
                       (let ((aw-scope 'global))
                         (aw-select "Select link referent window"))
-                    (message "Now click on the %s end window..." func)
-                    (prog1 (cl-loop do (setq end-event (read-event))
-                                    until (and (mouse-event-p end-event)
-                                               (not (string-match "\\`down-" 
(symbol-name (car end-event)))))
-                                    finally return (posn-window (event-start 
end-event)))
-                      (message "Done")))))))
+                    (message "Now click on the end window...")
+                    (let (end-event)
+                      (prog1 (cl-loop do (setq end-event (read-event))
+                                      until (and (mouse-event-p end-event)
+                                                 (not (string-match "\\`down-" 
(symbol-name (car end-event)))))
+                                      finally return (posn-window (event-start 
end-event)))
+                        (message "Done"))))))))
     (when (eq link-but-window referent-window)
       (error "(hmouse-choose-link-and-referent-windows): No other visible 
window with a link referent"))
     (unless (window-live-p link-but-window)
diff --git a/hui.el b/hui.el
index 9f33680846..c222bd4d61 100644
--- a/hui.el
+++ b/hui.el
@@ -3,7 +3,7 @@
 ;; Author:       Bob Weiner
 ;;
 ;; Orig-Date:    19-Sep-91 at 21:42:03
-;; Last-Mod:      8-Jul-23 at 16:04:59 by Bob Weiner
+;; Last-Mod:      9-Jul-23 at 23:00:16 by Bob Weiner
 ;;
 ;; SPDX-License-Identifier: GPL-3.0-or-later
 ;;
@@ -927,15 +927,17 @@ and adding any necessary instance number to the button 
label.
 For programmatic creation, use `ibut:program' instead."
   (interactive (list (when (use-region-p) (region-beginning))
                     (when (use-region-p) (region-end))))
+  (hui:buf-writable-err (current-buffer) "ibut-create")
+  (when (ebut:at-p)
+    (error "(ibut:program): Move off explicit button at point to create an 
implicit button"))
   (hypb:assert-same-start-and-end-buffer
     (let (default-name name but-buf actype)
       (setq but-buf (current-buffer))
-      (hui:buf-writable-err but-buf "ibut-create")
       (hattr:clear 'hbut:current)
 
       ;; Throw an error if on a named or delimited Hyperbole button since
       ;; cannot create another button within such contexts.
-      (when (hbut:at-p)
+      (when (ibut:at-p)
        (let ((name (hattr:get 'hbut:current 'name))
              (lbl (hbut:key-to-label (hattr:get 'hbut:current 'lbl-key)))
              (lbl-start (hattr:get 'hbut:current 'lbl-start))
@@ -1706,7 +1708,7 @@ arguments."
     (ebut:operate label (when edit-flag label))))
 
 (defun hui:ibut-link-create (edit-flag but-window name-key but-loc but-dir 
type-and-args)
-  "Create or edit a new Hyperbole implicit link button.
+  "Edit or create a new Hyperbole implicit link button.
 With EDIT-FLAG non-nil, edit an existing ibutton at point in
 BUT-WINDOW; otherwise, create a new one.
 
diff --git a/hypb-ert.el b/hypb-ert.el
index 77acf37229..50d860df9e 100644
--- a/hypb-ert.el
+++ b/hypb-ert.el
@@ -3,7 +3,7 @@
 ;; Author:       Mats Lidell <matsl@gnu.org> and Bob Weiner <rsw@gnu.org>
 ;;
 ;; Orig-Date:    31-Mar-21 at 21:11:00
-;; Last-Mod:      9-Jul-23 at 11:59:05 by Bob Weiner
+;; Last-Mod:     16-Jul-23 at 23:47:09 by Bob Weiner
 ;;
 ;; SPDX-License-Identifier: GPL-3.0-or-later
 ;;
@@ -29,7 +29,7 @@
 
 ;;; Code:
 
-(mapc #'require '(lisp-mode hload-path ert hact hbut hargs))
+(eval-and-compile (mapc #'require '(lisp-mode hload-path ert hact hbut hargs)))
 
 (defun hypb-ert-message-function (_msg-pat &rest _args)
   "Ignore messages ert outputs so can display messages from tests run."



reply via email to

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