From ffa70e7b1cbd0a321f64ec12e47060a29c3b96cd Mon Sep 17 00:00:00 2001 From: Eshel Yaron Date: Tue, 22 Nov 2022 20:14:46 +0200 Subject: [PATCH] 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 61b69f9..304b111 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 f096bf7..fc2b0dd 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 5072cd9..767c456 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") -- 2.39.2