]> code.delx.au - gnu-emacs-elpa/blobdiff - packages/el-search/el-search.el
prerequisites to allow replace with multiple expressions
[gnu-emacs-elpa] / packages / el-search / el-search.el
index 4dfb16b8f81a2b4d3a957087179911569113f65d..05cbc74aff083fd1087505aacf5fa51607106eb1 100644 (file)
@@ -7,7 +7,7 @@
 ;; Created: 29 Jul 2015
 ;; Keywords: lisp
 ;; Compatibility: GNU Emacs 25
-;; Version: 0.0.3
+;; Version: 0.1
 ;; Package-Requires: ((emacs "25"))
 
 
 ;;
 ;; TODO:
 ;;
+;; - change replace interface to include toggle(s)
+;;
+;; - detect infloops when replacing automatically (e.g. for 1 -> '(1))
+;;
+;; - highlight matches around point in a timer
+;;
 ;; - implement backward searching
 ;;
 ;; - improve docstrings
 ;; - handle more reader syntaxes, e.g. #n, #n#
 ;;
 ;; - Implement sessions; add multi-file support based on iterators.  A
-;; file list is read in (or the user can specify an iterator as a
-;; variable).  The state in the current buffer is just (buffer
-;; . marker).  Or should this be abstracted into an own lib?  Could be
-;; named "files-session" or so.
+;;   file list is read in (or the user can specify an iterator as a
+;;   variable).  The state in the current buffer is just (buffer
+;;   . marker).  Or should this be abstracted into an own lib?  Could
+;;   be named "files-session" or so.
 
 
 
 (require 'cl-lib)
 (require 'elisp-mode)
 (require 'thingatpt)
+(require 'help-fns) ;el-search--make-docstring
 
 
 ;;;; Configuration stuff
@@ -284,6 +291,8 @@ prompt to refer to the value of the currently tested expression."
     (read-from-minibuffer prompt initial-contents el-search-read-expression-map read
                           (or hist 'read-expression-history) default)))
 
+(defvar el-search--initial-mb-contents nil)
+
 (defun el-search--read-pattern (prompt &optional default read)
   (let ((this-sexp (sexp-at-point)))
     (minibuffer-with-setup-hook
@@ -341,7 +350,6 @@ Point must not be inside a string or comment."
   ;; code mainly from `pcase--make-docstring'
   (let* ((main (documentation (symbol-function 'el-search-pattern) 'raw))
          (ud (help-split-fundoc main 'pcase)))
-    (require 'help-fns)
     (with-temp-buffer
       (insert (or (cdr ud) main))
       (mapc
@@ -437,13 +445,14 @@ this pattern type."
      ,@body))
 
 (defun el-search--matcher (pattern &rest body)
-  (let ((warning-suppress-log-types '((bytecomp))))
-    (el-search--with-additional-pcase-macros
-     (byte-compile
-      `(lambda (expression)
-         (pcase expression
-           (,pattern ,@(or body (list t)))
-           (_        nil)))))))
+  (eval
+   `(el-search--with-additional-pcase-macros
+     (let ((warning-suppress-log-types '((bytecomp))))
+       (byte-compile
+        (lambda (expression)
+          (pcase expression
+            (,pattern ,@(or body (list t)))
+            (_        nil))))))))
 
 (defun el-search--match-p (matcher expression)
   (funcall matcher expression))
@@ -555,8 +564,9 @@ return nil (no error)."
 
 (defvar el-search-keep-hl nil)
 
-(defun el-search-hl-sexp-at-point ()
-  (let ((bounds (list (point) (el-search--end-of-sexp))))
+(defun el-search-hl-sexp (&optional bounds)
+  (let ((bounds (or bounds
+                    (list (point) (el-search--end-of-sexp)))))
     (if (overlayp el-search-hl-overlay)
         (apply #'move-overlay el-search-hl-overlay bounds)
       (overlay-put (setq el-search-hl-overlay (apply #'make-overlay bounds))
@@ -625,24 +635,31 @@ The following additional pattern types are currently defined:\n"
                            (ding)
                            nil))
       (setq el-search-success t)
-      (el-search-hl-sexp-at-point))))
+      (el-search-hl-sexp))))
 
-(defun el-search-search-and-replace-pattern (pattern replacement &optional mapping)
+(defun el-search-search-and-replace-pattern (pattern replacement &optional mapping splice)
   (let ((replace-all nil) (nbr-replaced 0) (nbr-skipped 0) (done nil)
         (el-search-keep-hl t) (opoint (point))
         (get-replacement (el-search--matcher pattern replacement)))
     (unwind-protect
         (while (and (not done) (el-search--search-pattern pattern t))
           (setq opoint (point))
-          (unless replace-all (el-search-hl-sexp-at-point))
+          (unless replace-all (el-search-hl-sexp))
           (let* ((read-mapping (el-search--create-read-map))
                  (region (list (point) (el-search--end-of-sexp)))
                  (substring (apply #'buffer-substring-no-properties region))
                  (expr      (read substring))
                  (replaced-this nil)
                  (new-expr  (funcall get-replacement expr))
-                 (to-insert (el-search--repair-replacement-layout
-                             (el-search--print new-expr) (append mapping read-mapping)))
+                 (get-replacement-string
+                  (lambda () (if (and splice (not (listp new-expr)))
+                            (error "Expression to splice in is an atom")
+                          (el-search--repair-replacement-layout
+                           (if splice
+                               (mapconcat #'el-search--print new-expr " ")
+                             (el-search--print new-expr))
+                           (append mapping read-mapping)))))
+                 (to-insert (funcall get-replacement-string))
                  (do-replace (lambda ()
                                (atomic-change-group
                                  (apply #'delete-region region)
@@ -650,8 +667,8 @@ The following additional pattern types are currently defined:\n"
                                        (opoint (point)))
                                    (insert to-insert)
                                    (indent-region opoint (point))
-                                   (goto-char opoint)
-                                   (el-search-hl-sexp-at-point)))
+                                   (el-search-hl-sexp (list opoint (point)))
+                                   (goto-char opoint)))
                                (cl-incf nbr-replaced)
                                (setq replaced-this t))))
             (if replace-all
@@ -663,8 +680,10 @@ The following additional pattern types are currently defined:\n"
                                             (if (or (string-match-p "\n" to-insert)
                                                     (< 40 (length to-insert)))
                                                 "" (format " with `%s'" to-insert))
-                                            "? [y SPC r ! q]" )
-                                    '(?y ?n ?r ?\ ?! ?q)))
+                                            "? "
+                                            (if splice "{splice} " "")
+                                            "[y SPC r ! q]" )
+                                    '(?y ?n ?r ?\ ?! ?q ?s)))
                             (?r (funcall do-replace)
                                 nil)
                             (?y (funcall do-replace)
@@ -676,6 +695,9 @@ The following additional pattern types are currently defined:\n"
                                   (funcall do-replace))
                                 (setq replace-all t)
                                 t)
+                            (?s (cl-callf not splice)
+                                (setq to-insert (funcall get-replacement-string))
+                                nil)
                             (?q (setq done t)
                                 t)))))
             (unless (or done (eobp)) (el-search--skip-expression nil t)))))
@@ -686,10 +708,6 @@ The following additional pattern types are currently defined:\n"
              (if (zerop nbr-skipped)  ""
                (format "   (%d skipped)" nbr-skipped)))))
 
-;; We need a variable for the initial contents because we want to `call-interactively'
-;; `el-search-query-replace-read-args'
-(defvar el-search--initial-mb-contents nil)
-
 (defun el-search-query-replace-read-args ()
   (barf-if-buffer-read-only)
   (let* ((from (el-search--read-pattern "Replace from: "))