;; tree-text.el
;;
;; Copyright (C) 2008-2009 recyclebin5385 all rights reserved.
;; http://recyclebin5385.blog13.fc2.com/
;;
;; Redistribution and use in source and binary forms, with or without
;; modification, are permitted provided that the following conditions
;; are met:
;;
;; Redistributions of source code must retain the above copyright
;; notice, this list of conditions and the following disclaimer.
;;
;; Neither the name of the copyright holder nor the names of its
;; contributors may be used to endorse or promote products derived
;; from this software without specific prior written permission.  THIS
;; SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
;; IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
;; FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
;; COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
;; (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
;; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
;; HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
;; STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
;; ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED
;; OF THE POSSIBILITY OF SUCH DAMAGE.
;;
;;テキストによる樹形図を作成する関数。
;;カレントバッファのテキストの各行を、樹形図の要素とみなして、
;;罫線で枝を描画する。
;;行頭の全角空白の個数を、各要素の階層の深さとみなす。
;;
;;ただし、罫線が引かれるのは、もともと全角空白のあった部分のみである。
;;空行があると、そこで樹形図は切断される。

(defvar make-tree-text-branch-length 0 "Branch length of tree graph.")

(defun make-tree-text-buffer ()
  "Make a tree graph from a whole buffer."
  (interactive)
  (make-tree-text-region (point-min) (point-max)))

(defun make-tree-text-region (START END)
  "Make a tree graph from a region."
  (interactive "r")

  (save-excursion
    ;;最終行の先頭に移動
    (goto-char END)
    (forward-line 0)

    (let (current-line-start next-line-start next-point)
      (catch 'loop
        (while t
          ;;末尾の行から順番に処理を行う
          (setq current-line-start (point))
          (setq next-point next-line-start)

          (while (equal ?　 (char-after))
            ;;行頭の全角空白を罫線に置換する
            (let* ((down-flag
                    (and next-point
                         (or (equal ?│ (char-after next-point))
                             (equal ?└ (char-after next-point))
                             (equal ?├ (char-after next-point)))))

                   (right-flag
                    (let ((right-char (char-after (1+ (point)))))
                      (and (not (equal ?　 right-char))
                           (not (equal ?\n right-char)))))

                   (replaced-char
                    (cond ((and down-flag right-flag) ?├)
                          (right-flag ?└)
                          (down-flag ?│)
                          (t nil))))

              (cond (replaced-char
                     (delete-char 1)
                     (insert-char replaced-char 1))
                    (t
                     (forward-char)))

              (cond (right-flag
                     (insert-char ?─ make-tree-text-branch-length))
                    (t
                     (insert-char ?　 make-tree-text-branch-length))))

            (cond ((and next-point (not (equal ?\n (char-after next-point))))
                   (setq next-point (1+ next-point)))))

          (if (= (point-min) (point)) (throw 'loop 1)) ;;バッファの先頭行を処理したら、ループから抜ける

          ;;1つ上の行に移動する
          (setq next-line-start current-line-start)
          (forward-line -1)
          (if (< (point) START) (throw 'loop 1)) ;;範囲をすべて処理したら、ループから抜ける

          (setq current-line-start (point)))))))