[Emacs-diffs] master 04ef947 1/3: Allow major-modes full control over quoting nested comments

[Ivan Andrus]

branch: master
commit 04ef947705c1b4c1742f539c0299b1f3665ca504
Author: Ivan Andrus <address@hidden>
Commit: Ivan Andrus <address@hidden>

    Allow major-modes full control over quoting nested comments
    
    * newcomment.el (comment-quote-nested-function): New variable.
    (comment-quote-nested-default): New function.
    (comment-quote-nested): Use `comment-quote-nested-function'.
---
 lisp/newcomment.el |   66 ++++++++++++++++++++++++++++++++++-----------------
 1 files changed, 44 insertions(+), 22 deletions(-)

diff --git a/lisp/newcomment.el b/lisp/newcomment.el
index 7df05a0..765e60a 100644
--- a/lisp/newcomment.el
+++ b/lisp/newcomment.el
@@ -179,6 +179,11 @@ comments always start in column zero.")
   "Non-nil if nested comments should be quoted.
 This should be locally set by each major mode if needed.")
 
+(defvar comment-quote-nested-function #'comment-quote-nested-default
+  "Function to quote nested comments in a region.
+It takes the same arguments as `comment-quote-nested-default',
+and is called with the buffer narrowed to a single comment.")
+
 (defvar comment-continue nil
   "Continuation string to insert for multiline comments.
 This string will be added at the beginning of each line except the very
@@ -412,28 +417,45 @@ function should first call this function explicitly."
 If UNP is non-nil, unquote nested comment markers."
   (setq cs (comment-string-strip cs t t))
   (setq ce (comment-string-strip ce t t))
-  (when (and comment-quote-nested (> (length ce) 0))
-    (let ((re (concat (comment-quote-re ce unp)
-                     "\\|" (comment-quote-re cs unp))))
-      (goto-char (point-min))
-      (while (re-search-forward re nil t)
-       (goto-char (match-beginning 0))
-       (forward-char 1)
-       (if unp (delete-char 1) (insert "\\"))
-       (when (= (length ce) 1)
-         ;; If the comment-end is a single char, adding a \ after that
-         ;; "first" char won't deactivate it, so we turn such a CE
-         ;; into !CS.  I.e. for pascal, we turn } into !{
-         (if (not unp)
-             (when (string= (match-string 0) ce)
-               (replace-match (concat "!" cs) t t))
-           (when (and (< (point-min) (match-beginning 0))
-                      (string= (buffer-substring (1- (match-beginning 0))
-                                                 (1- (match-end 0)))
-                               (concat "!" cs)))
-             (backward-char 2)
-             (delete-char (- (match-end 0) (match-beginning 0)))
-             (insert ce))))))))
+  (when (and comment-quote-nested
+            comment-quote-nested-function
+            (> (length ce) 0))
+    (funcall comment-quote-nested-function cs ce unp)))
+
+(defun comment-quote-nested-default (cs ce unp)
+  "Quote comment delimiters in the buffer.
+It expects to be called with the buffer narrowed to a single comment.
+It is used as a default for `comment-quote-nested-function'.
+
+The arguments CS and CE are regular expressions matching comment
+starting and ending delimiters respectively.
+
+If UNP is non-nil, comments are unquoted instead.
+
+To quote the delimiters, a \\ is inserted after the first
+character of CS or CE.  If CE is a single character it will
+change CE into !CS."
+  (let ((re (concat (comment-quote-re ce unp)
+                   "\\|" (comment-quote-re cs unp))))
+    (goto-char (point-min))
+    (while (re-search-forward re nil t)
+      (goto-char (match-beginning 0))
+      (forward-char 1)
+      (if unp (delete-char 1) (insert "\\"))
+      (when (= (length ce) 1)
+       ;; If the comment-end is a single char, adding a \ after that
+       ;; "first" char won't deactivate it, so we turn such a CE
+       ;; into !CS.  I.e. for pascal, we turn } into !{
+       (if (not unp)
+           (when (string= (match-string 0) ce)
+             (replace-match (concat "!" cs) t t))
+         (when (and (< (point-min) (match-beginning 0))
+                    (string= (buffer-substring (1- (match-beginning 0))
+                                               (1- (match-end 0)))
+                             (concat "!" cs)))
+           (backward-char 2)
+           (delete-char (- (match-end 0) (match-beginning 0)))
+           (insert ce)))))))
 
 ;;;;
 ;;;; Navigation