[nongnu] elpa/sweeprolog 8a532f3183 6/6: ADDED: sweeprolog-forward/backward/mark-predicate

[ELPA Syncer]

branch: elpa/sweeprolog
commit 8a532f318320f5a62a6295edc35a21cd45aa69a1
Author: Eshel Yaron <me@eshelyaron.com>
Commit: Eshel Yaron <me@eshelyaron.com>

    ADDED: sweeprolog-forward/backward/mark-predicate
---
 NEWS.org            |  10 ++++++
 README.org          |  30 +++++++++++-----
 sweep.pl            |  27 +++++++++++++-
 sweeprolog-tests.el |  32 ++++++++++++++++-
 sweeprolog.el       | 100 ++++++++++++++++++++++++++++++++++++++++++++++------
 5 files changed, 178 insertions(+), 21 deletions(-)

diff --git a/NEWS.org b/NEWS.org
index 1d197a25a7..a8cc507933 100644
--- a/NEWS.org
+++ b/NEWS.org
@@ -11,6 +11,16 @@ SWI-Prolog in Emacs.
 For further details, please consult the manual:
 <https://eshelyaron.com/sweep.html>.
 
+* Version 0.8.3 on 2022-11-07
+
+** New commands that operate on entire predicate definitions
+
+~sweeprolog-mode~ now includes dedicated function for acting on
+predicate definitions that span multiple clauses.  The new commands
+are ~sweeprolog-forward-predicate~ and ~sweeprolog-backward-predicate~
+bound to ~M-n~ and ~M-p~ respectively, and ~sweeprolog-mark-predicate~ bound
+to ~M-h~.
+
 * Version 0.8.2 on 2022-11-07
 
 ** Renamed ~sweeprolog-colourise-*~ to ~sweeprolog-analyze-*~
diff --git a/README.org b/README.org
index 7868bf1cf1..7baf76aa8b 100644
--- a/README.org
+++ b/README.org
@@ -680,6 +680,28 @@ buffer.  To jump to a definition in the current buffer, 
type =M-x imenu=
 (bound by default to =M-g i= in Emacs version 29).  For information
 about customizing =imenu=, see [[info:emacs#Imenu][Imenu in the Emacs manual]].
 
+** Predicate definition boundaries
+:PROPERTIES:
+:CUSTOM_ID: predicate-boundaries
+:DESCRIPTION: Commands operating on a Prolog predicate definition as a single 
unit
+:END:
+
+#+CINDEX: predicate-based motion
+#+FINDEX: sweeprolog-forward-predicate
+#+FINDEX: sweeprolog-backward-predicate
+#+KINDEX: M-n
+#+KINDEX: M-p
+In ~sweeprolog-mode~, the commands ~M-n~ (~sweeprolog-forward-predicate~)
+and ~M-p~ (~sweeprolog-backward-predicate~) are available for quickly
+jumping to the first line of the next or previous predicate
+definition in the current buffer.
+
+#+KINDEX: M-h
+The command ~M-h~ (~sweeprolog-mark-predicate~) marks the entire predicate
+definition at point, along with its =PlDoc= comments if there are any.
+This can be followed, for example, with killing the marked region to
+relocate the defined predicate by typing ~M-h C-w~.
+
 ** Following file specifications
 :PROPERTIES:
 :CUSTOM_ID: following-file-specs
@@ -1448,14 +1470,6 @@ there some further improvements that we want to pursue:
   definition, ideally with optional =PlDoc= comments (see 
[[#sweeprolog-pldoc][Documenting
   predicates]]).
 
-- Add commands for narrowing and moving by predicate definitions :: 
~sweeprolog-mode~
-  should include commands for moving point to the next/previous
-  predicate definition.  We already have commands for clause-based
-  motion (~C-M-a~, ~C-M-e~) but it would be useful to have predicate-based
-  variants as well.  These commands could then be bound to ~C-c C-n~ for
-  moving to the next predicate definition and ~C-c C-p~ for moving to
-  the previous.
-
 - Improve the information provided for predicate completion candidates :: 
predicate
   completion with ~C-M-i~ should annotate each completion candidate with
   the names and modes of its arguments, when available.  E.g. say
diff --git a/sweep.pl b/sweep.pl
index c5dfd37f4e..9f42fd0564 100644
--- a/sweep.pl
+++ b/sweep.pl
@@ -61,7 +61,9 @@
             sweep_predicate_html_documentation/2,
             sweep_predicate_properties/2,
             sweep_analyze_region/2,
-            sweep_xref_source/2
+            sweep_xref_source/2,
+            sweep_beginning_of_next_predicate/2,
+            sweep_beginning_of_last_predicate/2
           ]).
 
 :- use_module(library(pldoc)).
@@ -752,3 +754,26 @@ sweep_current_module(Module) :-
     atom_string(Path, String),
     sweep_module_path_(Module, Path).
 sweep_current_module(user).
+
+sweep_beginning_of_last_predicate(Start, Next) :-
+    sweep_source_id(Path),
+    xref_source(Path, [comments(store)]),
+    findall(L,
+            (   xref_defined(Path, _, H),
+                xref_definition_line(H, L),
+                L < Start
+            ),
+            Ls),
+    reverse(Ls, [Next|_]).
+
+sweep_beginning_of_next_predicate(Start, Next) :-
+    sweep_source_id(Path),
+    xref_source(Path, [comments(store)]),
+    xref_defined(Path, _, H), xref_definition_line(H, Next),
+    Start < Next.
+
+
+sweep_source_id(Path) :-
+    sweep_main_thread,
+    user:sweep_funcall("buffer-file-name", Path),
+    string(Path).
diff --git a/sweeprolog-tests.el b/sweeprolog-tests.el
index 16364e7dad..834c7e644c 100644
--- a/sweeprolog-tests.el
+++ b/sweeprolog-tests.el
@@ -105,6 +105,36 @@ foo(Foo) :- bar.
                    '(sweeprolog-undefined-default-face
                      sweeprolog-clause-default-face)))))
 
+
+(ert-deftest mark-predicate ()
+  "Test marking predicate definition."
+  (let ((temp (make-temp-file "sweeprolog-test"
+                              nil
+                              ".pl"
+                              "
+:- module(baz, []).
+
+
+%!  baz(-Baz) is semidet.
+%
+%   Foobar.
+
+baz(Baz) :- bar(Baz).
+baz(_) :- false.
+
+%!  bar(-Bar) is semidet.
+%
+%   Spam.
+
+bar(Bar) :- baz(Bar).
+"
+                              )))
+    (find-file-literally temp)
+    (sweeprolog-mode)
+    (call-interactively #'sweeprolog-mark-predicate)
+    (should (= (point) 24))
+    (should (= (mark) 104))))
+
 (ert-deftest export-predicate ()
   "Test exporting a predicate."
   (let ((temp (make-temp-file "sweeprolog-test"
@@ -156,7 +186,7 @@ foo(Bar) :- bar(Bar).
     (goto-char (point-max))
     (backward-word)
     (should (equal (sweeprolog-definition-at-point)
-                   '(1 "foo" 1)))))
+                   '(1 "foo" 1 21)))))
 
 (ert-deftest file-at-point ()
   "Test recognizing file specifications."
diff --git a/sweeprolog.el b/sweeprolog.el
index 5b936bd65e..9009fd3ac3 100644
--- a/sweeprolog.el
+++ b/sweeprolog.el
@@ -6,7 +6,7 @@
 ;; Maintainer: Eshel Yaron <~eshel/dev@lists.sr.ht>
 ;; Keywords: prolog languages extensions
 ;; URL: https://git.sr.ht/~eshel/sweep
-;; Package-Version: 0.8.2
+;; Package-Version: 0.8.3
 ;; Package-Requires: ((emacs "28.1"))
 
 ;; This file is NOT part of GNU Emacs.
@@ -326,6 +326,9 @@ clause."
                   #'flymake-show-diagnostics-buffer))
     (define-key map (kbd "C-M-^")   #'kill-backward-up-list)
     (define-key map (kbd "C-M-m")   #'sweeprolog-insert-term-dwim)
+    (define-key map (kbd "M-p")     #'sweeprolog-backward-predicate)
+    (define-key map (kbd "M-n")     #'sweeprolog-forward-predicate)
+    (define-key map (kbd "M-h")     #'sweeprolog-mark-predicate)
     map)
   "Keymap for `sweeprolog-mode'.")
 
@@ -2247,16 +2250,25 @@ Interactively, POINT is set to the current point."
           (not (= p (point))))
       (sweeprolog-beginning-of-next-top-term (- times)))))
 
-(defun sweeprolog-beginning-of-next-top-term (times)
+(defun sweeprolog-beginning-of-next-top-term (&optional times)
+  (setq times (or times 1))
   (let ((p (point)))
+    (when (sweeprolog-at-beginning-of-top-term-p)
+      (forward-char)
+      (re-search-forward (rx bol graph) nil t)
+      (while (and (or (nth 8 (syntax-ppss))
+                      (nth 8 (syntax-ppss (1+ (point)))))
+                  (not (eobp)))
+        (re-search-forward (rx bol graph) nil t))
+      (setq times (1- times)))
     (while (and (< 0 times) (not (eobp)))
       (setq times (1- times))
-      (unless (eobp)
-        (forward-char)
-        (re-search-forward (rx bol graph) nil t))
-      (while (and (nth 8 (syntax-ppss)) (not (eobp)))
-        (forward-char)
+      (re-search-forward (rx bol graph) nil t)
+      (while (and (or (nth 8 (syntax-ppss))
+                      (nth 8 (syntax-ppss (1+ (point)))))
+                  (not (eobp)))
         (re-search-forward (rx bol graph) nil t)))
+    (beginning-of-line)
     (not (= p (point)))))
 
 (defun sweeprolog-end-of-top-term ()
@@ -2341,7 +2353,7 @@ instead."
   (when-let ((pred (sweeprolog-identifier-at-point point)))
     (unless (sweeprolog-predicate-properties pred)
       (push-mark)
-      (sweeprolog-end-of-predicate-definition)
+      (sweeprolog-end-of-predicate-at-point)
       (let ((functor-arity (sweeprolog--mfn-to-functor-arity pred)))
         (sweeprolog-insert-clause (car functor-arity)
                                   (cdr functor-arity)))
@@ -2381,7 +2393,12 @@ of them signal success by returning non-nil."
                                           (pcase arg
                                             (`("head_term" ,_ ,f ,a)
                                              (setq def-at-point
-                                                   (list beg f a))))))
+                                                   (list beg f a)))
+                                            ("fullstop"
+                                             (when def-at-point
+                                               (setq def-at-point
+                                                     (append def-at-point
+                                                             (list beg))))))))
       def-at-point)))
 
 (defun sweeprolog-insert-pldoc-for-predicate (functor arguments det summary)
@@ -2396,7 +2413,7 @@ of them signal success by returning non-nil."
                   summary))
   (fill-paragraph))
 
-(defun sweeprolog-end-of-predicate-definition ()
+(defun sweeprolog-end-of-predicate-at-point ()
   "Move to the end of the predicate definition at point."
   (when-let* ((def (sweeprolog-definition-at-point)))
     (let ((point (point))
@@ -2413,6 +2430,66 @@ of them signal success by returning non-nil."
           (goto-char point)
           (setq point nil))))))
 
+(defun sweeprolog-forward-predicate (&optional arg)
+  "Move forward over the ARGth next predicate defintion from point."
+  (interactive "p" sweeprolog-mode)
+  (setq arg (or arg 1))
+  (while (< 0 arg)
+    (setq arg (1- arg))
+    (if-let ((line
+              (sweeprolog--query-once "sweep" 
"sweep_beginning_of_next_predicate"
+                                      (line-number-at-pos))))
+        (progn
+          (goto-char (point-min))
+          (forward-line (1- line)))
+      (setq arg 0)
+      (user-error "No next predicate"))))
+
+(defun sweeprolog-backward-predicate (&optional arg)
+  "Move backward over the ARGth next predicate defintion from point."
+  (interactive "p" sweeprolog-mode)
+  (setq arg (or arg 1))
+  (while (< 0 arg)
+    (setq arg (1- arg))
+    (if-let ((line
+              (sweeprolog--query-once "sweep" 
"sweep_beginning_of_last_predicate"
+                                      (line-number-at-pos))))
+        (progn
+          (goto-char (point-min))
+          (forward-line (1- line)))
+      (setq arg 0)
+      (user-error "No previous predicate"))))
+
+(defun sweeprolog-end-of-next-predicate ()
+  (let ((def-at-point (sweeprolog-definition-at-point)))
+    (when (or (and def-at-point (<= (point) (nth 3 def-at-point)))
+              (condition-case _
+                  (progn (sweeprolog-forward-predicate)
+                         t)))
+      (sweeprolog-end-of-predicate-at-point)
+      (point))))
+
+(defun sweeprolog-mark-predicate (&optional allow-extend)
+  "Put point at beginning of this predicate, mark at end.
+
+Interactively (or if ALLOW-EXTEND is non-nil), if this command is
+repeated or (in Transient Mark mode) if the mark is active, it
+marks the next predicate after the ones already marked."
+  (interactive "p" sweeprolog-mode)
+  (if (and allow-extend
+           (or (and (eq last-command this-command) (mark t))
+               (and transient-mark-mode mark-active)))
+      (set-mark
+       (save-excursion
+         (goto-char (mark))
+         (sweeprolog-end-of-next-predicate)))
+    (when (sweeprolog-end-of-next-predicate)
+      (push-mark nil t t)
+      (sweeprolog-backward-predicate)
+      (let ((last (or (caddr (sweeprolog-last-token-boundaries))
+                      (point-min))))
+        (while (re-search-backward (rx bol "%" (or "%" "!")) last t))))))
+
 (defun sweeprolog-beginning-of-predicate-at-point (&optional point)
   "Find the beginning of the predicate definition at or above POINT.
 
@@ -2535,7 +2612,8 @@ predicate definition at or directly above POINT."
       (while (and (not (bobp)) go)
         (skip-chars-backward " \t\n")
         (unless (bobp)
-          (forward-char -1)
+          (unless (nth 4 (syntax-ppss))
+            (forward-char -1))
           (if (nth 4 (syntax-ppss))
               (goto-char (nth 8 (syntax-ppss)))
             (setq go nil))))