[elpa] externals/phps-mode 0deaca3: Comment and un-comment region now only acts on actual PHP code

[Christian Johansson]

branch: externals/phps-mode
commit 0deaca3f2cdf1664bf598bd8a0a34f87c99780ae
Author: Christian Johansson <address@hidden>
Commit: Christian Johansson <address@hidden>

    Comment and un-comment region now only acts on actual PHP code
---
 phps-mode-functions.el      | 221 ++++++++++++++++++++++++++++----------------
 phps-mode-test-functions.el |   8 +-
 2 files changed, 146 insertions(+), 83 deletions(-)

diff --git a/phps-mode-functions.el b/phps-mode-functions.el
index 5c858a8..9466f17 100644
--- a/phps-mode-functions.el
+++ b/phps-mode-functions.el
@@ -1225,91 +1225,154 @@
 
 (defun phps-mode-functions-comment-region (beg end &optional _arg)
   "Comment region from BEG to END with optional ARG."
-  (save-excursion
-    ;; Go to start of region
-    (goto-char beg)
-
-    (let ((end-line-number (line-number-at-pos end t))
-          (current-line-number (line-number-at-pos))
-          (first-line t))
-
-      ;; Does region start at beginning of line?
-      (if (not (= beg (line-beginning-position)))
-
-          ;; Use doc comment
-          (progn
-            (goto-char end)
-            (insert " */")
-            (goto-char beg)
+  ;; Iterate tokens from beginning to end and comment out all PHP code
+  (when-let ((tokens phps-mode-lexer-tokens))
+    (let ((token-comment-start nil)
+          (token-comment-end nil)
+          (in-token-comment nil)
+          (offset 0))
+      (dolist (token tokens)
+        (let ((token-label (car token))
+              (token-start (car (cdr token)))
+              (token-end (cdr (cdr token))))
+          (when (and (>= token-start beg)
+                     (<= token-end end))
+
+            (if in-token-comment
+                (cond
+                 ((or
+                   (equal token-label 'T_COMMENT)
+                   (equal token-label 'T_DOC_COMMENT)
+                   (equal token-label 'T_CLOSE_TAG))
+                  (setq in-token-comment nil))
+                 (t (setq token-comment-end token-end)))
+
+              ;; When we have a start and end of comment, comment it out
+              (when (and
+                     token-comment-start
+                     token-comment-end)
+                (let ((offset-comment-start (+ token-comment-start offset))
+                      (offset-comment-end))
+                  (save-excursion
+                    (goto-char offset-comment-start)
+                    (insert "/* "))
+                  (setq offset (+ offset 3))
+                  (setq offset-comment-end (+ token-comment-end offset))
+                  (save-excursion
+                    (goto-char offset-comment-end)
+                    (insert " */"))
+                  (setq offset (+ offset 3))
+                  (phps-mode-debug-message
+                   (message "Commented out %s-%s" offset-comment-start 
offset-comment-end)))
+                (setq token-comment-start nil)
+                (setq token-comment-end nil))
+
+              (cond
+               ((or
+                 (equal token-label 'T_INLINE_HTML)
+                 (equal token-label 'T_OPEN_TAG)
+                 (equal token-label 'T_OPEN_TAG_WITH_ECHO)))
+               (t
+                (phps-mode-debug-message
+                 (message "Comment should start at %s %s" token-label 
token-start))
+                (setq token-comment-start token-start)
+                (setq in-token-comment t)))))))
+
+      ;; When we have a start and end of comment, comment it out
+      (when (and
+             in-token-comment
+             token-comment-start
+             token-comment-end)
+        (let ((offset-comment-start (+ token-comment-start offset))
+              (offset-comment-end))
+          (save-excursion
+            (goto-char offset-comment-start)
             (insert "/* "))
+          (setq offset (+ offset 3))
+          (setq offset-comment-end (+ token-comment-end offset))
+          (save-excursion
+            (goto-char offset-comment-end)
+            (insert " */"))
+          (setq offset (+ offset 3))
+          (phps-mode-debug-message
+           (message "Commented out trailing %s-%s" offset-comment-start 
offset-comment-end)))
+        (setq token-comment-start nil)
+        (setq token-comment-end nil)))))
 
-        ;; Do this for every line in region
-        (while (or first-line
-                   (< current-line-number end-line-number))
-          (move-beginning-of-line nil)
+(defun phps-mode-functions-uncomment-region (beg end &optional _arg)
+  "Un-comment region from BEG to END with optional ARG."
+  ;; Iterate tokens from beginning to end and uncomment out all commented PHP 
code
+  (when-let ((tokens phps-mode-lexer-tokens))
+    (let ((offset 0))
+      (dolist (token tokens)
+        (let ((token-label (car token))
+              (token-start (car (cdr token)))
+              (token-end (cdr (cdr token))))
+          (when (and (>= token-start beg)
+                     (<= token-end end))
+            (when (or
+                   (equal token-label 'T_COMMENT)
+                   (equal token-label 'T_DOC_COMMENT))
 
-          (when first-line
-            (setq first-line nil))
+              (phps-mode-debug-message
+               (message "Un-comment comment at %s %s" token-label token-start 
token-end))
 
-          ;; Does this line contain something other than white-space?
-          (unless (eq (point) (line-end-position))
-            (insert "// ")
-            (move-end-of-line nil)
-            (insert ""))
+              (let ((offset-comment-start (+ token-start offset))
+                    (offset-comment-end))
 
-          (when (< current-line-number end-line-number)
-            (line-move 1))
-          (setq current-line-number (1+ current-line-number)))))))
+                (if (equal token-label 'T_DOC_COMMENT)
+                    (progn
+                      (phps-mode-debug-message
+                       (message "Un-comment doc comment at %s-%s" token-start 
token-end))
+                      (save-excursion
+                        (goto-char offset-comment-start)
+                        (delete-char 4))
+                      (setq offset (- offset 4))
+                      (setq offset-comment-end (+ token-end offset))
+                      (save-excursion
+                        (goto-char offset-comment-end)
+                        (delete-char -4))
+                      (setq offset (- offset 4)))
 
-(defun phps-mode-functions-uncomment-region (beg end &optional _arg)
-  "Comment region from BEG to END with optional ARG."
-  (save-excursion
-
-    ;; Go to start of region
-    (goto-char beg)
-
-    (let ((end-line-number (line-number-at-pos end t))
-          (current-line-number (line-number-at-pos))
-          (first-line t))
-
-      ;; Does region start at beginning of line?
-      (if (not (= beg (line-beginning-position)))
-          (progn
-            (goto-char end)
-            (backward-char 3)
-            (when (looking-at-p " \\*/")
-              (delete-char 3))
-
-            (goto-char beg)
-            (when (looking-at-p "// ")
-              (delete-char 3))
-            (when (looking-at-p "/\\* ")
-              (delete-char 3)))
-
-        ;; Do this for every line in region
-        (while (or first-line
-                   (< current-line-number end-line-number))
-          (move-beginning-of-line nil)
-
-          (when first-line
-            (setq first-line nil))
-
-          ;; Does this line contain something other than white-space?
-          (unless (>= (+ (point) 3) (line-end-position))
-            (when (looking-at-p "// ")
-              (delete-char 3))
-            (when (looking-at-p "/\\* ")
-              (delete-char 3))
-
-            (move-end-of-line nil)
-
-            (backward-char 3)
-            (when (looking-at-p " \\*/")
-              (delete-char 3)))
-
-          (when (< current-line-number end-line-number)
-            (line-move 1))
-          (setq current-line-number (1+ current-line-number)))))))
+                  (phps-mode-debug-message
+                   (message "Un-comment comment starting at %s" token-start))
+
+                  (cond
+
+                   ((string=
+                     (buffer-substring-no-properties offset-comment-start (+ 
offset-comment-start 1))
+                     "#")
+                    (save-excursion
+                      (goto-char offset-comment-start)
+                      (delete-char 1))
+                    (setq offset (- offset 1)))
+                   ((string=
+                     (buffer-substring-no-properties offset-comment-start (+ 
offset-comment-start 2))
+                     "//")
+                    (save-excursion
+                      (goto-char offset-comment-start)
+                      (delete-char 2))
+                    (setq offset (- offset 2)))
+                   (t
+                    (save-excursion
+                      (goto-char offset-comment-start)
+                      (delete-char 3))
+                    (setq offset (- offset 3))))
+
+                  
+                  (setq offset-comment-end (+ token-end offset))
+                  (if (string=
+                       (buffer-substring-no-properties (- offset-comment-end 
3) offset-comment-end)
+                       " */")
+                      (progn
+                        (phps-mode-debug-message
+                         (message "Un-comment comment ending at %s" token-end))
+                        (save-excursion
+                          (goto-char offset-comment-end)
+                          (delete-char -3))
+                        (setq offset (- offset 3)))
+                    (phps-mode-debug-message
+                     (message "Do not un-comment comment ending at %s" 
token-end))))))))))))
 
 (provide 'phps-mode-functions)
 
diff --git a/phps-mode-test-functions.el b/phps-mode-test-functions.el
index 73827d4..b30eb8d 100644
--- a/phps-mode-test-functions.el
+++ b/phps-mode-test-functions.el
@@ -949,21 +949,21 @@
    "Comment object-oriented file with bracket-less namespace, class that 
extends and implements and functions with optional arguments"
    (comment-region (point-min) (point-max))
    (let ((buffer-contents (buffer-substring-no-properties (point-min) 
(point-max))))
-     (should (equal buffer-contents "// <?php\n// namespace myNamespace;\n// 
class myClass extends myAbstract implements myInterface {\n//     public 
function myFunctionA($myArg = null) {}\n//     protected function 
myFunctionB($myArg = 'abc') {}\n// }\n"))))
+     (should (equal buffer-contents "<?php\n/* namespace myNamespace;\nclass 
myClass extends myAbstract implements myInterface {\n    public function 
myFunctionA($myArg = null) {}\n    protected function myFunctionB($myArg = 
'abc') {}\n} */\n"))))
 
   (phps-mode-test-with-buffer
    "<?php\nnamespace myNamespace;\nclass myClass extends myAbstract implements 
myInterface {\n    public function myFunctionA($myArg = null) {}\n    protected 
function myFunctionB($myArg = 'abc') {}\n}\n"
    "Comment part of object-oriented file with bracket-less namespace, class 
that extends and implements and functions with optional arguments"
    (comment-region 62 86)
    (let ((buffer-contents (buffer-substring-no-properties (point-min) 
(point-max))))
-     (should (equal buffer-contents "<?php\nnamespace myNamespace;\nclass 
myClass extends myAbstract/*  implements myInterface  */{\n    public function 
myFunctionA($myArg = null) {}\n    protected function myFunctionB($myArg = 
'abc') {}\n}\n"))))
+     (should (equal buffer-contents "<?php\nnamespace myNamespace;\nclass 
myClass extends myAbstract /* implements myInterface */ {\n    public function 
myFunctionA($myArg = null) {}\n    protected function myFunctionB($myArg = 
'abc') {}\n}\n"))))
 
   (phps-mode-test-with-buffer
-   "// <?php\n// namespace myNamespace;\n// class myClass extends myAbstract 
implements myInterface {\n//     public function myFunctionA($myArg = null) 
{}\n//     protected function myFunctionB($myArg = 'abc') {}\n// }\n"
+   "// <?php\n// namespace myNamespace;\n// class myClass extends myAbstract 
implements myInterface {\n//    public function myFunctionA($myArg = null) 
{}\n//    protected function myFunctionB($myArg = 'abc') {}\n//}\n"
    "Uncomment object-oriented file with bracket-less namespace, class that 
extends and implements and functions with optional arguments"
    (uncomment-region (point-min) (point-max))
    (let ((buffer-contents (buffer-substring-no-properties (point-min) 
(point-max))))
-     (should (equal buffer-contents "<?php\nnamespace myNamespace;\nclass 
myClass extends myAbstract implements myInterface {\n    public function 
myFunctionA($myArg = null) {}\n    protected function myFunctionB($myArg = 
'abc') {}\n}\n"))))
+     (should (equal buffer-contents "// <?php\n namespace myNamespace;\n class 
myClass extends myAbstract implements myInterface {\n    public function 
myFunctionA($myArg = null) {}\n    protected function myFunctionB($myArg = 
'abc') {}\n}\n"))))
 
   (phps-mode-test-with-buffer
    "<?php\nnamespace myNamespace;\nclass myClass extends myAbstract/*  
implements myInterface  */{\n    public function myFunctionA($myArg = null) 
{}\n    protected function myFunctionB($myArg = 'abc') {}\n}\n"