(defun query-replace--split-string (string)
  "Split string STRING at a character with property `separator'"
  (let* ((length (length string))
         (split-pos (text-property-any 0 length 'separator t string)))
    (cond (split-pos
           (cl-assert (not (text-property-any
                            (1+ split-pos) length 'separator t string)))
           (cons (substring-no-properties string 0 split-pos)
            (substring-no-properties string (1+ split-pos) length)))
          ((string-match query-replace-from-to-separator string)
           (cons (substring-no-properties string 0 (match-beginning 0))
                 (substring-no-properties string (match-end 0) length)))
          (t (substring-no-properties string)))))

(defun query-replace-read-from (prompt regexp-flag)
  "Query and return the `from' argument of a query-replace operation.
The return value can also be a pair (FROM . TO) indicating that the user
wants to replace FROM with TO."
  (if query-replace-interactive
      (car (if regexp-flag regexp-search-ring search-ring))
    (let ((sep-char (replace-regexp-in-string
                     " " "" query-replace-from-to-separator)))
      (when (stringp query-replace-from-to-separator)
        (setq query-replace-from-to-separator
              (propertize (if (char-displayable-p (string-to-char sep-char))
                              query-replace-from-to-separator
                            " -> ")
                          'face 'minibuffer-prompt)))
      (let* ((history-add-new-input nil)
             (separator
              (if (and query-replace-from-to-separator
                       (> (string-bytes sep-char) (length sep-char)))
                  (propertize "\0"
                              'display query-replace-from-to-separator
                              'separator t)
                (propertize query-replace-from-to-separator 'separator t)))
             (minibuffer-history
              (append
               (when separator
                 (mapcar (lambda (from-to)
                           (concat (query-replace-descr (car from-to))
                                   separator
                                   (query-replace-descr (cdr from-to))))
                         query-replace-defaults))
               (symbol-value query-replace-from-history-variable)))
             (minibuffer-allow-text-properties t) ; separator uses text-properties
             (prompt
              (cond ((and query-replace-defaults separator)
                     (format "%s (default %s): " prompt (car minibuffer-history)))
                    (query-replace-defaults
                     (format "%s (default %s -> %s): " prompt
                             (query-replace-descr (caar query-replace-defaults))
                             (query-replace-descr (cdar query-replace-defaults))))
                    (t (format "%s: " prompt))))
             (from
              ;; The save-excursion here is in case the user marks and copies
              ;; a region in order to specify the minibuffer input.
              ;; That should not clobber the region for the query-replace itself.
              (save-excursion
                (minibuffer-with-setup-hook
                    (lambda ()
                      (setq-local text-property-default-nonsticky
                                  (cons '(separator . t) text-property-default-nonsticky)))
                  (if regexp-flag
                      (read-regexp prompt nil 'minibuffer-history)
                    (read-from-minibuffer
                     prompt nil nil nil nil (car search-ring) t)))))
             (to))
        (if (and (zerop (length from)) query-replace-defaults)
            (cons (caar query-replace-defaults)
                  (query-replace-compile-replacement
                   (cdar query-replace-defaults) regexp-flag))
          (setq from (query-replace--split-string from))
          (when (consp from) (setq to (cdr from) from (car from)))
          (add-to-history query-replace-from-history-variable from nil t)
          ;; Warn if user types \n or \t, but don't reject the input.
          (and regexp-flag
               (string-match "\\(\\`\\|[^\\]\\)\\(\\\\\\\\\\)*\\(\\\\[nt]\\)" from)
               (let ((match (match-string 3 from)))
                 (cond
                   ((string= match "\\n")
                    (message "Note: `\\n' here doesn't match a newline; to do that, type C-q C-j instead"))
                   ((string= match "\\t")
                    (message "Note: `\\t' here doesn't match a tab; to do that, just type TAB")))
                 (sit-for 2)))
          (if (not to)
              from
            (add-to-history query-replace-to-history-variable to nil t)
            (add-to-history 'query-replace-defaults (cons from to) nil t)
            (cons from (query-replace-compile-replacement to regexp-flag))))))))