[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[nongnu] elpa/sweeprolog 96f8a765d2 1/3: Support DCG and SSU rules in sw
From: |
ELPA Syncer |
Subject: |
[nongnu] elpa/sweeprolog 96f8a765d2 1/3: Support DCG and SSU rules in sweeprolog-insert-next-clause |
Date: |
Sun, 20 Nov 2022 16:59:23 -0500 (EST) |
branch: elpa/sweeprolog
commit 96f8a765d2783fae32368eee47c22f6d852354b0
Author: Eshel Yaron <me@eshelyaron.com>
Commit: Eshel Yaron <me@eshelyaron.com>
Support DCG and SSU rules in sweeprolog-insert-next-clause
* sweeprolog.el (sweeprolog-definition-at-point): also return kind of
neck.
(sweeprolog-maybe-insert-next-clause): pass it to...
(sweeprolog-insert-next-clause): new argument NECK used instead of
hardcoded ":-", use "Body" for clause body instead of "_".
(sweeprolog-identifier-at-point): handle raw meta goals.
* sweeprolog-tests.el: add tests for sweeprolog-insert-term-dwim
inserting clauses with different neck kinds.
---
sweeprolog-tests.el | 43 +++++++++++++++++++++++++++++++++++++++++--
sweeprolog.el | 32 +++++++++++++++++++++-----------
2 files changed, 62 insertions(+), 13 deletions(-)
diff --git a/sweeprolog-tests.el b/sweeprolog-tests.el
index 59af86f546..4fa1a4f87e 100644
--- a/sweeprolog-tests.el
+++ b/sweeprolog-tests.el
@@ -326,7 +326,7 @@ foo(Bar).
(goto-char (point-max))
(backward-word)
(should (equal (sweeprolog-definition-at-point)
- '(1 "foo" 1 21)))))
+ '(1 "foo" 1 21 ":-")))))
(ert-deftest syntax-errors ()
"Test clearing syntax error face after errors are fixed."
@@ -382,6 +382,45 @@ bar(Bar) :- baz(Bar).
(should fsap)
(should (string= "lists" (file-name-base fsap))))))
+(ert-deftest dwim-next-clause-fact ()
+ "Tests inserting a new clause after a fact."
+ (with-temp-buffer
+ (sweeprolog-mode)
+ (insert "
+foo.")
+ (sweeprolog-insert-term-dwim)
+ (should (string= (buffer-string)
+ "
+foo.
+foo :- Body.
+"))))
+
+(ert-deftest dwim-next-clause-dcg ()
+ "Tests inserting a non-terminal with `sweeprolog-insert-term-dwim'."
+ (with-temp-buffer
+ (sweeprolog-mode)
+ (insert "
+foo --> bar.")
+ (sweeprolog-insert-term-dwim)
+ (should (string= (buffer-string)
+ "
+foo --> bar.
+foo --> Body.
+"))))
+
+(ert-deftest dwim-next-clause-ssu ()
+ "Tests inserting an SSU rule with `sweeprolog-insert-term-dwim'."
+ (with-temp-buffer
+ (sweeprolog-mode)
+ (insert "
+foo => bar.")
+ (sweeprolog-insert-term-dwim)
+ (should (string= (buffer-string)
+ "
+foo => bar.
+foo => Body.
+"))))
+
(ert-deftest dwim-next-clause ()
"Tests inserting a new clause with `sweeprolog-insert-term-dwim'."
(with-temp-buffer
@@ -392,7 +431,7 @@ foo :- bar.")
(should (string= (buffer-string)
"
foo :- bar.
-foo :- _.
+foo :- Body.
"))))
(ert-deftest dwim-define-predicate ()
diff --git a/sweeprolog.el b/sweeprolog.el
index 89e2eccfed..567ee3babb 100644
--- a/sweeprolog.el
+++ b/sweeprolog.el
@@ -872,7 +872,8 @@ module name, F is a functor name and N is its arity."
`("head" ,_ ,f ,a)
`("goal" ,_ ,f ,a))
(setq id-at-point (list f a)))))))
- (when id-at-point
+ (when (and id-at-point
+ (not (eq (car id-at-point) 'variable)))
(sweeprolog--query-once "sweep" "sweep_functor_arity_pi"
id-at-point))))))
@@ -2583,8 +2584,9 @@ instead."
'sweeprolog-hole t
'rear-sticky '(sweeprolog-hole)))
-(defun sweeprolog-insert-clause (functor arity)
- (let ((point nil))
+(defun sweeprolog-insert-clause (functor arity &optional neck)
+ (let ((point nil)
+ (neck (or neck ":-")))
(combine-after-change-calls
(insert "\n" functor)
(setq point (point))
@@ -2593,19 +2595,22 @@ instead."
(dotimes (_ (1- arity))
(insert (sweeprolog--hole) ", "))
(insert (sweeprolog--hole) ")"))
- (insert " :- " (sweeprolog--hole) ".\n"))
+ (insert " " neck " " (sweeprolog--hole "Body") ".\n"))
(goto-char point)
(sweeprolog-forward-hole)))
(defun sweeprolog-maybe-insert-next-clause (point kind beg end)
(when-let ((current-predicate (and (eq kind 'operator)
(string= "."
(buffer-substring-no-properties beg end))
- (cdr (sweeprolog-definition-at-point
point))))
- (functor (car current-predicate))
- (arity (cadr current-predicate)))
+ (sweeprolog-definition-at-point point)))
+ (functor (nth 1 current-predicate))
+ (arity (nth 2 current-predicate))
+ (neck (nth 4 current-predicate)))
(goto-char end)
(end-of-line)
- (sweeprolog-insert-clause functor arity)
+ (sweeprolog-insert-clause functor
+ (- arity (if (string= neck "-->") 2 0))
+ neck)
t))
(defun sweeprolog-default-new-predicate-location (_pred)
@@ -2657,18 +2662,23 @@ of them signal success by returning non-nil."
(defun sweeprolog-definition-at-point (&optional point)
(save-excursion
(when point (goto-char point))
- (let ((def-at-point nil))
- (sweeprolog-analyze-term-at-point (lambda (beg _end arg)
+ (let ((def-at-point nil)
+ (neck ":-"))
+ (sweeprolog-analyze-term-at-point (lambda (beg end arg)
(pcase arg
(`("head_term" ,_ ,f ,a)
(setq def-at-point
(list beg f a)))
+ ("neck"
+ (setq neck
+
(buffer-substring-no-properties beg end)))
("fullstop"
(when def-at-point
(setq def-at-point
(append def-at-point
(list beg))))))))
- def-at-point)))
+ (when def-at-point
+ (append def-at-point (list neck))))))
(defun sweeprolog-insert-pldoc-for-predicate (functor arguments det summary)
(insert "\n\n")