master 4d7390576b: Add a new command 'yank-in-context'

[Lars Ingebrigtsen]

branch: master
commit 4d7390576b1fdc385e48ae9eab19f70c82643c0c
Author: Lars Ingebrigtsen <larsi@gnus.org>
Commit: Lars Ingebrigtsen <larsi@gnus.org>

    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 6185c6ff6a..26b9b19952 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 e48fa0668b..8205218ce1 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 7bb4fef0c0..8d25986090 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 66e1b94f0f..c80af7c37b 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 dcab811bb5..437c62f61d 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