From 27b28c8e16810d2dc233ea961ed4dcde209076ac Mon Sep 17 00:00:00 2001
From: Greg Sexton <gregsexton@gmail.com>
Date: Wed, 8 Apr 2015 21:31:14 +0100
Subject: [PATCH] Fold javadoc also

---
 origami-parsers.el | 33 +++++++++++++++++++++++++++++++--
 origami.el         | 31 ++++++++++++++++++++++++-------
 2 files changed, 55 insertions(+), 9 deletions(-)

diff --git a/origami-parsers.el b/origami-parsers.el
index 899fee9..32e8ecc 100644
--- a/origami-parsers.el
+++ b/origami-parsers.el
@@ -31,9 +31,10 @@
 
 ;;; Code:
 (require 'cl)
+(require 'dash)
 
 (defcustom origami-parser-alist
-  '((java-mode             . origami-c-style-parser)
+  '((java-mode             . origami-java-parser)
     (c-mode                . origami-c-style-parser)
     (c++-mode              . origami-c-style-parser)
     (perl-mode             . origami-c-style-parser)
@@ -49,6 +50,9 @@
   :group 'origami)
 
 (defun origami-get-positions (content regex)
+  "Returns a list of positions where REGEX matches in CONTENT. A
+position is a cons cell of the character and the numerical
+position in the CONTENT."
   (with-temp-buffer
     (insert content)
     (goto-char (point-min))
@@ -87,11 +91,36 @@
                        (cons positions (reverse acc)))))
     (cdr (build positions))))
 
+;;; TODO: tag these nodes? have ability to manipulate nodes that are
+;;; tagged? in a scoped fashion?
+(defun origami-javadoc-parser (create)
+  (lambda (content)
+    (let ((positions (->> (origami-get-positions content "/\\*\\*\\|\\*/")
+                          (-filter (lambda (position)
+                                     (eq (get-text-property 0 'face (car position))
+                                         'font-lock-doc-face))))))
+      (origami-build-pair-tree create "/**" "*/" positions))))
+
 (defun origami-c-style-parser (create)
   (lambda (content)
-    (let ((positions (origami-get-positions content "[{}]")))
+    (let ((positions (->> (origami-get-positions content "[{}]")
+                          (remove-if (lambda (position)
+                                       (let ((face (get-text-property 0 'face (car position))))
+                                         (-any? (lambda (f)
+                                                  (memq f '(font-lock-doc-face
+                                                            font-lock-comment-face
+                                                            font-lock-string-face)))
+                                                (if (listp face) face (list face)))))))))
       (origami-build-pair-tree create "{" "}" positions))))
 
+(defun origami-java-parser (create)
+  (let ((c-style (origami-c-style-parser create))
+        (javadoc (origami-javadoc-parser create)))
+    (lambda (content)
+      (origami-fold-children
+       (origami-fold-shallow-merge (origami-fold-root-node (funcall c-style content))
+                                   (origami-fold-root-node (funcall javadoc content)))))))
+
 (defun origami-lisp-parser (create regex)
   (lambda (content)
     (with-temp-buffer
diff --git a/origami.el b/origami.el
index f791340..1321a95 100644
--- a/origami.el
+++ b/origami.el
@@ -170,6 +170,10 @@
 (defun origami-fold-state-equal (a b)
   (equal (origami-fold-open? a) (origami-fold-open? b)))
 
+(defun origami-fold-add-child (node new)
+  (origami-fold-children-set node
+                             (cons new (origami-fold-children node))))
+
 (defun origami-fold-replace-child (node old new)
   (origami-fold-children-set node
                              (cons new (remove old (origami-fold-children node)))))
@@ -236,13 +240,16 @@ children cannot be manipulated."
           (cons tree (origami-fold-find-deepest child pred))
         (list tree)))))
 
+(defun origami-fold-find-path-containing-range (tree beg end)
+  (origami-fold-find-deepest tree
+                             (lambda (node)
+                               (and (>= beg (origami-fold-beg node))
+                                    (<= end (origami-fold-end node))))))
+
 (defun origami-fold-find-path-with-range (tree beg end)
   "Return the path to the most specific (deepest) node that has
 exactly the range BEG-END, or null."
-  (-when-let (path (origami-fold-find-deepest tree
-                                              (lambda (node)
-                                                (and (>= beg (origami-fold-beg node))
-                                                     (<= end (origami-fold-end node))))))
+  (-when-let (path (origami-fold-find-path-containing-range tree beg end))
     (let ((last (-last-item path)))
       (when (and (= beg (origami-fold-beg last))
                  (= end (origami-fold-end last)))
@@ -279,6 +286,16 @@ with the current state and the current node at each iteration."
   (origami-fold-postorder-reduce node (lambda (acc node)
                                         (and acc (origami-fold-open? node))) t))
 
+(defun origami-fold-shallow-merge (tree1 tree2)
+  "Shallow merge the children of TREE2 in to TREE1."
+  (-reduce-from (lambda (tree node)
+                  (origami-fold-assoc (origami-fold-find-path-containing-range tree
+                                                                               (origami-fold-beg node)
+                                                                               (origami-fold-end node))
+                                      (lambda (leaf)
+                                        (origami-fold-add-child leaf node))))
+                tree1 (origami-fold-children tree2)))
+
 ;;; linear history structure
 
 (defun origami-h-new (present)
@@ -346,10 +363,10 @@ was last built."
 (defun origami-build-tree (buffer parser)
   (when parser
     (with-current-buffer buffer
-      (let ((contents (buffer-substring-no-properties (point-min) (point-max))))
+      (let ((contents (buffer-string)))
         (-> parser
-          (funcall contents)
-          origami-fold-root-node)))))
+            (funcall contents)
+            origami-fold-root-node)))))
 
 (defun origami-get-parser (buffer)
   (let* ((cached-tree (origami-get-cached-tree buffer))