From: Eshel Yaron <me@eshelyaron.com>
Date: Sun, 20 Nov 2022 19:31:11 +0000 (+0200)
Subject: Support DCG and SSU rules in sweeprolog-insert-next-clause
X-Git-Tag: V8.5.20-sweep-0.8.10~2
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=96f8a765d2783fae32368eee47c22f6d852354b0;p=sweep.git

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.
---

diff --git a/sweeprolog-tests.el b/sweeprolog-tests.el
index 59af86f..4fa1a4f 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 89e2ecc..567ee3b 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")