Re: History for query replace pairs

[Tom <adatgyujto@gmail.com>]

[-- Attachment #1.1: Type: text/plain, Size: 1072 bytes --]

On Sun, Aug 10, 2014 at 7:59 AM, Tom <adatgyujto@gmail.com> wrote:

>
>
> Yes, that would be the full realization of the idea.
> Being able to select from FROM -> TO history pairs and quickly edit
> them in-place if  needed.
>
> So the current FROM input field should provide access to  previous
> FROM -> TO pairs and handle the case when such a pair is
> inputted instead of a simple FROM string.
>
>
I created a quick proof of concept implementation. It changes the behavior
of the arrow keys for the query-replace(-regexp) FROM prompt. You can stll
access the original behavior with M-p/n.

So when you start a query-replace and press the up arrow then
search/replace history is rendered as FROM -> TO pairs.  The -> marker is
highlighted and intangible, the cursor jumps over it and you are free to
edit the search/replace string. If you submit a FROM->TO pair from the FROM
input field with RET then the replacement is started immediately. If you
submit a simple string (without the marker) then it behaves as usual and
asks for a TO string.

See the attached file.

[-- Attachment #1.2: Type: text/html, Size: 1798 bytes --]

[-- Attachment #2: hist.el --]
[-- Type: application/octet-stream, Size: 3620 bytes --]

(defvar histpairs-history nil)

(defvar histpairs-history-current nil)


(defun histpairs-query-replace-p ()
  (string-match "Query replace\\( regexp\\)?\\( (\\|:\\)" (minibuffer-prompt)))


(defun histpairs-update-history-if-necessary ()
  (unless (eq (cdr histpairs-history) command-history)
    (setq histpairs-history
          (cons 
           (delete-if 'null 
                      (mapcar
                       (lambda (item)
                         (if (or (eq (car item) 'query-replace)
                                 (eq (car item) 'query-replace-regexp))
                             (cons (second item) (third item))))
                       command-history))
           command-history))))


(defun histpairs-update-minibuffer ()
  (delete-minibuffer-contents)
  (insert (caar histpairs-history-current)
          (propertize " -> " 'face 'highlight 
                      'intangible t 'rear-nonsticky t)

          (if (stringp (cdar histpairs-history-current))
              (cdar histpairs-history-current)
            (concat "can't handle this history element yet, "
                    "probably a regexp lisp expression"))))
  

(defun histpairs-previous-history-element (n)
  (interactive "p")
  (if (not (histpairs-query-replace-p))
      (previous-history-element n)

    (histpairs-update-history-if-necessary)

    (if (not histpairs-history-current)
        (setq histpairs-history-current (car histpairs-history))

      (setq histpairs-history-current (cdr histpairs-history-current)))
      

    (if (not histpairs-history-current)
        (message "No previous element.")

      (histpairs-update-minibuffer))))


(defun histpairs-next-history-element (n)
  (interactive "p")
  (if (not (histpairs-query-replace-p))
      (next-history-element n)

    (histpairs-update-history-if-necessary)

    (if histpairs-history-current
        (let ((items (car histpairs-history)))
          (while (and items
                      (not (eq (cdr items) histpairs-history-current)))
            (setq items (cdr items)))
          (setq histpairs-history-current items)))

    (if (not histpairs-history-current)
        (message "No next element.")

      (histpairs-update-minibuffer))))


(defun histpairs-finish ()
  (interactive)
  (if (not (histpairs-query-replace-p))
      (exit-minibuffer)

    (setq histpairs-history-current nil)

    (let ((pos (next-single-property-change 0 'intangible
                                            (minibuffer-contents))))
      (if (not pos)
          (exit-minibuffer)  ;; normal execution
        
        (if (get-text-property 0 'intangible (minibuffer-contents))
            (message "FROM is empty.")

          (let* ((end (next-single-property-change pos 'intangible
                                                   (minibuffer-contents)))
                 (from (substring (minibuffer-contents) 0 pos))
                 (to (if end
                         (substring (minibuffer-contents) end)
                       "")))
            (delete-minibuffer-contents)
            (insert from)

            (push 'return unread-command-events)
            (dolist (c (nreverse (string-to-list to)))
              (push c unread-command-events))

            (exit-minibuffer)))))))



(define-key minibuffer-local-map
  (kbd "<up>") 'histpairs-previous-history-element)
(define-key minibuffer-local-map
  (kbd "<down>") 'histpairs-next-history-element)
(define-key minibuffer-local-map
  (kbd "<return>") 'histpairs-finish)