bug#14405: 24.3.50; read-regexp-defaults-function

[Juri Linkov <juri@jurta.org>]

> +(defcustom read-regexp-defaults-function nil
> +  :type '(choice
> +          (const :tag "No default regexp reading function" nil)
> +          (choice :tag "Function to provide default for read-regexp"
> +		  (function-item :tag "Tag at point" find-tag-default)
> +		  (function-item :tag "Symbol at point" find-tag-default-as-regexp)
> +		  (function-item :tag "Latest history" (lambda () (car regexp-history)))

Actually there are two problems in this defcustom:

1. `find-tag-default' doesn't return a regexp.  To fix this problem,
we need two functions returning a regexp: as a non-symbol regexp and
as a symbol regexp.  I propose the following implementations:

  (defun find-tag-default-as-regexp ()
    "Return regexp that matches the default tag at point."
    (let ((tag (funcall (or find-tag-default-function
                            (get major-mode 'find-tag-default-function)
                            'find-tag-default))))
      (if tag (regexp-quote tag))))

  (defun find-tag-default-as-symbol-regexp ()
    "Return regexp that matches the default tag at point as symbol."
    (let ((tag-regexp (find-tag-default-as-regexp)))
      (if (and tag-regexp
               (eq (or find-tag-default-function
                       (get major-mode 'find-tag-default-function)
                       'find-tag-default)
                   'find-tag-default))
          (format "\\_<%s\\_>" tag-regexp)
        tag-regexp)))

2. The second problem is that `(lambda () (car regexp-history))'
can't be used in defcustom because many commands use history other than
`regexp-history'.

As a possible solution we could add a new special symbol
`default-last-history' to handle it in `read-regexp' that
has access to the actual value of the history variable in its arg
`history' using `(symbol-value (or history 'regexp-history))' below:

=== modified file 'lisp/replace.el'
--- lisp/replace.el	2013-03-24 21:47:52 +0000
+++ lisp/replace.el	2013-05-18 23:27:38 +0000
@@ -580,6 +580,24 @@ (defvar regexp-history nil
 (defvar occur-collect-regexp-history '("\\1")
   "History of regexp for occur's collect operation")
 
+(defcustom read-regexp-defaults-function nil
+  "Function that provides default regexp(s) for regexp reading commands."
+  :type '(choice
+	  (const :tag "No default regexp reading function" nil)
+	  (const :tag "Latest history" default-last-history)
+	  (function-item :tag "Tag at point" find-tag-default-as-regexp)
+	  (function-item :tag "Symbol at point" find-tag-default-as-symbol-regexp)
+	  (function :tag "Function to provide default for read-regexp"))
+  :group 'matching
+  :version "24.4")
+
 (defun read-regexp (prompt &optional defaults history)
   "Read and return a regular expression as a string.
 When PROMPT doesn't end with a colon and space, it adds a final \": \".
@@ -591,13 +609,23 @@ (defun read-regexp (prompt &optional def
 
 Optional arg HISTORY is a symbol to use for the history list.
 If HISTORY is nil, `regexp-history' is used."
-  (let* ((default     (if (consp defaults) (car defaults) defaults))
+  (let* ((defaults
+	   (if (and defaults (symbolp defaults))
+	       (cond
+		((eq (or read-regexp-defaults-function defaults)
+		     'default-last-history)
+		 (car (symbol-value (or history 'regexp-history))))
+		((functionp (or read-regexp-defaults-function defaults))
+		 (funcall (or read-regexp-defaults-function defaults))))
+	     defaults))
+	 (default     (if (consp defaults) (car defaults) defaults))
 	 (suggestions (if (listp defaults) defaults (list defaults)))
 	 (suggestions
 	  (append
 	   suggestions
 	   (list
 	    (find-tag-default-as-regexp)
+	    (find-tag-default-as-symbol-regexp)
 	    (car regexp-search-ring)
 	    (regexp-quote (or (car search-ring) ""))
 	    (car (symbol-value query-replace-from-history-variable)))))
@@ -1143,9 +1170,9 @@
 (defun occur-read-primary-args ()
   (let* ((perform-collect (consp current-prefix-arg))
          (regexp (read-regexp (if perform-collect
                                   "Collect strings matching regexp"
                                 "List lines matching regexp")
-                              (funcall occur-read-regexp-defaults-function))))
+                              'default-last-history)))
     (list regexp
 	  (if perform-collect
 	      ;; Perform collect operation

=== modified file 'lisp/hi-lock.el'
--- lisp/hi-lock.el	2013-03-31 13:34:35 +0000
+++ lisp/hi-lock.el	2013-05-18 23:27:23 +0000
@@ -431,8 +411,7 @@ (defun hi-lock-line-face-buffer (regexp
   (interactive
    (list
     (hi-lock-regexp-okay
-     (read-regexp "Regexp to highlight line"
-		  (funcall hi-lock-read-regexp-defaults-function)))
+     (read-regexp "Regexp to highlight line" 'default-last-history))
     (hi-lock-read-face-name)))
   (or (facep face) (setq face 'hi-yellow))
   (unless hi-lock-mode (hi-lock-mode 1))
@@ -457,8 +436,7 @@ (defun hi-lock-face-buffer (regexp &opti
   (interactive
    (list
     (hi-lock-regexp-okay
-     (read-regexp "Regexp to highlight"
-		  (funcall hi-lock-read-regexp-defaults-function)))
+     (read-regexp "Regexp to highlight" 'default-last-history))
     (hi-lock-read-face-name)))
   (or (facep face) (setq face 'hi-yellow))
   (unless hi-lock-mode (hi-lock-mode 1))
@@ -483,8 +481,7 @@ (defun hi-lock-face-phrase-buffer (regex
    (list
     (hi-lock-regexp-okay
      (hi-lock-process-phrase
-      (read-regexp "Phrase to highlight"
-		   (funcall hi-lock-read-regexp-defaults-function))))
+      (read-regexp "Phrase to highlight" 'default-last-history)))
     (hi-lock-read-face-name)))
   (or (facep face) (setq face 'hi-yellow))
   (unless hi-lock-mode (hi-lock-mode 1))

=== modified file 'lisp/progmodes/grep.el'
--- lisp/progmodes/grep.el	2013-02-12 04:46:18 +0000
+++ lisp/progmodes/grep.el	2013-05-18 23:23:30 +0000
@@ -817,12 +831,7 @@ (defun grep-expand-template (template &o
 
 (defun grep-read-regexp ()
   "Read regexp arg for interactive grep."
-  (let ((default (grep-tag-default)))
-    (read-regexp
-     (concat "Search for"
-	     (if (and default (> (length default) 0))
-		 (format " (default \"%s\"): " default) ": "))
-     default 'grep-regexp-history)))
+  (read-regexp "Search for" 'grep-tag-default 'grep-regexp-history))
 
 (defun grep-read-files (regexp)
   "Read files arg for interactive grep."