From: Eshel Yaron Date: Fri, 8 Sep 2023 17:25:44 +0000 (+0200) Subject: ADDED: New command 'sweeprolog-extract-region-to-predicate' X-Git-Tag: V9.1.15-sweep-0.24.0~1 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=39f7e40e68cf213f0eb76c7b810083e6e06e1026;p=sweep.git 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. --- diff --git a/sweep.pl b/sweep.pl index 5e8ce0a..d9d10e9 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 13d558d..17fdf1e 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 24938cc..d348d28 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)