[Emacs-diffs] master 99de04e: Use text properties to save search parameters. (Bug#22479)

[Juri Linkov]

branch: master
commit 99de04e6a84dbc93aab479666af126c8fb109b95
Author: Juri Linkov <address@hidden>
Commit: Juri Linkov <address@hidden>

    Use text properties to save search parameters.  (Bug#22479)
    
    * lisp/isearch.el (isearch-update-ring): Call isearch-string-propertize.
    Delete duplicates with possibly different text properties.
    (isearch-string-propertize)
    (isearch-update-from-string-properties): New functions.
    (with-isearch-suspended, isearch-ring-adjust1):
    Call isearch-update-from-string-properties.
    (isearch-edit-string): Let-bind minibuffer-allow-text-properties to t.
    (isearch-query-replace): Use propertized isearch-string.
    (isearch--lax-regexp-function-p): Simplify.
    
    * lisp/replace.el (query-replace-descr): Rewrite to keep text properties
    non-destructively in the replacement string.
    (query-replace--split-string): Don't remove text properties
    by substring-no-properties.
    (query-replace-read-args): Try to get isearch-regexp-function
    from text-properties.
    (perform-replace): Display parameters in the replacement message.
    
    * lisp/desktop.el (desktop--v2s): Check if text properties are unreadable.
    (Bug#30786)
---
 lisp/desktop.el | 10 ++++++----
 lisp/isearch.el | 53 ++++++++++++++++++++++++++++++++++++++---------------
 lisp/replace.el | 36 +++++++++++++++++++++++++++++-------
 3 files changed, 73 insertions(+), 26 deletions(-)

diff --git a/lisp/desktop.el b/lisp/desktop.el
index 55ec71c..3e1ba20 100644
--- a/lisp/desktop.el
+++ b/lisp/desktop.el
@@ -841,10 +841,12 @@ QUOTE may be `may' (value may be quoted),
     ((or (numberp value) (null value) (eq t value) (keywordp value))
      (cons 'may value))
     ((stringp value)
-     (let ((copy (copy-sequence value)))
-       (set-text-properties 0 (length copy) nil copy)
-       ;; Get rid of text properties because we cannot read them.
-       (cons 'may copy)))
+     ;; Get rid of unreadable text properties.
+     (if (condition-case nil (read (format "%S" value)) (error nil))
+         (cons 'may value)
+       (let ((copy (copy-sequence value)))
+         (set-text-properties 0 (length copy) nil copy)
+         (cons 'may copy))))
     ((symbolp value)
      (cons 'must value))
     ((vectorp value)
diff --git a/lisp/isearch.el b/lisp/isearch.el
index e006694..8519373 100644
--- a/lisp/isearch.el
+++ b/lisp/isearch.el
@@ -1126,10 +1126,29 @@ NOPUSH is t and EDIT is t."
 (defun isearch-update-ring (string &optional regexp)
   "Add STRING to the beginning of the search ring.
 REGEXP if non-nil says use the regexp search ring."
-  (add-to-history
-   (if regexp 'regexp-search-ring 'search-ring)
-   string
-   (if regexp regexp-search-ring-max search-ring-max)))
+  (let ((history-delete-duplicates t))
+    (add-to-history
+     (if regexp 'regexp-search-ring 'search-ring)
+     (isearch-string-propertize string)
+     (if regexp regexp-search-ring-max search-ring-max)
+     t)))
+
+(defun isearch-string-propertize (string &optional properties)
+  "Add isearch properties to the isearch string."
+  (unless properties
+    (setq properties `(isearch-case-fold-search ,isearch-case-fold-search))
+    (unless isearch-regexp
+      (setq properties (append properties `(isearch-regexp-function 
,isearch-regexp-function)))))
+  (apply 'propertize string properties))
+
+(defun isearch-update-from-string-properties (string)
+  "Update isearch properties from the isearch string"
+  (when (memq 'isearch-case-fold-search (text-properties-at 0 string))
+    (setq isearch-case-fold-search
+         (get-text-property 0 'isearch-case-fold-search string)))
+  (when (memq 'isearch-regexp-function (text-properties-at 0 string))
+    (setq isearch-regexp-function
+         (get-text-property 0 'isearch-regexp-function string))))
 
 
 ;; The search status structure and stack.
@@ -1335,6 +1354,8 @@ You can update the global isearch variables by setting 
new values to
                  multi-isearch-file-list multi-isearch-file-list-new
                  multi-isearch-buffer-list multi-isearch-buffer-list-new)
 
+            (isearch-update-from-string-properties isearch-string)
+
            ;; Restore the minibuffer message before moving point.
             (funcall (or isearch-message-function #'isearch-message) nil t)
 
@@ -1401,7 +1422,9 @@ The following additional command keys are active while 
editing.
          (history-add-new-input nil)
          ;; Binding minibuffer-history-symbol to nil is a work-around
          ;; for some incompatibility with gmhist.
-         (minibuffer-history-symbol))
+         (minibuffer-history-symbol)
+         ;; Search string might have meta information on text properties.
+         (minibuffer-allow-text-properties t))
      (setq isearch-new-string
           (read-from-minibuffer
            (isearch-message-prefix nil isearch-nonincremental)
@@ -1826,7 +1849,9 @@ replacements from Isearch is `M-s w ... M-%'."
        ;; `exit-recursive-edit' in `isearch-done' that terminates
        ;; the execution of this command when it is non-nil.
        ;; We call `exit-recursive-edit' explicitly at the end below.
-       (isearch-recursive-edit nil))
+       (isearch-recursive-edit nil)
+       (isearch-string-propertized
+         (isearch-string-propertize isearch-string)))
     (isearch-done nil t)
     (isearch-clean-overlays)
     (if (and isearch-other-end
@@ -1839,12 +1864,12 @@ replacements from Isearch is `M-s w ... M-%'."
                         (< (mark) (point))))))
         (goto-char isearch-other-end))
     (set query-replace-from-history-variable
-         (cons isearch-string
+         (cons isearch-string-propertized
                (symbol-value query-replace-from-history-variable)))
     (perform-replace
-     isearch-string
+     isearch-string-propertized
      (query-replace-read-to
-      isearch-string
+      isearch-string-propertized
       (concat "Query replace"
               (isearch--describe-regexp-mode (or delimited 
isearch-regexp-function) t)
              (if backward " backward" "")
@@ -2552,7 +2577,8 @@ Search is updated accordingly."
                      length)))
       (setq isearch-string (nth yank-pointer ring)
            isearch-message (mapconcat 'isearch-text-char-description
-                                      isearch-string "")))))
+                                      isearch-string ""))
+      (isearch-update-from-string-properties isearch-string))))
 
 (defun isearch-ring-adjust (advance)
   ;; Helper for isearch-ring-advance and isearch-ring-retreat
@@ -2768,11 +2794,8 @@ Can be changed via `isearch-search-fun-function' for 
special needs."
 
 (defun isearch--lax-regexp-function-p ()
   "Non-nil if next regexp-function call should be lax."
-  (not (or isearch-nonincremental
-           (null (car isearch-cmds))
-           (eq (length isearch-string)
-               (length (isearch--state-string
-                        (car isearch-cmds)))))))
+  (or (memq this-command '(isearch-printing-char isearch-del-char))
+      isearch-yank-flag))
 
 (defun isearch-search-fun-default ()
   "Return default functions to use for the search."
diff --git a/lisp/replace.el b/lisp/replace.el
index 7f3541d..0e72339 100644
--- a/lisp/replace.el
+++ b/lisp/replace.el
@@ -147,15 +147,26 @@ is highlighted lazily using isearch lazy highlighting (see
 See `replace-regexp' and `query-replace-regexp-eval'.")
 
 (defun query-replace-descr (string)
-  (mapconcat 'isearch-text-char-description string ""))
+  (setq string (copy-sequence string))
+  (dotimes (i (length string) string)
+    (let ((c (aref string i)))
+      (cond
+       ((< c ?\s) (add-text-properties
+                   i (1+ i)
+                   `(display ,(propertize (format "^%c" (+ c 64)) 'face 
'escape-glyph))
+                   string))
+       ((= c ?\^?) (add-text-properties
+                   i (1+ i)
+                    `(display ,(propertize "^?" 'face 'escape-glyph))
+                    string))))))
 
 (defun query-replace--split-string (string)
   "Split string STRING at a substring with property `separator'."
   (let* ((length (length string))
          (split-pos (text-property-any 0 length 'separator t string)))
     (if (not split-pos)
-        (substring-no-properties string)
-      (cons (substring-no-properties string 0 split-pos)
+        string
+      (cons (substring string 0 split-pos)
             (substring-no-properties
              string (or (text-property-not-all
                          (1+ split-pos) length 'separator t string)
@@ -301,7 +312,9 @@ the original string if not."
         (to (if (consp from) (prog1 (cdr from) (setq from (car from)))
               (query-replace-read-to from prompt regexp-flag))))
     (list from to
-         (and current-prefix-arg (not (eq current-prefix-arg '-)))
+         (or (and current-prefix-arg (not (eq current-prefix-arg '-)))
+              (and (memq 'isearch-regexp-function (text-properties-at 0 from))
+                   (get-text-property 0 'isearch-regexp-function from)))
          (and current-prefix-arg (eq current-prefix-arg '-)))))
 
 (defun query-replace (from-string to-string &optional delimited start end 
backward region-noncontiguous-p)
@@ -2379,8 +2392,17 @@ characters."
          (message
           (if query-flag
               (apply 'propertize
-                     (substitute-command-keys
-                      "Query replacing %s with %s: 
(\\<query-replace-map>\\[help] for help) ")
+                     (concat "Query replacing "
+                             (if backward "backward " "")
+                             (if delimited-flag
+                                 (or (and (symbolp delimited-flag)
+                                          (get delimited-flag
+                                               'isearch-message-prefix))
+                                     "word ") "")
+                             (if regexp-flag "regexp " "")
+                             "%s with %s: "
+                             (substitute-command-keys
+                              "(\\<query-replace-map>\\[help] for help) "))
                      minibuffer-prompt-properties))))
 
     ;; Unless a single contiguous chunk is selected, operate on multiple 
chunks.
@@ -2598,13 +2620,13 @@ characters."
                         (with-output-to-temp-buffer "*Help*"
                           (princ
                            (concat "Query replacing "
+                                   (if backward "backward " "")
                                    (if delimited-flag
                                        (or (and (symbolp delimited-flag)
                                                 (get delimited-flag
                                                       'isearch-message-prefix))
                                            "word ") "")
                                    (if regexp-flag "regexp " "")
-                                   (if backward "backward " "")
                                    from-string " with "
                                    next-replacement ".\n\n"
                                    (substitute-command-keys