Skip to content

Instantly share code, notes, and snippets.

@thierryvolpiatto
Created January 20, 2017 15:32
Show Gist options
  • Save thierryvolpiatto/dede9905d511dc8843fbcb9437f4a40f to your computer and use it in GitHub Desktop.
Save thierryvolpiatto/dede9905d511dc8843fbcb9437f4a40f to your computer and use it in GitHub Desktop.
query-replace separator
(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))))))))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment