Rewrite Eshell tests using ERT
[bpt/emacs.git] / lisp / replace.el
index 3eaa5cc..1bebff4 100644 (file)
@@ -583,29 +583,31 @@ of `history-length', which see.")
 (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 \": \".
-If DEFAULTS is non-nil, it displays the first default in the prompt.
-
-Non-nil optional arg DEFAULTS is a string or a list of strings that
-are prepended to a list of standard default values, which include the
-string at point, the last isearch regexp, the last isearch string, and
-the last replacement regexp.
-
-Non-nil HISTORY is a symbol to use for the history list.
+If the first element of DEFAULTS is non-nil, it's added to the prompt.
+
+Optional arg DEFAULTS has the form (DEFAULT . SUGGESTIONS)
+or simply DEFAULT where DEFAULT, if non-nil, should be a string that
+is returned as the default value when the user enters empty input.
+SUGGESTIONS is a list of strings that can be inserted into
+the minibuffer using \\<minibuffer-local-map>\\[next-history-element].  \
+The values supplied in SUGGESTIONS
+are prepended to the list of standard suggestions that include
+the tag at point, the last isearch regexp, the last isearch string,
+and the last replacement regexp.
+
+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))
-        (defaults
-          (append
-           (if (listp defaults) defaults (list 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))))
+  (let* ((default     (if (consp defaults) (car defaults) defaults))
+        (suggestions (if (listp defaults) defaults (list defaults)))
+        (suggestions
+         (append
+          suggestions
+          (list
+           (find-tag-default-as-regexp)
+           (car regexp-search-ring)
+           (regexp-quote (or (car search-ring) ""))
+           (car (symbol-value query-replace-from-history-variable)))))
+        (suggestions (delete-dups (delq nil (delete "" suggestions))))
         ;; Do not automatically add default to the history for empty input.
         (history-add-new-input nil)
         (input (read-from-minibuffer
@@ -616,9 +618,11 @@ If HISTORY is nil, `regexp-history' is used."
                                 (query-replace-descr default)))
                       (t
                        (format "%s: " prompt)))
-                nil nil nil (or history 'regexp-history) defaults t)))
+                nil nil nil (or history 'regexp-history) suggestions t)))
     (if (equal input "")
+       ;; Return the default value when the user enters empty input.
        (or default input)
+      ;; Otherwise, add non-empty input to the history and return input.
       (prog1 input
        (add-to-history (or history 'regexp-history) input)))))
 
@@ -1121,6 +1125,14 @@ If the value is nil, don't highlight the buffer names specially."
   :type 'face
   :group 'matching)
 
+(defcustom list-matching-lines-prefix-face 'shadow
+  "Face used by \\[list-matching-lines] to show the prefix column.
+If the face doesn't differ from the default face,
+don't highlight the prefix with line numbers specially."
+  :type 'face
+  :group 'matching
+  :version "24.4")
+
 (defcustom occur-excluded-properties
   '(read-only invisible intangible field mouse-face help-echo local-map keymap
     yank-handler follow-link)
@@ -1131,12 +1143,32 @@ which means to discard all text properties."
   :group 'matching
   :version "22.1")
 
+(defvar occur-read-regexp-defaults-function
+  'occur-read-regexp-defaults
+  "Function that provides default regexp(s) for occur commands.
+This function should take no arguments and return one of nil, a
+regexp or a list of regexps for use with occur commands -
+`occur', `multi-occur' and `multi-occur-in-matching-buffers'.
+The return value of this function is used as DEFAULTS param of
+`read-regexp' while executing the occur command.  This function
+is called only during interactive use.
+
+For example, to check for occurrence of symbol at point use
+
+    \(setq occur-read-regexp-defaults-function
+         'find-tag-default-as-regexp\).")
+
+(defun occur-read-regexp-defaults ()
+  "Return the latest regexp from `regexp-history'.
+See `occur-read-regexp-defaults-function' for details."
+  (car regexp-history))
+
 (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")
-                              (car regexp-history))))
+                              (funcall occur-read-regexp-defaults-function))))
     (list regexp
          (if perform-collect
              ;; Perform collect operation
@@ -1310,7 +1342,9 @@ See also `multi-occur'."
                      (isearch-no-upper-case-p regexp t)
                    case-fold-search)
                  list-matching-lines-buffer-name-face
-                 nil list-matching-lines-face
+                 (if (face-differs-from-default-p list-matching-lines-prefix-face)
+                     list-matching-lines-prefix-face)
+                 list-matching-lines-face
                  (not (eq occur-excluded-properties t))))))
          (let* ((bufcount (length active-bufs))
                 (diff (- (length bufs) bufcount)))
@@ -1399,7 +1433,7 @@ See also `multi-occur'."
                            (apply #'propertize (format "%7d:" lines)
                                   (append
                                    (when prefix-face
-                                     `(font-lock-face prefix-face))
+                                     `(font-lock-face ,prefix-face))
                                    `(occur-prefix t mouse-face (highlight)
                                      ;; Allow insertion of text at
                                      ;; the end of the prefix (for
@@ -1423,7 +1457,9 @@ See also `multi-occur'."
                             ;; of multi-line matches.
                             (replace-regexp-in-string
                              "\n"
-                             "\n       :"
+                             (if prefix-face
+                                 (propertize "\n       :" 'font-lock-face prefix-face)
+                               "\n       :")
                              match-str)
                             ;; Add marker at eol, but no mouse props.
                             (propertize "\n" 'occur-target marker)))
@@ -1434,7 +1470,8 @@ See also `multi-occur'."
                              ;; The complex multi-line display style.
                              (setq ret (occur-context-lines
                                         out-line nlines keep-props begpt endpt
-                                        lines prev-lines prev-after-lines))
+                                        lines prev-lines prev-after-lines
+                                        prefix-face))
                              ;; Set first elem of the returned list to `data',
                              ;; and the second elem to `prev-after-lines'.
                              (setq prev-after-lines (nth 1 ret))
@@ -1458,7 +1495,7 @@ See also `multi-occur'."
                (when prev-after-lines
                  (with-current-buffer out-buf
                    (insert (apply #'concat (occur-engine-add-prefix
-                                            prev-after-lines)))))))
+                                            prev-after-lines prefix-face)))))))
            (when (not (zerop matches)) ;; is the count zero?
              (setq globalcount (+ globalcount matches))
              (with-current-buffer out-buf
@@ -1513,10 +1550,13 @@ See also `multi-occur'."
        str)
     (buffer-substring-no-properties beg end)))
 
-(defun occur-engine-add-prefix (lines)
+(defun occur-engine-add-prefix (lines &optional prefix-face)
   (mapcar
    #'(lambda (line)
-       (concat "       :" line "\n"))
+       (concat (if prefix-face
+                  (propertize "       :" 'font-lock-face prefix-face)
+                "       :")
+              line "\n"))
    lines))
 
 (defun occur-accumulate-lines (count &optional keep-props pt)
@@ -1545,7 +1585,8 @@ See also `multi-occur'."
 ;; Generate a list of lines, add prefixes to all but OUT-LINE,
 ;; then concatenate them all together.
 (defun occur-context-lines (out-line nlines keep-props begpt endpt
-                                    lines prev-lines prev-after-lines)
+                                    lines prev-lines prev-after-lines
+                                    &optional prefix-face)
   ;; Find after- and before-context lines of the current match.
   (let ((before-lines
         (nreverse (cdr (occur-accumulate-lines
@@ -1585,10 +1626,13 @@ See also `multi-occur'."
      ;; Return a list where the first element is the output line.
      (apply #'concat
            (append
-            (and prev-after-lines
-                 (occur-engine-add-prefix prev-after-lines))
-            (and separator (list separator))
-            (occur-engine-add-prefix before-lines)
+            (if prev-after-lines
+                (occur-engine-add-prefix prev-after-lines prefix-face))
+            (if separator
+                (list (if prefix-face
+                          (propertize separator 'font-lock-face prefix-face)
+                        separator)))
+            (occur-engine-add-prefix before-lines prefix-face)
             (list out-line)))
      ;; And the second element is the list of context after-lines.
      (if (> nlines 0) after-lines))))