From 4d7390576b1fdc385e48ae9eab19f70c82643c0c Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Fri, 20 May 2022 03:24:30 +0200 Subject: [PATCH] Add a new command 'yank-in-context' * lisp/simple.el (escaped-string-quote): New variable. (yank-in-context): New command. (yank-in-context--transform): Helper function. * lisp/progmodes/sh-script.el (sh-mode): Set up an escaped-string-quote function. * lisp/progmodes/sql.el (sql-mode): Define escaped-string-quote. --- etc/NEWS | 4 ++ lisp/progmodes/sh-script.el | 5 ++ lisp/progmodes/sql.el | 1 + lisp/simple.el | 103 ++++++++++++++++++++++++++++++++++++ test/lisp/simple-tests.el | 34 ++++++++++++ 5 files changed, 147 insertions(+) diff --git a/etc/NEWS b/etc/NEWS index 6185c6ff6ab..26b9b19952b 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -2201,6 +2201,10 @@ the clipboard, and insert it into the buffer. ** New user option 'yank-transform-functions'. This function allows the user to alter the string to be inserted. +--- +** New command 'yank-in-context'. +This command tries to preserve string/comment syntax when yanking. + --- ** New function 'minibuffer-lazy-highlight-setup'. This function allows setting up the minibuffer so that lazy diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el index e48fa0668b5..8205218ce11 100644 --- a/lisp/progmodes/sh-script.el +++ b/lisp/progmodes/sh-script.el @@ -1543,6 +1543,11 @@ with your script for an edit-interpret-debug cycle." (add-hook 'completion-at-point-functions #'sh-completion-at-point-function nil t) (setq-local outline-regexp "###") + (setq-local escaped-string-quote + (lambda (terminator) + (if (eq terminator ?') + "'\\'" + "\\"))) ;; Parse or insert magic number for exec, and set all variables depending ;; on the shell thus determined. (sh-set-shell diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el index 7bb4fef0c09..8d259860901 100644 --- a/lisp/progmodes/sql.el +++ b/lisp/progmodes/sql.el @@ -4159,6 +4159,7 @@ must tell Emacs. Here's how to do that in your init file: (setq-local abbrev-all-caps 1) ;; Contains the name of database objects (setq-local sql-contains-names t) + (setq-local escaped-string-quote "'") (setq-local syntax-propertize-function (syntax-propertize-rules ;; Handle escaped apostrophes within strings. diff --git a/lisp/simple.el b/lisp/simple.el index 66e1b94f0f5..c80af7c37bb 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -60,6 +60,24 @@ value of 1 means that nothing is amalgamated.") (defgroup paren-matching nil "Highlight (un)matching of parens and expressions." :group 'matching) + +(defvar-local escaped-string-quote "\\" + "String to insert before a string quote character in a string to escape it. +This is typically a backslash (in most languages): + + \\='foo\\\\='bar\\=' + \"foo\\\"bar\" + +But in SQL, for instance, it's \"\\='\": + + \\='foo\\='\\='bar\\=' + +This can also be a function, which is called with the string +terminator as the argument, and should return a string to be +used as the escape. + +This variable is used by the `yank-in-context' command.") + ;;; next-error support framework @@ -6013,6 +6031,9 @@ Properties listed in `yank-handled-properties' are processed, then those listed in `yank-excluded-properties' are discarded. STRING will be run through `yank-transform-functions'. +`yank-in-context' is a command that uses this mechanism to +provide a `yank' alternative that conveniently preserves +string/comment syntax. If STRING has a non-nil `yank-handler' property anywhere, the normal insert behavior is altered, and instead, for each contiguous @@ -6064,6 +6085,88 @@ With ARG, rotate that many kills forward (or backward, if negative)." (interactive "p") (current-kill arg)) +(defun yank-in-context (&optional arg) + "Insert the last stretch of killed text while preserving syntax. +In particular, if point is inside a string, any quote characters +in the killed text will be quoted, so that the string remains a +valid string. + +If point is inside a comment, ensure that the inserted text is +also marked as a comment. + +This command otherwise behaves as `yank'. See that command for +explanation of ARG. + +This function uses the `escaped-string-quote' buffer-local +variable to determine how strings should be escaped." + (interactive "*P") + (let ((yank-transform-functions (cons #'yank-in-context--transform + yank-transform-functions))) + (yank arg))) + +(defun yank-in-context--transform (string) + (let ((ppss (syntax-ppss))) + (cond + ;; We're in a string. + ((ppss-string-terminator ppss) + (string-replace + (string (ppss-string-terminator ppss)) + (concat (if (functionp escaped-string-quote) + (funcall escaped-string-quote + (ppss-string-terminator ppss)) + escaped-string-quote) + (string (ppss-string-terminator ppss))) + string)) + ;; We're in a comment. + ((or (ppss-comment-depth ppss) + (and (bolp) + (not (eobp)) + ;; If we're in the middle of a bunch of commented text, + ;; we probably want to be commented. This is quite DWIM. + (or (bobp) + (save-excursion + (forward-line -1) + (forward-char 1) + (ppss-comment-depth (syntax-ppss)))) + (ppss-comment-depth + (setq ppss (save-excursion + (forward-char 1) + (syntax-ppss)))))) + (cond + ((and (eq (ppss-comment-depth ppss) t) + (> (length comment-end) 0) + (string-search comment-end string)) + (user-error "Can't insert a string containing a comment terminator in a comment")) + ;; If this is a comment syntax that has an explicit end, then + ;; we can just insert as is. + ((> (length comment-end) 0) string) + ;; Line-based comment formats. + ((or (string-search "\n" string) + (bolp)) + (let ((mode major-mode) + (bolp (bolp)) + (eolp (eolp)) + (comment-style 'plain)) + (with-temp-buffer + (funcall mode) + (insert string) + (when (string-match-p "\n\\'" string) + (cond + ((not eolp) (delete-char -1)) + (bolp (insert "\n")))) + (comment-normalize-vars) + (comment-region-default-1 + (if bolp + (point-min) + (save-excursion + (goto-char (point-min)) + (forward-line 1) + (point))) + (point-max) nil t) + (buffer-string)))) + (t string))) + (t string)))) + (defvar read-from-kill-ring-history) (defun read-from-kill-ring (prompt) "Read a `kill-ring' entry using completion and minibuffer history. diff --git a/test/lisp/simple-tests.el b/test/lisp/simple-tests.el index dcab811bb5a..437c62f61d8 100644 --- a/test/lisp/simple-tests.el +++ b/test/lisp/simple-tests.el @@ -971,5 +971,39 @@ See Bug#21722." ;;(should (= (length (delq nil (undo-make-selective-list 5 9))) 0)) (should (= (length (delq nil (undo-make-selective-list 6 9))) 0)))) +(ert-deftest test-yank-in-context () + (should + (equal + (with-temp-buffer + (sh-mode) + (insert "echo \"foo\"") + (kill-new "\"bar\"") + (goto-char 8) + (yank-in-context) + (buffer-string)) + "echo \"f\\\"bar\\\"oo\"")) + + (should + (equal + (with-temp-buffer + (sh-mode) + (insert "echo \"foo\"") + (kill-new "'bar'") + (goto-char 8) + (yank-in-context) + (buffer-string)) + "echo \"f'bar'oo\"")) + + (should + (equal + (with-temp-buffer + (sh-mode) + (insert "echo 'foo'") + (kill-new "'bar'") + (goto-char 8) + (yank-in-context) + (buffer-string)) + "echo 'f'\\''bar'\\''oo'"))) + (provide 'simple-test) ;;; simple-tests.el ends here -- 2.39.2