[nongnu] elpa/sweeprolog 39f7e40e68 2/5: ADDED: New command 'sweeprolog-extract-region-to-predicate'

[ELPA Syncer]

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

    ADDED: New command 'sweeprolog-extract-region-to-predicate'
    
    Add a command for extracting a part of a clause body into a separate
    predicate.
    
    * sweep.pl (sweep_term_variable_names/2)
    (sweep_goal_may_cut/2): New helper predicates.
    * sweeprolog.el (sweeprolog-extract-region-to-predicate): New command.
    (sweeprolog-maybe-extract-region-to-predicate): New function.
    (sweeprolog-insert-term-functions): Add it.
    * sweep.texi (Insert Term DWIM, Extract Goal): Document it.
---
 sweep.pl      | 30 ++++++++++++++++++-
 sweep.texi    | 45 ++++++++++++++++++++++++++---
 sweeprolog.el | 93 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++---
 3 files changed, 159 insertions(+), 9 deletions(-)

diff --git a/sweep.pl b/sweep.pl
index 5e8ce0abb4..d9d10e9898 100644
--- a/sweep.pl
+++ b/sweep.pl
@@ -93,7 +93,9 @@
             sweep_variable_start_code/2,
             sweep_head_functors_collection/2,
             sweep_functors_collection/2,
-            sweep_compound_functors_collection/2
+            sweep_compound_functors_collection/2,
+            sweep_term_variable_names/2,
+            sweep_goal_may_cut/2
           ]).
 
 :- use_module(library(pldoc)).
@@ -1422,3 +1424,29 @@ sweep_expand_macro(String0, String) :-
     term_string(Term, String, [variable_names(Vs), module(M)]).
 
 sweep_variable_start_code(C, _) :- code_type(C, prolog_var_start).
+
+sweep_term_variable_names(String, Names) :-
+    term_string(_, String, [variable_names(VarNames)]),
+    maplist([Atom=_,Name]>>atom_string(Atom, Name), VarNames, Names).
+
+sweep_goal_may_cut(String, _) :-
+    term_string(Goal, String),
+    sweep_goal_may_cut_(Goal),
+    !.
+
+sweep_goal_may_cut_((_->A;B)) =>
+    (   sweep_goal_may_cut_(A)
+    ;   sweep_goal_may_cut_(B)
+    ).
+sweep_goal_may_cut_(A;B) =>
+    (   sweep_goal_may_cut_(A)
+    ;   sweep_goal_may_cut_(B)
+    ).
+sweep_goal_may_cut_((A,B)) =>
+    (   sweep_goal_may_cut_(A)
+    ;   sweep_goal_may_cut_(B)
+    ).
+sweep_goal_may_cut_(!) =>
+    true.
+sweep_goal_may_cut_(_) =>
+    false.
diff --git a/sweep.texi b/sweep.texi
index 13d558d0ba..17fdf1e441 100644
--- a/sweep.texi
+++ b/sweep.texi
@@ -2099,8 +2099,8 @@ As a means of automating common Prolog code editing 
tasks, such as
 adding new clauses to an existing predicate, Sweep Prolog mode
 provides the ``do what I mean'' command
 @code{sweeprolog-insert-term-dwim}, bound by default to @kbd{C-M-m}
-(or equivalently, @kbd{M-RET}).  This command inserts a new term at or
-after point according to the context in which you invoke it.
+(or equivalently, @kbd{M-@key{RET}}).  This command inserts a new term in
+the current buffer according to the context in which you invoke it.
 
 @table @kbd
 @kindex M-RET
@@ -2109,7 +2109,7 @@ after point according to the context in which you invoke 
it.
 @item M-@key{RET}
 @itemx C-M-m
 Insert an appropriate Prolog term in the current buffer, based on the
-context at point (@code{sweeprolog-insert-term-dwim}).
+current context (@code{sweeprolog-insert-term-dwim}).
 @end table
 
 @defvar sweeprolog-insert-term-functions
@@ -2126,6 +2126,11 @@ non-@code{nil}.
 By default, @code{sweeprolog-insert-term-dwim} tries the following
 insertion functions, in order:
 
+@defun sweeprolog-maybe-extract-region-to-predicate
+If the region is active, extract the selected goal into a separate
+predicate.  @xref{Extract Goal}.
+@end defun
+
 @defun sweeprolog-maybe-insert-next-clause
 If the last token before point is a fullstop ending a predicate
 clause, insert a new clause below it.
@@ -2177,7 +2182,7 @@ test() :- TestBody.
 The cursor is left between the parentheses of the @code{test()} head
 term, and the @code{TestBody} variable is marked as a hole
 (@pxref{Holes}).  To insert another unit test, place point after a
-complete test case and type @kbd{C-M-m} (or @kbd{M-RET}) to invoke
+complete test case and type @kbd{C-M-m} (or @kbd{M-@key{RET}}) to invoke
 @code{sweeprolog-insert-term-dwim} (@pxref{Insert Term DWIM, ,
 Context-Based Term Insertion}).
 
@@ -2517,6 +2522,38 @@ With Context Menu mode enabled, you can also expand 
macros by
 right-clicking on the @code{#} and selecting @samp{Expand Macro} from
 the context menu.  @xref{Context Menu}.
 
+@node Extract Goal
+@section Extracting Goals to Separate Predicates
+
+Sweep can help you extract a part of the body of a Prolog clause into
+a separate predicate, so you can reuse it in other places.
+
+@findex sweeprolog-extract-region-to-predicate
+@deffn Command sweeprolog-extract-region-to-predicate
+Extract the goal between point and mark into a new predicate.
+@end deffn
+
+This command extracts the selected goal into a separate predicate.  It
+prompts you for the name of the new predicate and inserts a definition
+for that predicate in the current buffer, while replacing the current
+region with a call to this new predicate.  The body of the new
+predicate is the goal in the current region, and this command
+determines the arguments of the new predicate based on the variables
+that the goal to extract shares with the containing clause.
+
+If the selected goal contains a cut whose scope would change as a
+result of being extracted from the current clause,
+@code{sweeprolog-extract-region-to-predicate} warns you about it and
+asks you to confirm before continuing.
+
+By default, @code{sweeprolog-extract-region-to-predicate} is not bound
+directly to any key in Sweep Prolog mode; instead, you can it by
+typing @kbd{M-@key{RET}} (@code{sweeprolog-insert-term-dwim}) when the
+region is active.  @xref{Insert Term DWIM}).
+
+With Context Menu mode enabled, you can also invoke this command by
+right-clicking on an active region.
+
 @node Prolog Help
 @chapter Prolog Help
 
diff --git a/sweeprolog.el b/sweeprolog.el
index 24938cc725..d348d28088 100644
--- a/sweeprolog.el
+++ b/sweeprolog.el
@@ -56,7 +56,8 @@
 (defvar sweeprolog--extra-init-args nil)
 
 (defvar sweeprolog-insert-term-functions
-  '(sweeprolog-maybe-insert-next-clause
+  '(sweeprolog-maybe-extract-region-to-predicate
+    sweeprolog-maybe-insert-next-clause
     sweeprolog-maybe-define-predicate)
   "Hook of functions that insert a Prolog term in a certain context.
 
@@ -1392,8 +1393,8 @@ Prolog buffers."
 (defun sweeprolog-local-variables-collection (&rest exclude)
   "Return a list of variable names that occur in the current clause.
 
-EXCLUDE is a list of variables name to be excluded from the
-resulting list even when found in the current clause."
+EXCLUDE is a list of variable names to exclude from the resulting
+list even when found in the current clause."
   (let* ((case-fold-search nil)
          (beg (save-mark-and-excursion
                 (unless (sweeprolog-at-beginning-of-top-term-p)
@@ -5987,13 +5988,23 @@ POINT is the buffer position of the mouse click."
                              :help ,(format "Expand macro to %s" expansion)
                              :keys "\\[sweeprolog-expand-macro-at-point]")))))
 
+(defun sweeprolog-context-menu-for-region (menu &rest _)
+  "Extend MENU with commands that are only relevant when the region is active."
+  (when (use-region-p)
+    (define-key menu [sweeprolog-extract-region-to-predicate]
+                `(menu-item "Extract to New Predicate"
+                            sweeprolog-extract-region-to-predicate
+                            :help "Extract the selected goal into a separate 
predicate"
+                            :keys 
"\\[sweeprolog-extract-region-to-predicate]"))))
+
 (defvar sweeprolog-context-menu-functions
   '(sweeprolog-context-menu-for-clause
     sweeprolog-context-menu-for-file
     sweeprolog-context-menu-for-module
     sweeprolog-context-menu-for-predicate
     sweeprolog-context-menu-for-variable
-    sweeprolog-context-menu-for-macro)
+    sweeprolog-context-menu-for-macro
+    sweeprolog-context-menu-for-region)
   "Functions that create context menu entries for Prolog tokens.
 Each function receives as its arguments the menu, the Prolog
 token's description, its start position, its end position, and
@@ -6809,6 +6820,80 @@ This function is used as a 
`add-log-current-defun-function' in
               fun ind (number-to-string ari)))))
 
 
+;;;; Extract goals to separate predicates
+
+(defun sweeprolog-extract-region-to-predicate (beg end new)
+  "Extract the Prolog goal from BEG to END into a new predicate, NEW.
+
+BEG and END are buffer positions; interactively, these are the
+beginning and end of the current region.  NEW is a string used as
+the functor of the new predicate; interactively, this command
+prompts for NEW in the minibuffer.
+
+This command defines the new predicate with arguments based on
+the variables that the goal to extract shares with the containing
+clause.
+
+The user option `sweeprolog-new-predicate-location-function' says
+where in the buffer to insert the newly created predicate."
+  (interactive "r\nsNew predicate functor: " sweeprolog-mode)
+  ;; TODO - check that NEW isn't already used
+  (let* ((name (sweeprolog-format-string-as-atom new))
+         (body (buffer-substring-no-properties beg end))
+         (vars (condition-case error
+                   (sweeprolog--query-once "sweep" "sweep_term_variable_names"
+                                           body)
+                 (prolog-exception
+                  (user-error "Region does not contain a valid Prolog 
term")))))
+    (if (and (sweeprolog--query-once "sweep" "sweep_goal_may_cut" body)
+             (not (y-or-n-p (concat
+                             "The selected goal contains a cut whose "
+                             "scope would change as a result of this "
+                             "operation.  Continue?"))))
+        (message "Canceled.")
+      (combine-after-change-calls
+        (goto-char beg)
+        (delete-region beg end)
+        (insert name)
+        (let* ((clause-beg (save-excursion
+                             (sweeprolog-beginning-of-top-term)
+                             (point)))
+               (clause-end (save-excursion
+                             (sweeprolog-end-of-top-term)
+                             (point)))
+               (clause-vars
+                (condition-case error
+                    (sweeprolog--query-once "sweep" "sweep_term_variable_names"
+                                            (buffer-substring-no-properties
+                                             clause-beg clause-end))
+                  (prolog-exception (sweeprolog-local-variables-collection))))
+               (neck (or (nth 4 (sweeprolog-definition-at-point)) ":-"))
+               (args (seq-intersection vars clause-vars #'string=)))
+          (when args
+            (insert "(" (mapconcat #'identity args ", ") ")"))
+          (funcall sweeprolog-new-predicate-location-function
+                   name (length args) neck)
+          (let ((def-beg (1+ (point))))
+            (insert (concat "\n"
+                            name
+                            (when args
+                              (concat "(" (mapconcat #'identity args ", ") 
")"))
+                            " "
+                            neck
+                            "\n"
+                            body
+                            ".\n"))
+            (indent-region-line-by-line def-beg (point))
+            (goto-char def-beg)))))))
+
+(defun sweeprolog-maybe-extract-region-to-predicate (&rest _)
+  (when (use-region-p)
+    (sweeprolog-extract-region-to-predicate
+     (use-region-beginning)
+     (use-region-end)
+     (read-string "Extract region to new predicate: "))
+    t))
+
 ;;;; Bug Reports
 
 (defvar reporter-prompt-for-summary-p)