Make going forward defun work correctly with comments

Author: czipperz

haskell-decl-scan.el

@@ -351,6 +351,43 @@ there."
   (interactive)
   (haskell-ds-move-to-decl nil (haskell-ds-bird-p) nil))
 
+(defun haskell-ds-comment-p
+    (&optional
+     pt)
+  "Test if the cursor is on whitespace or a comment.
+
+`PT' defaults to `(point)'"
+  ;; ensure result is `t' or `nil' instead of just truthy
+  (if (or
+       ;; is cursor on whitespace
+       (let ((f (following-char)))
+         (or (= f ?\t)
+             (= f ?\n)
+             (= f ? )))
+       ;; http://emacs.stackexchange.com/questions/14269/how-to-detect-if-the-point-is-within-a-comment-area
+       ;; is cursor at begging, inside, or end of comment
+       (let ((fontfaces (get-text-property (or pt
+                                               (point)) 'face)))
+         (when (not (listp fontfaces))
+           (setf fontfaces (list fontfaces)))
+         (delq nil (mapcar
+                    #'(lambda (f)
+                        (or (eq f 'font-lock-comment-face)
+                            (eq f 'font-lock-comment-delimiter-face)))
+                    fontfaces))))
+      t
+    nil))
+
+(defun haskell-ds-line-commented-p ()
+  "Tests if all characters from `point' to `end-of-line' pass
+`haskell-ds-comment-p'"
+  (let ((r t))
+    (while (and r (not (eolp)))
+      (if (not (haskell-ds-comment-p))
+          (setq r nil))
+      (forward-char))
+    r))
+
 (defun haskell-ds-forward-decl ()
   "Move forward to the first character that starts a top-level
 declaration.  As `haskell-ds-backward-decl' but forward."
@@ -380,7 +417,7 @@ declaration.  As `haskell-ds-backward-decl' but forward."
           (haskell-ds-move-to-decl t (haskell-ds-bird-p) nil))
       ;; Then go back to end of current
       (forward-line -1)
-      (while (and (eolp)
+      (while (and (haskell-ds-line-commented-p)
                   ;; prevent infinite loop
                   (not (= (point)
                           (point-min))))

tests/haskell-decl-scan-tests.el

@@ -31,6 +31,30 @@
 (require 'haskell-decl-scan)
 (require 'haskell-test-utils)
 
+(ert-deftest haskell-ds-line-commented-p-1 ()
+  "All lines in this buffer should count as comments"
+  (with-temp-buffer
+    (haskell-mode)
+    (insert-lines "" "--hi" "  -- hi\t " "" "{-hi-}" " \t{-hi-}  ")
+    (font-lock-fontify-buffer)
+    (goto-char (point-min))
+
+    (while (not (eobp))
+      (should (haskell-ds-line-commented-p))
+      (forward-line))))
+
+(ert-deftest haskell-ds-comment-p-1 ()
+  "All characters in this buffer should count as comments"
+  (with-temp-buffer
+    (haskell-mode)
+    (insert-lines "" "--hi" "  -- hi\t " "" "{-hi-}" " \t{-hi-}  ")
+    (font-lock-fontify-buffer)
+    (goto-char (point-min))
+
+    (while (not (bobp))
+      (should (haskell-ds-comment-p))
+      (forward-char))))
+
 (ert-deftest haskell-ds-backward-decl-1 ()
   "Test running haskell-ds-backward-decl"
   (with-temp-buffer
@@ -44,6 +68,27 @@
     (should-not (haskell-ds-backward-decl))
     (should (= (point-min) (point)))))
 
+(ert-deftest haskell-ds-backward-decl-2-commented ()
+  "Test running haskell-ds-backward-decl"
+  (with-temp-buffer
+    (haskell-mode)
+    (insert-lines "" "-- documentation" "fun :: Int -> Int"
+                  "" "{- comment -}" "fun = id"
+                  "" "  -- space comment" "f2 :: Int"
+                  "" " {- trailing -} \t" "f2 = 3"
+                  "" "" "")
+    (font-lock-fontify-buffer)
+    (goto-char (point-max))
+
+    (should (haskell-ds-backward-decl))
+    (should (looking-at-p "f2 :: Int"))
+
+    (should (haskell-ds-backward-decl))
+    (should (looking-at-p "fun :: Int -> Int"))
+
+    (should-not (haskell-ds-backward-decl))
+    (should (bobp))))
+
 (ert-deftest haskell-ds-backward-decl-2 ()
   "Test running haskell-ds-backward-decl"
   (with-temp-buffer
@@ -92,6 +137,31 @@
     (should (= (point) (save-excursion (goto-line 13) (point))))
     (should (= (point-max) (progn (haskell-ds-forward-decl) (point))))))
 
+(ert-deftest haskell-ds-forward-decl-2-commented ()
+  "Test running haskell-ds-backward-decl"
+  (with-temp-buffer
+    (haskell-mode)
+    (insert-lines "" "-- documentation" "fun :: Int -> Int"
+                  "" "{- comment -}" "fun = id"
+                  "" "  -- space comment" "f2 :: Int"
+                  "" " {- trailing -} \t" "f2 = 3"
+                  "" "" "")
+    (font-lock-fontify-buffer)
+    (goto-char (point-min))
+
+    (should (haskell-ds-forward-decl))
+    (should (looking-at-p "$"))
+    (should (= (point) (save-excursion (goto-line 7) (point))))
+
+    (should (haskell-ds-forward-decl))
+    (should (looking-at-p "f2 :: Int"))
+
+    (should (haskell-ds-forward-decl))
+    (should (= (point) (save-excursion (goto-line 13) (point))))
+
+    (should (= (point-max) (progn (haskell-ds-forward-decl) (point))))
+    (should (eobp))))
+
 (provide 'haskell-decl-scan-tests)
 
 ;;; haskell-decl-scan-tests.el ends here