[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[nongnu] elpa/sweeprolog ffa70e7b1c 2/4: Handle module-qualification in
|
From: |
ELPA Syncer |
|
Subject: |
[nongnu] elpa/sweeprolog ffa70e7b1c 2/4: Handle module-qualification in next-clause insertion |
|
Date: |
Tue, 22 Nov 2022 15:59:41 -0500 (EST) |
branch: elpa/sweeprolog
commit ffa70e7b1cbd0a321f64ec12e47060a29c3b96cd
Author: Eshel Yaron <me@eshelyaron.com>
Commit: Eshel Yaron <me@eshelyaron.com>
Handle module-qualification in next-clause insertion
* sweeprolog.el (sweeprolog-definition-at-point): also return module
name when the head term is qualified.
(sweeprolog-maybe-insert-next-clause): pass module name to...
(sweeprolog-insert-clause): new argument module.
* sweeprolog-tests.el: add a couple of relevant test cases.
---
sweep.pl | 6 +++++
sweeprolog-tests.el | 67 +++++++++++++++++++++++++++++++++++++++++++++++++-
sweeprolog.el | 70 +++++++++++++++++++++++++++++++++++------------------
3 files changed, 118 insertions(+), 25 deletions(-)
diff --git a/sweep.pl b/sweep.pl
index 61b69f939f..304b11121c 100644
--- a/sweep.pl
+++ b/sweep.pl
@@ -485,6 +485,12 @@ sweep_color_normalized_(_, comment, [Kind0|_],
["comment"|Kind]) :-
sweep_color_normalized_(_, dcg, [Kind0|_], ["dcg"|Kind]) :-
!,
atom_string(Kind0, Kind).
+sweep_color_normalized_(_, hook, [Kind0|_], ["hook"|Kind]) :-
+ !,
+ atom_string(Kind0, Kind).
+sweep_color_normalized_(_, module, [M0|_], ["module"|M]) :-
+ !,
+ atom_string(M0, M).
sweep_color_normalized_(_, qq_content, [Type0|_], ["qq_content"|Type]) :-
!,
atom_string(Type0, Type).
diff --git a/sweeprolog-tests.el b/sweeprolog-tests.el
index f096bf743b..fc2b0dd377 100644
--- a/sweeprolog-tests.el
+++ b/sweeprolog-tests.el
@@ -329,7 +329,7 @@ foo(Bar).
(goto-char (point-max))
(backward-word)
(should (equal (sweeprolog-definition-at-point)
- '(1 "foo" 1 21 ":-")))))
+ '(1 "foo" 1 21 ":-" nil)))))
(ert-deftest syntax-errors ()
"Test clearing syntax error face after errors are fixed."
@@ -398,6 +398,71 @@ foo.
foo :- Body.
"))))
+(ert-deftest dwim-next-clause-module-qualified-cdg ()
+ "Tests inserting new module-qualified DCG non-terminal."
+ (let ((temp (make-temp-file "sweeprolog-test"
+ nil
+ "pl"
+ "
+spam:foo --> bar.
+"
+ )))
+ (find-file-literally temp)
+ (sweeprolog-mode)
+ (goto-char (point-max))
+ (sweeprolog-insert-term-dwim)
+ (should (string= (buffer-string)
+ "
+spam:foo --> bar.
+spam:foo --> Body.
+
+"
+ ))))
+
+(ert-deftest dwim-next-clause-module-qualified ()
+ "Tests inserting new module-qualified clause."
+ (let ((temp (make-temp-file "sweeprolog-test"
+ nil
+ "pl"
+ "
+spam:foo :- bar.
+"
+ )))
+ (find-file-literally temp)
+ (sweeprolog-mode)
+ (goto-char (point-max))
+ (sweeprolog-insert-term-dwim)
+ (should (string= (buffer-string)
+ "
+spam:foo :- bar.
+spam:foo :- Body.
+
+"
+ ))))
+
+(ert-deftest dwim-next-clause-prolog-message ()
+ "Tests inserting new `prolog:message/1' clause."
+ (let ((temp (make-temp-file "sweeprolog-test"
+ nil
+ "pl"
+ "
+prolog:message(foo(bar, Baz, Spam)) -->
+ [ 'baz: ~D spam: ~w'-[Baz, Spam] ].
+"
+ )))
+ (find-file-literally temp)
+ (sweeprolog-mode)
+ (goto-char (point-max))
+ (sweeprolog-insert-term-dwim)
+ (should (string= (buffer-string)
+ "
+prolog:message(foo(bar, Baz, Spam)) -->
+ [ 'baz: ~D spam: ~w'-[Baz, Spam] ].
+prolog:message(_) --> Body.
+
+"
+ ))))
+
(ert-deftest dwim-next-clause-dcg ()
"Tests inserting a non-terminal with `sweeprolog-insert-term-dwim'."
(with-temp-buffer
diff --git a/sweeprolog.el b/sweeprolog.el
index 5072cd9760..767c45670f 100644
--- a/sweeprolog.el
+++ b/sweeprolog.el
@@ -1923,10 +1923,12 @@ resulting list even when found in the current clause."
(list (list beg end (sweeprolog-predicate-indicator-face))))
("string"
(list (list beg end (sweeprolog-string-face))))
- ("module"
+ (`("module" . ,_)
(list (list beg end (sweeprolog-module-face))))
("neck"
(list (list beg end (sweeprolog-neck-face))))
+ (`("hook" . ,_)
+ (list (list beg end (sweeprolog-hook-face))))
("hook"
(list (list beg end (sweeprolog-hook-face))))
(`("qq_content" . ,type)
@@ -2615,11 +2617,15 @@ instead."
'sweeprolog-hole t
'rear-sticky '(sweeprolog-hole)))
-(defun sweeprolog-insert-clause (functor arity &optional neck)
+(defun sweeprolog-insert-clause (functor arity &optional neck module)
(let ((point nil)
(neck (or neck ":-")))
(combine-after-change-calls
- (insert "\n" functor)
+ (insert "\n"
+ (if module
+ (concat module ":")
+ "")
+ functor)
(setq point (point))
(when (< 0 arity)
(insert "(")
@@ -2633,16 +2639,18 @@ instead."
(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))
- (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 (if (string= neck "-->") 2 0))
- neck)
- t))
+ (sweeprolog-definition-at-point point))))
+ (let ((functor (nth 1 current-predicate))
+ (arity (nth 2 current-predicate))
+ (neck (nth 4 current-predicate))
+ (module (nth 5 current-predicate)))
+ (goto-char end)
+ (end-of-line)
+ (sweeprolog-insert-clause functor
+ (- arity (if (string= neck "-->") 2 0))
+ neck
+ module)
+ t)))
(defun sweeprolog-default-new-predicate-location (&rest _)
(sweeprolog-end-of-predicate-at-point))
@@ -2715,23 +2723,37 @@ 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)
- (neck ":-"))
+ (let ((functor nil)
+ (arity nil)
+ (neck ":-")
+ (module nil)
+ (start nil)
+ (stop nil))
(sweeprolog-analyze-term-at-point (lambda (beg end arg)
(pcase arg
- (`("head_term" ,_ ,f ,a)
- (setq def-at-point
- (list beg f a)))
+ ("range"
+ (setq start beg))
+ (`("head" "meta" ":" 2)
+ (setq module t))
+ ("expanded"
+ (setq module "prolog"))
+ (`("hook" . "message")
+ (when (string= module "prolog")
+ (setq functor
(buffer-substring-no-properties beg end)
+ arity 3)))
+ (`("module" . ,mod)
+ (when (eq module t)
+ (setq module mod)))
+ (`("head" ,_ ,f ,a)
+ (setq functor f
+ arity 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))))))))
- (when def-at-point
- (append def-at-point (list neck))))))
+ (setq stop beg)))))
+ (when functor
+ (list start functor arity stop neck module)))))
(defun sweeprolog-insert-pldoc-for-predicate (functor arguments det summary)
(insert "\n\n")