Re: Yanking isearch to highlight-regexp

[Juri Linkov <juri@jurta.org>]

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/