outline-tree2 の設定ファイルをさらしてみる。

;; -*- Mode: lisp; Package: OUTLINE-TREE2; outline-tree: user-regexp-lisp-dots; -*-

;;; Code:

(require "outline-tree/outline-tree")

(in-package "outline-tree2")

;;; extended-key-translate-table 設定
;(set-extended-key-translate-table exkey-C-tab #\F23)
;(set-extended-key-translate-table exkey-C-return #\F20)
;
;;; Editor <-> TreeView
;; Editor -> TreeView
;(global-set-key #\F23 'treeview::treeview-focus-treeview)

;; TreeView (outline-tree) -> Editor
;(define-key outline-tree2::*outline-tree-map* #\F23 'treeview::treeview-focus-editor)

;;; outline 更新
;(global-set-key #\F20 'outline-tree2::outline-tree-create-outline-and-select-node)
;(define-key outline-tree2::*outline-tree-map*
;            #\F20 'outline-tree2::outline-tree-create-outline-and-select-node)

;; ノード対応テキストハイライト
(setq *outline-tree-text-highlight-attribute* '(:background 3 :prefix #\T :extend t))

;;; sample.config.l ends here



;; バッファ更新時にバッファが削除済みの場合、更新処理を行わないように修正
;; 上書き
(defun outline-tree-update-modified-buffer-node-name-view ()
  (unless *outline-tree-update-modified-buffer-node-name-view-p*
    (return-from outline-tree-update-modified-buffer-node-name-view nil))
  (treeview::with-app (*outline-tree-app-id*)
    (let (buffer-node-name-view)
      (maphash
	   #'(lambda (buffer buffer-node)
	       (unless (deleted-buffer-p buffer)  ;; この条件を追加
		 (setq buffer-node-name-view
		       (if (buffer-modified-p buffer)
			   (concat "* " (outline-tree-data-get-node-name buffer-node))
			 (outline-tree-data-get-node-name buffer-node)))
		 (unless (string-equal buffer-node-name-view
				       (treeview::treeview-get-item-text buffer-node))
		   (treeview::treeview-set-item-text buffer-node buffer-node-name-view))))
	   outline-tree2::*outline-tree-buffer-hash*))))

;;-----------------------------------------------------------
;;. outline-treeを表示･非表示
(defun outline-tree-toggle-open ()
  "outline-tree: アウトラインツリーのトグル"
  (interactive)
  (let ((whndl (get-window-handle))
	(center (winapi:make-RECT))
	width)
    (winapi::GetWindowRect whndl center)
    (setq width (- (winapi::RECT-right center) (winapi::RECT-left center)))
    (setq treeview::*treeview-window-size-default*
	  (cond ((> width 1900)
		 400)
		((> width 1600)
		 300)
		(t
		 200))))
  (if (outline-tree-exist-p)
      (if (outline-tree-open-p)
	  (outline-tree-close)
	(outline-tree-open))
    (progn
      (outline-tree-create)
      (outline-tree-open))))

(defun set-toggle-olc-keybind ()
  (if (fboundp 'user::toggle-buffer-bar)
      (global-set-key '(#\C-c #\C-o)
		      (x-key-macro 16 'outline-tree-toggle-open 'user::toggle-buffer-bar))
    (global-set-key '(#\C-c #\C-o) 'outline-tree-toggle-open)))

(if (modulep "allconfigs/allconfigs")
    (set-toggle-olc-keybind)
  (add-hook 'user::*post-allconfigs-hook* 'set-toggle-olc-keybind))


;;. カーソル追従の深さを無制限に
;;-----------------------------------------------------------
(setq *outline-tree-expand-on-chase-cursor* t)

;;-----------------------------------------------------------
;;. outline-treeの現在ノード以下を展開・非展開
(defun toggle-outline-tree-node-expand ()
  "outline-treeの現在ノード以下を展開・非展開"
  (interactive)
  (treeview::with-app (outline-tree2::*outline-tree-app-id*)
    (let ((node (outline-tree-get-selected-node)))
      (if (treeview::treeview-expand-p node)
          (outline-tree-expand-collapse-subtree node)
        (outline-tree-expand-expand-subtree-show-heading-node node)
        ))))

(global-set-key #\C-M-\: 'toggle-outline-tree-node-expand)

;;-----------------------------------------------------------
;;. outline-treeの現在ノードの親以下を展開
(defun outline-tree-node-expand-parent ()
  "outline-treeの現在ノードの親以下を展開"
  (interactive)
  (treeview::with-app (outline-tree2::*outline-tree-app-id*)
    (let ((node (outline-tree-get-selected-node))
          parent)
      (setq parent (treeview::treeview-get-parent-item node))
      (outline-tree-expand-expand-subtree-show-heading-node parent)
      )))

(global-set-key #\C-M-\; 'outline-tree-node-expand-parent)

;;-----------------------------------------------------------
;;. outline-tree を左端から arg 分だけスクロールした場所に移動する
(defvar *outline-tree-hscroll-arg* nil)
(setq *outline-tree-hscroll-arg* 8)

(defvar *outline-tree-hscroll-arg* nil)
(defvar *outline-tree-hscroll-delay* nil)
;(setq *outline-tree-hscroll-delay* 0.1)


(defun outline-tree-hscroll (arg)
  "outline-tree を左端から arg 分だけスクロールした場所に移動する"
  (interactive "p")
  (if arg
      (if *outline-tree-hscroll-delay*
          (start-timer
           *outline-tree-hscroll-delay*
           #'(lambda ()
               (treeview::with-app (outline-tree2::*outline-tree-app-id*)
                 (do-events)
                 (treeview::treeview-hscroll-window-left)
                 (treeview::treeview-hscroll-window arg)))
           t)
        (treeview::with-app (outline-tree2::*outline-tree-app-id*)
          (do-events)
          (treeview::treeview-hscroll-window-left)
          (treeview::treeview-hscroll-window arg))
	)))

;;-----------------------------------------------------------
;;. 削除されたウィンドウの場合のバグを修正 
(defun outline-tree-funcall-buffer-by-window (func window)
  (unless window
    (setq window (outline-tree-get-target-window)))
  (let ((gcolumn (goal-column)))
    (prog1
        (save-window-excursion
	  (handler-case
	      (set-window window)
	    (error (c)
	      (setq window (selected-window))))
          (funcall func (selected-buffer)))
      (set-goal-column gcolumn))))

;;-----------------------------------------------------------
;;. recenter (C-l) で outline-treeも更新
(defun olt-updates ()
  (when (and (outline-tree-exist-p)
	     (outline-tree-open-p))
    ;(outline-tree-create-outline)
    (outline-tree-hscroll *outline-tree-hscroll-arg*)))

(require "recenter/recenter-with-hook")
(add-hook 'ed::*after-recenter-hook* 'olt-updates t)

(defvar *olt-updates-expand-depth* 4)
(setq *olt-updates-expand-depth* 5)

;;-----------------------------------------------------------
;;. recenter (C-l) ×2 で outline-treeを展開更新
(defun olt-updates-with-expand ()
  (and (outline-tree-exist-p)
       (outline-tree-open-p)
       (let ((*outline-tree-expand-depth-on-create-outline*
	      (if (boundp 'outline-tree-expand-depth-on-create-outline-local)
		  outline-tree-expand-depth-on-create-outline-local
		*outline-tree-expand-depth-on-create-outline*)))
	 (outline-tree-create-outline)
	 (outline-tree-expand-expand-subtree *olt-updates-expand-depth*)
	 (outline-tree-hscroll *outline-tree-hscroll-arg*)
	 )))
(add-hook 'ed::*after-continued-recenter-hook* 'olt-updates-with-expand t)


;(global-set-key #\Delete 'outline-tree-delete-outline-by-node)

;(global-set-key #\M-\C-p 'outline-tree-select-up-key-node)
;(global-set-key #\M-\C-n 'outline-tree-select-down-key-node)
;(global-set-key #\M-\C-b 'outline-tree-select-left-key-node)
;(global-set-key #\M-\C-f 'outline-tree-select-right-key-node)
;(define-key *outline-tree-map* #\RET 'outline-tree-node-action)

(defun outline-tree-select-up-key-node-if-exists ()
  (interactive)
  (if (and (outline-tree-exist-p)
	   (outline-tree-open-p))
      (outline-tree-select-up-key-node)))
(defun outline-tree-select-down-key-node-if-exists ()
  (interactive)
  (if (and (outline-tree-exist-p)
	   (outline-tree-open-p))
      (outline-tree-select-down-key-node)))
(defun outline-tree-select-left-key-node-if-exists ()
  (interactive)
  (if (and (outline-tree-exist-p)
	   (outline-tree-open-p))
      (outline-tree-select-left-key-node)))
(defun outline-tree-select-right-key-node-if-exists ()
  (interactive)
  (if (and (outline-tree-exist-p)
	   (outline-tree-open-p))
      (outline-tree-select-right-key-node)))

(global-set-key #\M-\C-0     'outline-tree-select-up-key-node-if-exists)
(global-set-key #\M-\C-Up    'outline-tree-select-up-key-node-if-exists)
(global-set-key #\M-\C-Down  'outline-tree-select-down-key-node-if-exists)
(global-set-key #\M-\C-Left  'outline-tree-select-left-key-node-if-exists)
(global-set-key #\M-\C-Right 'outline-tree-select-right-key-node-if-exists)

(global-set-key #\M-\C-h (x-key-macro #x12 'backward-kill-word
			   'outline-tree-select-left-key-node-if-exists))
(global-set-key #\M-\C-j 'outline-tree-select-down-key-node-if-exists)
(global-set-key #\M-\C-k 'outline-tree-select-up-key-node-if-exists)
(global-set-key '(#\C-x #\O) 'treeview::treeview-focus-treeview)
(define-key treeview::*treeview-map* '(#\C-x #\O) 'treeview::treeview-other-window)

;(global-set-key #\M-\C-l 'outline-tree-select-right-key-node-if-exists)


;(global-set-key #\M-\C-z 'outline-tree-select-pageup-key-node)
;(global-set-key #\M-\C-v 'outline-tree-select-pagedown-key-node)
;(global-set-key #\M-\C-a 'outline-tree-select-ancestor-node)
;(global-set-key #\M-\C-e 'outline-tree-select-eldest-descendants-node)
;(global-set-key #\M-\C-s (treeview::treeview-make-tv-command outline-tree-isearch-forward))
;(global-set-key #\M-\C-r (treeview::treeview-make-tv-command outline-tree-isearch-backward))
;(global-set-key #\M-\P 'outline-tree-swap-region-by-prev-range-node)
;(global-set-key #\M-\N 'outline-tree-swap-region-by-next-range-node)
;(global-set-key #\M-\D 'outline-tree-delete-region-by-range-node))

;;. icon を指定できるように

;:layer-regexp-list を以下のリストに拡張:
;  正規表現、または正規表現とアイコンID のリスト

(defun outline-tree-insert-range-node (range-name parent-node
						  &key (insertafter winapi:TVI_LAST)
						  title-range whole-range sub-type
						  implicit-func explicit-func
						  heading-icon)
  (let (icon group-count)
    (cond ((eq sub-type :header-node)
           (setq icon *outline-tree-icon-id-header*))
          ((and *outline-tree-range-node-group-p*
                (plusp (setq group-count (outline-tree-data-get-group-count parent-node))))
           (cond ((eq sub-type :heading-node)
                  (cond ((= (mod group-count 2) 1)
                         (setq icon *outline-tree-icon-id-heading1*))
                        ((= (mod group-count 2) 0)
                         (setq icon *outline-tree-icon-id-heading2*))))
                 (t
                  (cond ((= (mod group-count 2) 1)
                         (setq icon *outline-tree-icon-id-range1*))
                        ((= (mod group-count 2) 0)
                         (setq icon *outline-tree-icon-id-range2*))))))
          (t
	   (cond ((eq sub-type :heading-node)
		  (setq icon (or heading-icon
				 *outline-tree-icon-id-heading*)))
                 (t
                  (setq icon *outline-tree-icon-id-range*)))))
    (treeview::with-app (*outline-tree-app-id*)
      (outline-tree-register-range-node
       range-name
       (treeview::treeview-insert-item range-name parent-node
                                       :insertafter insertafter
                                       :icon icon :sicon icon)
       :title-range title-range
       :whole-range whole-range
       :sub-type sub-type
       :implicit-func implicit-func
       :explicit-func explicit-func))))

(defun outline-tree-create-outline-regexp-internal
  (&key root-node
        layer-regexp-list layer-regexp-list-case-fold (layer-regexp-list-order :non-miss)
        create-sub-outline-func title-converter sub-type line-oriented)
  "正規表現アウトライン作成内部 function
ROOT-NODE
LAYER-REGEXP-LIST
LAYER-REGEXP-LIST-CASE-FOLD
LAYER-REGEXP-LIST-ORDER: :top-miss, :any-miss, :non-miss, :disorder"
  (labels (;; ************************************************************
           ;; 階層検索 
           ;; ************************************************************
           (outline-tree-create-outline-regexp-order (&key root-node
                                                           layer-regexp-list
                                                           layer-regexp-list-order
                                                           create-sub-outline-func
                                                           line-oriented)
             (let ((current-regexp (car layer-regexp-list))
                   (layer-regexp-list (cdr layer-regexp-list))
                   header-node range-node value-list from next-from title-from title-to
                   whole-range title-range contents-from regnum title heading-icon icon match)
	       (when (consp current-regexp)
		 (setq heading-icon (cadr current-regexp)
		       current-regexp (car current-regexp))
		 (if (symbolp heading-icon)
		     (setq heading-icon (symbol-value heading-icon))))
               (save-excursion
                 (goto-char (point-min))
                 ;; ****************************************
                 ;; サブアウトライン作成
                 ;; ****************************************
                 (unless current-regexp
                   (when create-sub-outline-func
                     (funcall create-sub-outline-func root-node))
                   (return-from outline-tree-create-outline-regexp-order))
                 ;; ****************************************
                 ;; 現在の正規表現でのマッチ情報を取得
                 ;; ****************************************
                 (when current-regexp
		   (while (scan-buffer current-regexp :regexp t)
                     (setq from next-from
                           next-from (point))
		     (setq whole-range (cons from next-from)
			   title-range (cons title-from title-to))
		     (if (functionp heading-icon)
			 (progn
			   (setq match (match-data))
			   (setq icon (funcall heading-icon))
			   (store-match-data match))
		       (setq icon heading-icon))
                     ;; from が nil のものもとりあえず push
                     (push (list whole-range title-range contents-from icon) value-list)
                     (setq contents-from (match-end 0))
		     
                     (when line-oriented
                       (goto-char contents-from)
                       (unless (bolp)
                         (goto-eol)
                         (forward-char)
                         (setq contents-from (point))))
                     (if (setq regnum (dotimes (i 9) (if (match-string (- 9 i)) (return (- 9 i)))))
                         ;; 正規表現からタイトル取得
                         (setq title-from (match-beginning regnum)
                               title-to (match-end regnum))
                       ;; 先頭行からタイトル取得
                       (save-excursion
                         (goto-char (match-beginning 0))
                         (setq title-from (point)
                               title-to (progn (goto-eol) (point)))))
                     (goto-char contents-from))
                   ;; 最後の一回分を push
                   (when next-from
                     (setq whole-range (cons next-from (if (= (point-max) (buffer-size)) nil (point-max)))
                           title-range (cons title-from title-to))
		     (if (functionp heading-icon)
			 (save-excursion
			   (goto-char next-from)
			   (setq icon (funcall heading-icon)))
		       (setq icon heading-icon))
                     (push (list whole-range title-range contents-from icon) value-list))
                   ;; 順番を逆にした上で、from が nil のものを取り除く
                   (setq value-list (cdr (nreverse value-list))))
                 ;; ******************************
                 ;; 正規表現マッチ情報に従い処理実施
                 ;; ******************************
                 (cond
                  ;; 現在の正規表現にマッチする部分が見つかった場合
                  (value-list
                   ;; layer-regexp-list-order を更新
                   (when (eq layer-regexp-list-order :top-miss)
                     (setq layer-regexp-list-order :non-miss))
                   ;; 現在の正規表現にマッチ開始するまでの範囲を処理
                   (if line-oriented
                       (setq whole-range
                             (cons (save-excursion
                                     (goto-char (point-min))
                                     (if (bolp) (point) (progn (goto-eol) (forward-char) (point))))
                                   (car (first (car value-list)))))
                     (setq whole-range (cons (point-min) (car (first (car value-list))))))
                   (when (< (outline-tree-get-range-from whole-range)
                            (outline-tree-get-range-to whole-range))
                     (save-excursion
                       (save-restriction
                         ;; サブアウトライン作成
			 (narrow-to-region (outline-tree-get-range-from whole-range)
					   (outline-tree-get-range-to whole-range))
			 (setq header-node
			       (outline-tree-insert-range-node *outline-tree-header-node-name*
							       root-node
							       :whole-range whole-range
							       :sub-type :header-node
							       :heading-icon (fourth (car value-list))))
                         (outline-tree-create-outline-regexp-order
                          :root-node header-node
                          :create-sub-outline-func create-sub-outline-func)
                         (when (and (not (outline-tree-node-has-children-p header-node))
                                    (not (and (eq sub-type :heading-node)
                                              (outline-tree-buffer-node-p root-node))))
                           (outline-tree-remove-range-node header-node)))))
                   ;; 現在の正規表現にマッチした箇所から開始するそれぞれの範囲を処理
                   ;; (階層定義正規表現リスト)
                   (dolist (value value-list)
                     (setq whole-range (first value)
                           title-range (second value)
                           contents-from (third value))
                     (setq title (buffer-substring (outline-tree-get-range-from title-range)
                                                   (outline-tree-get-range-to title-range)))
		     (when title-converter
		       (setq title (funcall title-converter title)))
		     (setq range-node (outline-tree-insert-range-node
					   title root-node :title-range title-range :whole-range whole-range
					   :sub-type sub-type :heading-icon (fourth value)))
                     (when (< contents-from (outline-tree-get-range-to whole-range))
                       (save-restriction
                         (narrow-to-region contents-from
                                           (outline-tree-get-range-to whole-range))
                         (outline-tree-create-outline-regexp-order
                          :root-node range-node
                          :layer-regexp-list layer-regexp-list
                          :layer-regexp-list-order layer-regexp-list-order
                          :create-sub-outline-func create-sub-outline-func
                          :line-oriented line-oriented))))
                   (caaar value-list))
                  ;; 正規表現にマッチする部分が見つからず、それが許容される場合
                  ((member layer-regexp-list-order '(:top-miss :any-miss))
                   (outline-tree-create-outline-regexp-order
                    :root-node root-node
                    :layer-regexp-list layer-regexp-list
                    :layer-regexp-list-order layer-regexp-list-order
                    :create-sub-outline-func create-sub-outline-func
                    :line-oriented line-oriented))
                  (t
                   (outline-tree-create-outline-regexp-order
                    :root-node root-node
                    :create-sub-outline-func create-sub-outline-func))))))
           ;; ************************************************************
           ;; 階層解析
           ;; ************************************************************
           (outline-tree-create-outline-regexp-disorder (&key root-node
                                                              layer-regexp-list
                                                              create-sub-outline-func
                                                              line-oriented)
             (let (current-regexp match-alist regexp-position regnum header-node title heading-icon)
               (save-excursion
                 ;; ****************************************
                 ;; 今回の階層をどの正規表現で作成するか解析
                 ;; ****************************************
                 ;; 各正規表現がマッチする最初のポイントを取得
                 (dolist (regexp layer-regexp-list)
		   (when (consp regexp)
		     (setq heading-icon (cadr regexp)
			   regexp (car regexp))
		     (if (symbolp heading-icon)
			 (setq heading-icon (symbol-value heading-icon))))
                   (goto-char (point-min))
                   (when (and regexp
                              (scan-buffer regexp :regexp t))
                     (push (cons regexp (point)) match-alist)))
                 ;; どの正規表現に始めにマッチしたか確認
                 (when match-alist
                   (setq current-regexp (caar (stable-sort match-alist #'< :key #'cdr)))
                   ;(setq regexp-position
                   ;      (position current-regexp layer-regexp-list :test 'equal))
                   (setq regexp-position
			 (position current-regexp layer-regexp-list
				   :test #'(lambda (x y)
					     (or (equal x y)
						 (equal x (safe-car y))))))
                   (setq layer-regexp-list
                         (append (subseq layer-regexp-list 0 regexp-position)
                                 (subseq layer-regexp-list (1+ regexp-position)))))
                 (goto-char (point-min))
                 ;; ****************************************
                 ;; サブアウトライン作成
                 ;; ****************************************
                 (unless current-regexp
                   (when create-sub-outline-func
                     (funcall create-sub-outline-func root-node))
                   (return-from outline-tree-create-outline-regexp-disorder))
                 ;; ****************************************
                 ;; 現在の正規表現でのマッチ情報を取得
                 ;; ****************************************
                 (when current-regexp
		   (let ((heading-icon-function-p (functionp heading-icon))
			 range-node value-list
			 from next-from title-from title-to
			 whole-range title-range contents-from
			 icon)
                     (while (scan-buffer current-regexp :regexp t)
                       (setq from next-from
                             next-from (point))
                       (setq whole-range (cons from next-from)
                             title-range (cons title-from title-to))
		       (if heading-icon-function-p
			   (let ((match (match-data)))
			     (setq icon (funcall heading-icon))
			     (store-match-data match))
			 (setq icon heading-icon))
                       ;; from が nil のものもとりあえず push
                       (push (list whole-range title-range contents-from icon) value-list)
                       (setq contents-from (match-end 0))
                       (when line-oriented
                         (goto-char contents-from)
                         (unless (bolp)
                           (goto-eol)
                           (forward-char)
                           (setq contents-from (point))))
                       (if (setq regnum (dotimes (i 9) (if (match-string (- 9 i)) (return (- 9 i)))))
                           ;; 正規表現からタイトル取得
                           (setq title-from (match-beginning regnum)
                                 title-to (match-end regnum))
                         ;; 先頭行からタイトル取得
                         (save-excursion
                           (goto-char (match-beginning 0))
                           (setq title-from (point)
                                 title-to (progn (goto-eol) (point)))))
                       (goto-char contents-from))
                     ;; 最後の一回分を push
                     (when next-from
                       (setq whole-range (cons next-from (if (= (point-max) (buffer-size)) nil (point-max)))
                             title-range (cons title-from title-to))
                       (push (list whole-range title-range contents-from) value-list))
                     ;; 順番を逆にした上で、from が nil のものを取り除く
                     (setq value-list (cdr (nreverse value-list)))
                     (cond
                      (value-list
                       ;; 現在の正規表現にマッチ開始するまでの範囲を処理
                       (if line-oriented
                           (setq whole-range
                                 (cons (save-excursion
                                         (goto-char (point-min))
                                         (if (bolp) (point) (progn (goto-eol) (forward-char) (point))))
                                       (car (first (car value-list)))))
                         (setq whole-range (cons (point-min) (car (first (car value-list))))))
                       (when (< (outline-tree-get-range-from whole-range)
                                (outline-tree-get-range-to whole-range))
                         (save-excursion
                           (save-restriction
                             ;; サブアウトライン作成
                             (narrow-to-region (outline-tree-get-range-from whole-range)
                                               (outline-tree-get-range-to whole-range))
			     (setq header-node
				   (outline-tree-insert-range-node *outline-tree-header-node-name*
								   root-node
								   :whole-range whole-range
								   :sub-type :header-node
								   :heading-icon (fourth (car value-list))))
                             (outline-tree-create-outline-regexp-disorder
                              :root-node header-node
                              :create-sub-outline-func create-sub-outline-func)
                             (when (and (not (outline-tree-node-has-children-p header-node))
                                        (not (and (eq sub-type :heading-node)
                                                  (outline-tree-buffer-node-p root-node))))
                               (outline-tree-remove-range-node header-node)))))
                       ;; 現在の正規表現にマッチした箇所から開始するそれぞれの範囲を処理
                       ;; (階層定義正規表現リスト)
		       (dolist (value value-list)
			 (setq whole-range (first value)
			       title-range (second value)
			       contents-from (third value))
			 (setq title (buffer-substring (outline-tree-get-range-from title-range)
						       (outline-tree-get-range-to title-range)))
			 (when title-converter
			   (setq title (funcall title-converter title)))
			 (setq range-node (outline-tree-insert-range-node
					       title root-node :title-range title-range :whole-range whole-range
					       :sub-type sub-type
					       :heading-icon (fourth value)))
			 (when (< contents-from (outline-tree-get-range-to whole-range))
			   (save-restriction
			     (narrow-to-region contents-from
					       (outline-tree-get-range-to whole-range))
			     (outline-tree-create-outline-regexp-disorder
			      :root-node range-node
			      :layer-regexp-list layer-regexp-list
			      :create-sub-outline-func create-sub-outline-func
			      :line-oriented line-oriented))))
                       (caaar value-list))
                      ;; 正規表現にマッチする部分が見つからず、検索終了の場合
                      (t
                       (outline-tree-create-outline-regexp-disorder
                        :root-node root-node
                        :create-sub-outline-func create-sub-outline-func)))))))))
    ;; 処理開始部
    ;; layer-regexp-list の各要素を compiled-regexp 形式に
    (when (symbolp layer-regexp-list)
      (setq layer-regexp-list (symbol-value layer-regexp-list)))
    (setq layer-regexp-list
	  (mapcar #'(lambda (regexp)
		      (if (stringp regexp)
			  (compile-regexp regexp layer-regexp-list-case-fold)
			(if (and (consp regexp)
				 (stringp (car regexp)))
			    (cons (compile-regexp (car regexp)) (cdr regexp))
			  regexp)))
                  layer-regexp-list))
    (cond
     ;; 階層解析
     ((member layer-regexp-list-order '(:disorder))
      (outline-tree-create-outline-regexp-disorder
       :root-node root-node
       :layer-regexp-list layer-regexp-list
       :create-sub-outline-func create-sub-outline-func
       :line-oriented line-oriented))
     ;; 階層検索
     (t
      (unless (member layer-regexp-list-order '(:top-miss :any-miss :non-miss))
        (setq layer-regexp-list-order :non-miss))
      (outline-tree-create-outline-regexp-order
       :root-node root-node
       :layer-regexp-list layer-regexp-list
       :layer-regexp-list-order layer-regexp-list-order
       :create-sub-outline-func create-sub-outline-func
       :line-oriented line-oriented)))
    (outline-tree-node-has-children-p root-node)))

#|
icon を指定する example: 

.outline-tree/autoload/cr-user-regexp-lisp-dots.l >>>
(require "outline-tree/outline-tree")
(require "outline-tree/cr-regexp-internal")

(in-package "outline-tree2")
;; definition
(defun outline-tree-create-outline-user-regexp-lisp-dots (root-node)
  (outline-tree-create-outline-regexp-internal
       :root-node root-node
       :layer-regexp-list-order :non-miss
       :layer-regexp-list '(("^;;;?\\.[ \t]*\\([^.\n][^;\n]*\\)[ \t;]*$" *outline-tree-icon-id-info*)
			    ;"^;;\\.[ \t]+\\([^.\n].*\\)"
			    ("^;;;?\\.\\{2\\}[ \t]*\\([^.\n].*\\)")
			    "^;;;?\\.\\{3\\}[ \t]*\\([^.\n].*\\)"
			    "^;;;?\\.\\{4\\}[ \t]*\\([^.\n].*\\)"
			    "^;;;?\\.\\{5\\}[ \t]*\\([^.\n].*\\)"
			    "^;;;?\\.\\{6\\}[ \t]*\\([^.\n].*\\)"
			    "^;;;?\\.\\{7\\}[ \t]*\\([^.\n].*\\)"
			    "^;;;?\\.\\{8\\}[ \t]*\\([^.\n].*\\)"
			    "^;;;?\\.\\{9\\}[ \t]*\\([^.\n].*\\)"
			    )
       :layer-regexp-list-case-fold nil
       :sub-type :heading-node
       :line-oriented nil
       :title-converter nil))
;; register
(outline-tree-add-create-outline-function
 'outline-tree-create-outline-user-regexp-lisp-dots "* user : Lisp 階層付きテキスト" '(:user :sequential)
 "Lisp コメントを考慮した階層付きテキストを階層表示します。")
<<<
|#



;;. autoload の設定

;; Note: buf2htmlは、autoload でロードできるように本体側を修正済み
(autoload 'ed::buf2html-get-ini2css-string "buf2html")
(autoload 'ed::buf2html-get-region-string "buf2html")