(elisp-extract-local-variable): Various improvements

diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el
index ad65e0700aa8e47d5f30abacb6d4493a86b13bd7..3544e9bb7fc0b00f744e2921ef282a1bbc6bd55c 100644 (file)
--- a/lisp/progmodes/elisp-mode.el
+++ b/lisp/progmodes/elisp-mode.el
@@ -2371,58 +2371,91 @@ interactively, this is the prefix argument."
 
 (defvar elisp-extract-local-variable-name-history nil)
 
-(defun elisp-extract-to-local-variable (beg end target var)
-  "Extract BEG to END region to local VAR bound at TARGET."
+(defun elisp-extract-to-local-variable (regions target var)
+  "Extract REGIONS to a new local VAR and bind it at TARGET.
+
+REGIONS is a list of cons cells (BEG . END), each specifying a
+region (from BEG to END) to replace with a reference to VAR.
+
+TARGET is the start position of a form FORM to wrap with a `let' that
+introduces VAR.  If FORM is already a `let' form, add another binding to
+FORM instead of wrapping it with another `let'.
+
+Interactively, use the active region as the sole element of REGIONS, and
+prompt for TARGET and VAR.  With a prefix argument, extend REGIONS with
+any additional occurrences of the form in the active region in the scope
+of TARGET."
   (interactive
-   (let ((beg (region-beginning))
-         (end (region-end))
-         (max 0)
-         (targets nil))
+   (let ((beg (region-beginning)) (end (region-end)) (max 0) targets)
+     (unless (use-region-p) (user-error "No active region"))
      (save-excursion
        (goto-char beg)
        (beginning-of-defun-raw)
        (scope (lambda (type sbeg len bin)
                 (and (<= sbeg beg)
                      (memq type '(function macro special-form top-level))
-                     (push (save-excursion (nth 1 (syntax-ppss sbeg))) targets))
+                     (push (nth 1 (syntax-ppss sbeg)) targets))
                 (let ((send (+ sbeg len)))
                   (and (<= beg sbeg send end) (numberp bin) (< bin beg)
                        (setq max (max max bin)))))))
      (let* ((target
-             (if-let ((avy-action #'ignore)
-                      (targets (seq-drop-while
-                                (apply-partially #'> max)
-                                (sort (seq-intersection
-                                       (nth 9 (syntax-ppss)) targets #'=)))))
-                 (or (avy-process targets) (keyboard-quit))
+             (if-let ((avy-action #'ignore) ;Just return selection.
+                      (cands (seq-drop-while
+                              (apply-partially #'> max)
+                              (sort (seq-intersection
+                                     (nth 9 (syntax-ppss)) targets #'=)))))
+                 (or (avy-process cands) (keyboard-quit))
                (user-error "No valid targets")))
-            (tarend (save-excursion (goto-char target) (scan-sexps (point) 1)))
-            (ovbeg (make-overlay target (1+ target)))
-            (ovend (make-overlay tarend (1+ tarend))))
-       (overlay-put ovbeg 'face 'show-paren-match)
-       (overlay-put ovend 'face 'show-paren-match)
-       (list beg end target
+            (tarend (save-excursion
+                      (goto-char target)
+                      (1- (scan-sexps (point) 1))))
+            others ovothers ovbeg ovend)
+       (when (and current-prefix-arg (fboundp 'el-search-forward))
+         (save-excursion
+           (goto-char target)
+           (while (el-search-forward
+                   (list '\` (read (buffer-substring beg end)))
+                   tarend t)
+             (let ((obeg (point)) (oend (1- (scan-sexps (point) 1))))
+               (goto-char oend)
+               (when (or (< oend beg) (< end obeg)) ;No overlap.
+                 (push (cons obeg oend) others)
+                 (let ((ovb (make-overlay obeg (1+ obeg)))
+                       (ove (make-overlay oend (1+ oend))))
+                   (overlay-put ovb 'face 'isearch)
+                   (overlay-put ove 'face 'isearch)
+                   (push ovb ovothers)
+                   (push ove ovothers)))))))
+       (setq ovbeg (make-overlay target (1+ target)))
+       (setq ovend (make-overlay tarend (1+ tarend)))
+       (overlay-put ovbeg 'face 'lazy-highlight)
+       (overlay-put ovend 'face 'lazy-highlight)
+       (list `((,beg . ,end) . ,others) target
              (unwind-protect
-                 (read-string (format-prompt "Extract region to local var called" "v")
-                              nil 'elisp-extract-local-variable-name-history "v")
-               (delete-overlay ovbeg)
-               (delete-overlay ovend)))))
+                 (read-string
+                  (format-prompt "Extract region to var called" "v")
+                  nil 'elisp-extract-local-variable-name-history "v")
+               (mapc #'delete-overlay `(,ovbeg ,ovend . ,ovothers))))))
    emacs-lisp-mode)
-  (let ((reg (delete-and-extract-region beg end)))
-    (goto-char beg)
-    (insert var)
-    (let ((pos (copy-marker (point))))
-      (goto-char target)
-      (pcase (save-excursion (read (current-buffer)))
-        (`(,(or 'let 'let* 'if-let* 'when-let* 'while-let*) . ,_)
-         (down-list 2)
-         (insert "(" var " " reg ")\n"))
-        (_
-         (insert "(let ((" var " " reg "))\n")
-         (goto-char (scan-sexps (point) 1))
-         (insert ")")))
-      (prog-indent-sexp 'defun)
-      (goto-char pos))))
+  (let* ((beg-end (car regions)) (beg (car beg-end)) (end (cdr beg-end))
+         (pos (copy-marker beg t))
+         (reg (buffer-substring-no-properties beg end)))
+    (pcase-dolist
+        (`(,b . ,e) (sort regions :key #'cdr :reverse t))
+      (goto-char b)
+      (delete-region b e)
+      (insert var))
+    (goto-char target)
+    (if (memq (car-safe (save-excursion (read (current-buffer))))
+              '(let let* if-let* when-let* while-let*))
+        ;; Add binding to existing `let'.
+        (progn (down-list 2) (insert "(" var " " reg ")\n"))
+      ;; Wrap with new `let'.
+      (insert "(let ((" var " " reg "))\n")
+      (goto-char (scan-sexps (point) 1))
+      (insert ")"))
+    (prog-indent-sexp 'defun)
+    (goto-char pos)))
 
 \f
 (put 'read-symbol-shorthands 'safe-local-variable #'consp)