Re: Yanking isearch to highlight-regexp

[Juri Linkov]

Below is a patch that unifies two similar regexp-reading functions
`keep-lines-read-args' and `occur-read-primary-args' into the general
function `read-regexp'.  It reads a regexp using the regexp history
and provides some useful defaults.  Like `keep-lines-read-args'
it accepts the prompt as its argument, but without the trailing colon
to be able to add the default value in parentheses.

But now the prompt for `keep-lines' doesn't look nice since
it displays parentheses twice as:

  Keep lines (containing match for regexp) (default regexp): 

maybe a better format would be:

  Keep lines, containing match for regexp (default regexp): 

This new function could be used later in other packages like hi-lock.

Index: lisp/replace.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/replace.el,v
retrieving revision 1.272
diff -c -r1.272 replace.el
*** lisp/replace.el     6 Jun 2008 20:32:11 -0000       1.272
--- lisp/replace.el     28 Jun 2008 22:00:32 -0000
***************
*** 522,527 ****
--- 522,559 ----
  Maximum length of the history list is determined by the value
  of `history-length', which see.")
  
+ (defun read-regexp (prompt)
+   "Read regexp as a string using the regexp history and some useful defaults.
+ Prompt for a regular expression with PROMPT.  Provide the last element
+ of the regexp history as the basic default, and return it on typing RET.
+ Additional defaults are the string under point, the last search regexp,
+ the last search string, and the last replacement regexp.
+ Return the regexp as a string."
+   (let* ((default (car regexp-history))
+        (defaults
+          (list (regexp-quote
+                 (or (funcall (or find-tag-default-function
+                                  (get major-mode 'find-tag-default-function)
+                                  'find-tag-default))
+                     ""))
+                (car regexp-search-ring)
+                (regexp-quote (or (car search-ring) ""))
+                (car (symbol-value
+                      query-replace-from-history-variable))))
+        (defaults (delete-dups (delq nil (delete "" defaults))))
+        ;; Don't add automatically the car of defaults for empty input
+        (history-add-new-input nil)
+        (input
+         (read-from-minibuffer
+          (if default
+              (format "%s (default %s): " prompt (query-replace-descr default))
+            (format "%s: " prompt))
+          nil nil nil 'regexp-history defaults t)))
+     (if (equal input "")
+       default
+       (prog1 input
+       (add-to-history 'regexp-history input)))))
+ 
  
  (defalias 'delete-non-matching-lines 'keep-lines)
  (defalias 'delete-matching-lines 'flush-lines)
***************
*** 532,551 ****
    "Read arguments for `keep-lines' and friends.
  Prompt for a regexp with PROMPT.
  Value is a list, (REGEXP)."
!   (let* ((default (list
!                  (regexp-quote
!                   (or (funcall (or find-tag-default-function
!                                    (get major-mode 'find-tag-default-function)
!                                    'find-tag-default))
!                       ""))
!                  (car regexp-search-ring)
!                  (regexp-quote (or (car search-ring) ""))
!                  (car (symbol-value
!                        query-replace-from-history-variable))))
!        (default (delete-dups (delq nil (delete "" default)))))
!     (list (read-from-minibuffer prompt nil nil nil
!                               'regexp-history default t)
!         nil nil t)))
  
  (defun keep-lines (regexp &optional rstart rend interactive)
    "Delete all lines except those containing matches for REGEXP.
--- 564,570 ----
    "Read arguments for `keep-lines' and friends.
  Prompt for a regexp with PROMPT.
  Value is a list, (REGEXP)."
!   (list (read-regexp prompt) nil nil t))
  
  (defun keep-lines (regexp &optional rstart rend interactive)
    "Delete all lines except those containing matches for REGEXP.
***************
*** 574,580 ****
    (interactive
     (progn
       (barf-if-buffer-read-only)
!      (keep-lines-read-args "Keep lines (containing match for regexp): ")))
    (if rstart
        (progn
        (goto-char (min rstart rend))
--- 593,599 ----
    (interactive
     (progn
       (barf-if-buffer-read-only)
!      (keep-lines-read-args "Keep lines (containing match for regexp)")))
    (if rstart
        (progn
        (goto-char (min rstart rend))
***************
*** 649,655 ****
    (interactive
     (progn
       (barf-if-buffer-read-only)
!      (keep-lines-read-args "Flush lines (containing match for regexp): ")))
    (if rstart
        (progn
        (goto-char (min rstart rend))
--- 668,674 ----
    (interactive
     (progn
       (barf-if-buffer-read-only)
!      (keep-lines-read-args "Flush lines (containing match for regexp)")))
    (if rstart
        (progn
        (goto-char (min rstart rend))
***************
*** 695,701 ****
  a previously found match."
  
    (interactive
!    (keep-lines-read-args "How many matches for (regexp): "))
    (save-excursion
      (if rstart
        (progn
--- 714,720 ----
  a previously found match."
  
    (interactive
!    (keep-lines-read-args "How many matches for (regexp)"))
    (save-excursion
      (if rstart
        (progn
***************
*** 1003,1040 ****
        (nreverse result))))
  
  (defun occur-read-primary-args ()
!   (let* ((default (car regexp-history))
!        (defaults
!          (list (and transient-mark-mode mark-active
!                     (regexp-quote
!                      (buffer-substring-no-properties
!                       (region-beginning) (region-end))))
!                (regexp-quote
!                 (or (funcall
!                      (or find-tag-default-function
!                          (get major-mode 'find-tag-default-function)
!                          'find-tag-default))
!                     ""))
!                (car regexp-search-ring)
!                (regexp-quote (or (car search-ring) ""))
!                (car (symbol-value
!                      query-replace-from-history-variable))))
!        (defaults (delete-dups (delq nil (delete "" defaults))))
!        ;; Don't add automatically the car of defaults for empty input
!        (history-add-new-input nil)
!        (input
!         (read-from-minibuffer
!          (if default
!              (format "List lines matching regexp (default %s): "
!                      (query-replace-descr default))
!            "List lines matching regexp: ")
!          nil nil nil 'regexp-history defaults)))
!     (list (if (equal input "")
!             default
!           (prog1 input
!             (add-to-history 'regexp-history input)))
!         (when current-prefix-arg
!           (prefix-numeric-value current-prefix-arg)))))
  
  (defun occur-rename-buffer (&optional unique-p interactive-p)
    "Rename the current *Occur* buffer to *Occur: original-buffer-name*.
--- 1022,1030 ----
        (nreverse result))))
  
  (defun occur-read-primary-args ()
!   (list (read-regexp "List lines matching regexp")
!       (when current-prefix-arg
!         (prefix-numeric-value current-prefix-arg))))
  
  (defun occur-rename-buffer (&optional unique-p interactive-p)
    "Rename the current *Occur* buffer to *Occur: original-buffer-name*.

-- 
Juri Linkov
http://www.jurta.org/emacs/