branch: externals/hyperbole
commit 871391f36840ba144407bbfd0d1f00361593c426
Author: Mats Lidell <mats.lid...@lidells.se>
Commit: GitHub <nore...@github.com>
Add test for hargs:sexpression-p (#451)
* Add test for hargs:sexpression-p
* Fix hargs:sexpression-p when eval triggers an error
Add test hargs-tests--sexpression-p
---
hargs.el | 38 ++++++++++++++++++++------------------
test/hargs-tests.el | 22 +++++++++++++++++++++-
2 files changed, 41 insertions(+), 19 deletions(-)
diff --git a/hargs.el b/hargs.el
index f5ec41e0b3..e5367f00b8 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: 20-Jan-24 at 15:37:06 by Mats Lidell
+;; Last-Mod: 20-Jan-24 at 19:43:53 by Mats Lidell
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -508,23 +508,25 @@ If point follows an sexpression end character, the
preceding sexpression
is returned. If point precedes an sexpression start character, the
following sexpression is returned. Otherwise, the innermost sexpression
that point is within is returned or nil if none."
- (save-excursion
- (ignore-errors
- (let ((not-quoted
- '(not (and (eq (char-syntax (char-after (- (point) 2))) ?\\)
- (not (eq (char-syntax (char-after (- (point) 3)))
?\\))))))
- (cond ((and (eq (char-syntax (preceding-char)) ?\))
- ;; Ignore quoted end chars.
- (eval not-quoted))
- (buffer-substring (point)
- (progn (forward-sexp -1) (point))))
- ((and (eq (char-syntax (following-char)) ?\()
- ;; Ignore quoted begin chars.
- (eval not-quoted))
- (buffer-substring (point)
- (progn (forward-sexp) (point))))
- (no-recurse nil)
- (t (save-excursion (up-list 1) (hargs:sexpression-p t))))))))
+ (let ((not-quoted
+ '(condition-case ()
+ (not (and (eq (char-syntax (char-after (- (point) 2))) ?\\)
+ (not (eq (char-syntax (char-after (- (point) 3)))
?\\))))
+ (error t))))
+ (save-excursion
+ (ignore-errors
+ (cond ((and (eq (char-syntax (preceding-char)) ?\))
+ ;; Ignore quoted end chars.
+ (eval not-quoted))
+ (buffer-substring (point)
+ (progn (forward-sexp -1) (point))))
+ ((and (eq (char-syntax (following-char)) ?\()
+ ;; Ignore quoted begin chars.
+ (eval not-quoted))
+ (buffer-substring (point)
+ (progn (forward-sexp) (point))))
+ (no-recurse nil)
+ (t (save-excursion (up-list 1) (hargs:sexpression-p t))))))))
;;; ************************************************************************
;;; Public functions
diff --git a/test/hargs-tests.el b/test/hargs-tests.el
index 8f74d689cb..7fe53d852d 100644
--- a/test/hargs-tests.el
+++ b/test/hargs-tests.el
@@ -3,7 +3,7 @@
;; Author: Mats Lidell <ma...@gnu.org>
;;
;; Orig-Date: 04-Feb-22 at 23:00:00
-;; Last-Mod: 28-May-23 at 23:14:18 by Mats Lidell
+;; Last-Mod: 20-Jan-24 at 19:38:11 by Mats Lidell
;;
;; SPDX-License-Identifier: GPL-3.0-or-later
;;
@@ -47,6 +47,26 @@
(cl-letf (((symbol-function 'hargs:read) (lambda (prompt &optional a b c d)
"xyz")))
(should (string= (hargs:get "+K: ") "xyz"))))
+(ert-deftest hargs-tests--sexpression-p ()
+ "Verify behavior of `hargs:sexpression-p'."
+ (with-temp-buffer
+ (insert " (setq var (+ 1 2)) ")
+ ;; pos ->123456789012345678901
+ (dolist (v '((1 nil nil)
+ (2 "(setq var (+ 1 2))" "(setq var (+ 1 2))")
+ (3 "(setq var (+ 1 2))" nil)
+ (4 "(setq var (+ 1 2))" nil)
+ (11 "(setq var (+ 1 2))" nil)
+ (12 "(+ 1 2)" "(+ 1 2)")
+ (13 "(+ 1 2)" nil)
+ (18 "(+ 1 2)" nil)
+ (19 "(+ 1 2)" "(+ 1 2)")
+ (20 "(setq var (+ 1 2))" "(setq var (+ 1 2))")
+ (21 nil nil)))
+ (goto-char (car v))
+ (should (string= (cadr v) (hargs:sexpression-p)))
+ (should (string= (caddr v) (hargs:sexpression-p t))))))
+
;; This file can't be byte-compiled without `with-simulated-input' which
;; is not part of the actual dependencies, so:
;; Local Variables:
