diff --git a/README.md b/README.md
index 70ef732..f2696c6 100644
--- a/README.md
+++ b/README.md
@@ -19,7 +19,7 @@ embedded in a native application.)
- [CLOG - Reference Manual](https://rabbibotton.github.io/clog/clog-manual.html)
-STATUS: CLOG and CLOG Builder 2.0 released. CLOG API Stable 4 years
+STATUS: CLOG and CLOG Builder 2.1 released. CLOG API Stable 4 years
The CLOG Builder is in 100% portable Common Lisp using the CLOG Framework.
diff --git a/clog.asd b/clog.asd
index 0f1769b..6a1df1c 100644
--- a/clog.asd
+++ b/clog.asd
@@ -93,8 +93,8 @@
(:file "clog-builder-projects")
(:file "clog-builder-asdf-browser")
(:file "clog-builder-sys-browser")
- (:file "clog-builder-dir-win")
(:file "clog-builder-project-tree")
+ (:file "clog-builder-dir-tree")
(:file "clog-builder-repl")
(:file "clog-builder-shell")
(:file "clog-builder-images")
@@ -109,5 +109,4 @@
(:file "panel-projects")
(:file "panel-project-directory")
(:file "panel-clog-builder-repl")
- (:file "panel-shell")
- (:file "panel-dir-view")))
+ (:file "panel-shell")))
diff --git a/doc/clog-manual.html b/doc/clog-manual.html
index 96d272d..5f41032 100644
--- a/doc/clog-manual.html
+++ b/doc/clog-manual.html
@@ -363,6 +363,13 @@ static file matching the requested path ON-NEW-WINDOW-HANDLER and
Turn on browser console debugging for OBJ's connection.
+
+
+
@@ -3808,7 +3815,7 @@ if :HTML-ID "myid" then the HTML-ID for cent
-- [generic-function] CREATE-CLOG-TREE OBJ &KEY CONTENT INDENT-LEVEL NODE-HTML FILL-FUNCTION VISIBLE CLASS HTML-ID AUTO-PLACE
+- [generic-function] CREATE-CLOG-TREE OBJ &KEY CONTENT INDENT-LEVEL NODE-HTML ON-CONTEXT-MENU FILL-FUNCTION VISIBLE CLASS HTML-ID AUTO-PLACE
@@ -3818,6 +3825,18 @@ if :HTML-ID "myid" then the HTML-ID for cent
Accessor for clog-tree root, create clog-tree-items
on the tree-root or other clog-tree's.
+
+
+
+
+
+
@@ -3826,6 +3845,11 @@ on the tree-root or other clog-tree's.
Accessor for clog-tree root, create clog-tree-items
on the tree-root or other clog-tree's.
+
+
+
+- [generic-function] CONTENT OBJECT
+
@@ -3836,7 +3860,7 @@ on the tree-root or other clog-tree's.
-- [generic-function] CREATE-CLOG-TREE-ITEM OBJ &KEY CONTENT INDENT-LEVEL NODE-HTML ON-CLICK CLASS HTML-ID AUTO-PLACE
+- [generic-function] CREATE-CLOG-TREE-ITEM OBJ &KEY CONTENT INDENT-LEVEL NODE-HTML ON-CLICK ON-CONTEXT-MENU CLASS HTML-ID AUTO-PLACE
diff --git a/source/clog-tree.lisp b/source/clog-tree.lisp
index de4909c..e1ad68f 100644
--- a/source/clog-tree.lisp
+++ b/source/clog-tree.lisp
@@ -16,7 +16,9 @@
(defclass clog-tree (clog-div)
((tree-root :accessor tree-root)
(indent-level :accessor indent-level)
- (content :accessor content))
+ (content :accessor content)
+ (toggle-state :accessor toggle-state)
+ (toggle-func :accessor toggle-func))
(:documentation "CLOG-Tree object - a collapsible tree component"))
(defgeneric tree-root (clog-tree)
@@ -27,6 +29,9 @@ on the tree-root or other clog-tree's."))
(:documentation "Accessor for clog-tree root, create clog-tree-items
on the tree-root or other clog-tree's."))
+(defgeneric toggle-state (clog-tree)
+ (:documentation "True if node is open."))
+
(defmethod create-clog-tree ((obj clog-obj) &key (content "")
(indent-level 0)
(node-html "📁") ; folder icon
@@ -50,7 +55,7 @@ and when not visible (such as clicked to close) the children are destroyed."
(setf (tree-root new-obj) (create-span header))
(dotimes (n indent-level)
(create-span new-obj :content " " :auto-place :top))
- (flet ((toggle-tree ()
+ (flet ((toggle-me ()
(cond (fill-function
(if visible
(setf (text (tree-root new-obj)) "")
@@ -60,19 +65,27 @@ and when not visible (such as clicked to close) the children are destroyed."
(if visible
(setf (hiddenp (tree-root new-obj)) t)
(setf (hiddenp (tree-root new-obj)) nil))
- (setf visible (not visible))))))
+ (setf visible (not visible))))
+ (setf (toggle-state new-obj) visible)))
(setf visible (not visible))
- (toggle-tree)
+ (toggle-me)
+ (setf (toggle-func new-obj) #'toggle-me)
(when on-context-menu
(set-on-context-menu new-obj (lambda (obj)
(declare (ignore))
(funcall on-context-menu obj))))
(set-on-click new-obj (lambda (obj)
(declare (ignore obj))
- (toggle-tree))
+ (toggle-me))
:cancel-event t)) ; prevent event bubble up tree
new-obj))
+(defmethod toggle-tree (clog-tree)
+ (:documentation "Toggle state of tree node"))
+
+(defmethod toggle-tree ((obj clog-tree))
+ (funcall (toggle-func obj)))
+
(defclass clog-tree-item (clog-div)
((tree-item :accessor tree-item)
(indent-level :accessor indent-level)
diff --git a/source/clog.lisp b/source/clog.lisp
index 5f3c7c2..5fcdebf 100644
--- a/source/clog.lisp
+++ b/source/clog.lisp
@@ -654,6 +654,8 @@ embedded in a native template application.)"
(clog-tree class)
(create-clog-tree generic-function)
(tree-root generic-function)
+ (toggle-tree generic-function)
+ (toggle-state generic-function)
(indent-level generic-function)
(content generic-function)
diff --git a/tools/clog-builder-dir-tree.lisp b/tools/clog-builder-dir-tree.lisp
new file mode 100644
index 0000000..017c946
--- /dev/null
+++ b/tools/clog-builder-dir-tree.lisp
@@ -0,0 +1,221 @@
+(in-package :clog-tools)
+
+(defun on-dir-tree (obj &key dir)
+ (let* ((*default-title-class* *builder-title-class*)
+ (*default-border-class* *builder-border-class*)
+ (win (create-gui-window obj :title "Directory Tree"
+ :width 300
+ :has-pinner t
+ :keep-on-top t
+ :client-movement *client-side-movement*))
+ (root-dir (create-form-element (window-content win) :text))
+ (panel (create-panel (window-content win) :background-color :silver
+ :style "text-align:center;"
+ :class "w3-tiny"
+ :height 27 :top 30 :left 0 :right 0))
+ (tree (create-panel (window-content win)
+ :class "w3-small"
+ :overflow :scroll
+ :top 60 :bottom 0 :left 0 :right 0)))
+ (declare (ignore panel))
+ (set-geometry win :top (menu-bar-height win) :left 0 :height "" :bottom 5 :right "")
+ (setf (positioning root-dir) :absolute)
+ (set-geometry root-dir :height 27 :width "100%" :top 0 :left 0 :right 0)
+ (setf (text-value root-dir) (format nil "~A" (or dir (uiop:getcwd))))
+ (labels ((project-tree-dir-select (node dir)
+ (dolist (item (sort (uiop:subdirectories dir)
+ (lambda (a b)
+ (string-lessp (format nil "~A" a) (format nil "~A" b)))))
+ (create-clog-tree (tree-root node)
+ :fill-function (lambda (obj)
+ (project-tree-dir-select obj (format nil "~A" item)))
+ :indent-level (1+ (indent-level node))
+ :visible nil
+ :on-context-menu
+ (lambda (obj)
+ (let* ((disp (text-value (content obj)))
+ (menu (create-panel obj
+ :left (left obj) :top (top obj)
+ :width (width obj)
+ :class *builder-window-desktop-class*
+ :auto-place :top))
+ (title (create-div menu :content disp))
+ (op (create-div menu :content "Toggle Open" :class *builder-menu-context-item-class*))
+ (ops (create-div menu :content "Open in Pseudo Shell" :class *builder-menu-context-item-class*))
+ (opo (create-div menu :content "Open in OS" :class *builder-menu-context-item-class*))
+ (opd (create-div menu :content "Open in new Tree" :class *builder-menu-context-item-class*))
+ (opr (create-div menu :content "Set as root" :class *builder-menu-context-item-class*))
+ (nwd (create-div menu :content "New subdirectory" :class *builder-menu-context-item-class*))
+ (ren (create-div menu :content "Rename Director" :class *builder-menu-context-item-class*))
+ (del (create-div menu :content "Delete Directory" :class *builder-menu-context-item-class*)))
+ (declare (ignore title op))
+ (set-on-click menu (lambda (i)
+ (declare (ignore i))
+ (destroy menu)))
+ (set-on-click opd (lambda (i)
+ (declare (ignore i))
+ (on-dir-tree obj :dir item))
+ :cancel-event t)
+ (set-on-click opr (lambda (i)
+ (declare (ignore i))
+ (setf (text-value root-dir) item)
+ (jquery-execute root-dir "trigger('change')"))
+ :cancel-event t)
+ (set-on-click ops (lambda (i)
+ (declare (ignore i))
+ (on-shell obj :dir item))
+ :cancel-event t)
+ (set-on-click opo (lambda (i)
+ (declare (ignore i))
+ (open-file-with-os item))
+ :cancel-event t)
+ (set-on-click nwd (lambda (i)
+ (declare (ignore i))
+ (input-dialog obj "Name of new directory?"
+ (lambda (result)
+ (when result
+ (ensure-directories-exist (format nil "~A~A/" item result))
+ (toggle-tree obj)
+ (toggle-tree obj)))
+ :title "New Directory"))
+ :cancel-event t)
+ (set-on-click ren (lambda (i)
+ (declare (ignore i))
+ (input-dialog obj (format nil "Rename ~A to?" disp)
+ (lambda (result)
+ (when result
+ (rename-file item (format nil "~A~A/" dir result))
+ (setf item (format nil "~A~A/" dir result))
+ (setf (text-value (content obj)) result)))
+ :title "Rename Directory"))
+ :cancel-event t)
+ (set-on-click del (lambda (i)
+ (confirm-dialog i (format nil "Delete ~A?" disp)
+ (lambda (result)
+ (when result
+ (handler-case
+ (progn
+ (uiop:delete-empty-directory item)
+ (destroy obj))
+ (error ()
+ (alert-toast obj "Directory Delete Failure"
+ (format nil "Failed to delete ~A, perhaps not empty." item))))))))
+ :cancel-event t)
+ (set-on-mouse-leave menu (lambda (obj) (destroy obj)))))
+ :content (first (last (pathname-directory item)))))
+ (dolist (item (sort (uiop:directory-files (directory-namestring dir))
+ (lambda (a b)
+ (if (equal (pathname-name a) (pathname-name b))
+ (string-lessp (format nil "~A" a) (format nil "~A" b))
+ (string-lessp (format nil "~A" (pathname-name a))
+ (format nil "~A" (pathname-name b)))))))
+ (create-clog-tree-item (tree-root node)
+ :on-context-menu
+ (lambda (obj)
+ (let* ((disp (text-value (content obj)))
+ (menu (create-panel obj
+ :left (left obj) :top (top obj)
+ :width (width obj)
+ :class *builder-window-desktop-class*
+ :auto-place :top))
+ (title (create-div menu :content disp))
+ (op (create-div menu :content "Open" :class *builder-menu-context-item-class*))
+ (oph (create-div menu :content "Open this tab" :class *builder-menu-context-item-class*))
+ (opt (create-div menu :content "Open new tab" :class *builder-menu-context-item-class*))
+ (ope (create-div menu :content "Open emacs" :class *builder-menu-context-item-class*))
+ (opo (create-div menu :content "Open OS default" :class *builder-menu-context-item-class*))
+ (ren (create-div menu :content "Rename" :class *builder-menu-context-item-class*))
+ (del (create-div menu :content "Delete" :class *builder-menu-context-item-class*)))
+ (declare (ignore title op))
+ (set-on-click menu (lambda (i)
+ (declare (ignore i))
+ (destroy menu)))
+ (set-on-click oph (lambda (i)
+ (declare (ignore i))
+ (project-tree-select obj (format nil "~A" item) :method :here))
+ :cancel-event t)
+ (set-on-click opt (lambda (i)
+ (declare (ignore i))
+ (project-tree-select obj (format nil "~A" item) :method :tab))
+ :cancel-event t)
+ (set-on-click ope (lambda (i)
+ (declare (ignore i))
+ (project-tree-select obj (format nil "~A" item) :method :emacs))
+ :cancel-event t)
+ (set-on-click opo (lambda (i)
+ (declare (ignore i))
+ (open-file-with-os item))
+ :cancel-event t)
+ (set-on-click ren (lambda (i)
+ (declare (ignore i))
+ (input-dialog obj (format nil "Rename ~A to?" disp)
+ (lambda (result)
+ (when result
+ (rename-file item (format nil "~A~A" (directory-namestring item) result))
+ (setf item (format nil "~A~A" (directory-namestring item) result))
+ (setf (text-value (content obj)) result)))
+ :title "Rename File"))
+ :cancel-event t)
+ (set-on-click del (lambda (i)
+ (confirm-dialog i (format nil "Delete ~A?" disp)
+ (lambda (result)
+ (when result
+ (uiop:delete-file-if-exists item)
+ (destroy obj)))))
+ :cancel-event t)
+ (set-on-mouse-leave menu (lambda (obj) (destroy obj)))))
+ :on-click (lambda (obj)
+ (project-tree-select obj (format nil "~A" item)))
+ :content (file-namestring item))))
+ (on-change (obj)
+ (declare (ignore obj))
+ (setf (text tree) "")
+ (let* ((root (text-value root-dir))
+ (tname (uiop:truename* root))
+ (dir (format nil "~A" (directory-namestring (if tname
+ tname
+ "")))))
+ (setf (text-value root-dir) dir)
+ (create-clog-tree tree
+ :fill-function (lambda (obj)
+ (project-tree-dir-select obj dir))
+ :content dir
+ :on-context-menu
+ (lambda (obj)
+ (let* ((disp dir)
+ (item dir)
+ (menu (create-panel obj
+ :left (left obj) :top (top obj)
+ :width (width obj)
+ :class *builder-window-desktop-class*
+ :auto-place :top))
+ (title (create-div menu :content disp))
+ (op (create-div menu :content "Toggle Open" :class *builder-menu-context-item-class*))
+ (ops (create-div menu :content "Open Pseudo Shell" :class *builder-menu-context-item-class*))
+ (opo (create-div menu :content "Open in OS" :class *builder-menu-context-item-class*))
+ (nwd (create-div menu :content "New subdirectory" :class *builder-menu-context-item-class*)))
+ (declare (ignore title op))
+ (set-on-click menu (lambda (i)
+ (declare (ignore i))
+ (destroy menu)))
+ (set-on-click ops (lambda (i)
+ (declare (ignore i))
+ (on-shell obj :dir item))
+ :cancel-event t)
+ (set-on-click opo (lambda (i)
+ (declare (ignore i))
+ (open-file-with-os item))
+ :cancel-event t)
+ (set-on-click nwd (lambda (i)
+ (declare (ignore i))
+ (input-dialog obj "Name of new directory?"
+ (lambda (result)
+ (when result
+ (ensure-directories-exist (format nil "~A~A/" dir result))
+ (toggle-tree obj)
+ (toggle-tree obj)))
+ :title "New Directory"))
+ :cancel-event t)
+ (set-on-mouse-leave menu (lambda (obj) (destroy obj)))))))))
+ (set-on-change root-dir #'on-change)
+ (on-change obj))))
\ No newline at end of file
diff --git a/tools/clog-builder-dir-win.lisp b/tools/clog-builder-dir-win.lisp
deleted file mode 100644
index 85d603c..0000000
--- a/tools/clog-builder-dir-win.lisp
+++ /dev/null
@@ -1,104 +0,0 @@
-(in-package :clog-tools)
-
-(defun on-dir-win (obj &key dir top left)
- "Open dir window"
- (let* ((*default-title-class* *builder-title-class*)
- (*default-border-class* *builder-border-class*)
- (win (create-gui-window obj :title "Directory Window"
- :top top :left left
- :width 600 :height 400
- :has-pinner t
- :keep-on-top t
- :client-movement *client-side-movement*))
- (d (create-dir-view (window-content win))))
- (set-geometry d :top 0 :left 0 :right 0 :bottom 0 :width "" :height "")
- (when *open-external*
- (setf (checkedp (open-file-ext d)) t))
- (when dir
- (populate-dir-win d dir))))
-
-(defun on-setup-dir-win (panel)
- (populate-dir-win panel "./")
- (when *open-external*
- (setf (checkedp (open-file-ext panel)) t))
- (when *open-panels-as-popups*
- (setf (checkedp (pop-clog panel)) t)))
-
-(defun populate-dir-win (panel d)
- (let ((dir (directory-namestring (uiop:truename* d))))
- (setf (window-title (current-window panel))
- (format nil "Directory Listing - ~A" dir))
- (setf (current-dir panel) dir)
- ;; Dirs
- (setf (inner-html (folders panel)) "")
- (add-select-option (folders panel)
- (format nil "~A" dir)
- (format nil ". (~A)" dir))
- (unless (or (equalp dir "/") (equalp dir #P"/"))
- (add-select-option (folders panel) (format nil "~A../" dir) ".."))
- (dolist (item (uiop:subdirectories dir))
- (add-select-option (folders panel) item item))
- ;; Files
- (setf (inner-html (files panel)) "")
- (dolist (item (uiop:directory-files (directory-namestring dir)))
- (add-select-option (files panel) item (file-namestring item)))))
-
-(defun on-select-dir-win (panel)
- (let ((item (value (files panel))))
- (unless (equal item "")
- (cond ((and (> (length item) 5)
- (equal (subseq item (- (length item) 5)) ".clog"))
- (if (checkedp (open-file-ext panel))
- (on-new-builder-panel-ext panel :open-file item :open-ext (checkedp (pop-clog panel)))
- (on-new-builder-panel panel :open-file item :open-ext (checkedp (pop-clog panel)))))
- (t
- (if (checkedp (open-file-ext panel))
- (on-open-file-ext panel :open-file item)
- (on-open-file panel :open-file item)))))))
-
-(defun on-delete-dir-win (panel)
- (let ((item (value (files panel))))
- (unless (equal item "")
- (confirm-dialog panel (format nil "Delete ~A?" item)
- (lambda (result)
- (when result
- (uiop:delete-file-if-exists item)
- (populate-dir-win panel (directory-namestring item))))))))
-
-(defun on-new-dir-dir-win (panel)
- (input-dialog panel "Name of new directory?"
- (lambda (result)
- (when result
- (ensure-directories-exist (format nil "~A~A/" (current-dir panel) result))
- (populate-dir-win panel (current-dir panel))))
- :title "New Directory"))
-
-(defun on-delete-dir-dir-win (panel d)
- (let ((dir (directory-namestring (uiop:truename* d))))
- (confirm-dialog panel (format nil "Delete ~A?" dir)
- (lambda (result)
- (when result
- (handler-case
- (uiop:delete-empty-directory dir)
- (error ()
- (alert-toast panel "Directory Delete Failure"
- (format nil "Failed to delete ~A, perhaps not empty." dir))))
- (populate-dir-win panel (current-dir panel)))))))
-
-(defun on-rename-dir-dir-win (panel d)
- (input-dialog panel "Rename directory to?"
- (lambda (result)
- (when result
- (rename-file d (format nil "~A~A/" (current-dir panel) result))
- (populate-dir-win panel (current-dir panel))))
- :title "Rename Directory"))
-
-(defun on-rename-dir-win (panel)
- (let ((item (value (files panel))))
- (unless (equal item "")
- (input-dialog panel "Rename file to?"
- (lambda (result)
- (when result
- (rename-file item (format nil "~A~A" (directory-namestring item) result))
- (populate-dir-win panel (current-dir panel))))
- :title "Rename File"))))
diff --git a/tools/clog-builder-project-tree.lisp b/tools/clog-builder-project-tree.lisp
index d234e3e..09ee03c 100644
--- a/tools/clog-builder-project-tree.lisp
+++ b/tools/clog-builder-project-tree.lisp
@@ -117,7 +117,7 @@
:auto-place :top))
(title (create-div menu :content disp))
(op (create-div menu :content "Toggle Open" :class *builder-menu-context-item-class*))
- (opd (create-div menu :content "Open in Dir Viewer" :class *builder-menu-context-item-class*))
+ (opd (create-div menu :content "Open in Dir Tree" :class *builder-menu-context-item-class*))
(ops (create-div menu :content "Open in Pseudo Shell" :class *builder-menu-context-item-class*))
(opo (create-div menu :content "Open in OS" :class *builder-menu-context-item-class*)))
(declare (ignore title op))
@@ -126,7 +126,7 @@
(destroy menu)))
(set-on-click opd (lambda (i)
(declare (ignore i))
- (on-dir-win obj :dir item))
+ (on-dir-tree obj :dir item))
:cancel-event t)
(set-on-click ops (lambda (i)
(declare (ignore i))
@@ -232,7 +232,7 @@
:auto-place :top))
(title (create-div menu :content disp))
(op (create-div menu :content "Toggle Open" :class *builder-menu-context-item-class*))
- (opd (create-div menu :content "Open in Dir Viewer" :class *builder-menu-context-item-class*))
+ (opd (create-div menu :content "Open in Dir Tree" :class *builder-menu-context-item-class*))
(ops (create-div menu :content "Open Pseudo Shell" :class *builder-menu-context-item-class*))
(opa (create-div menu :content "Open in ASDF Browser" :class *builder-menu-context-item-class*))
(opr (create-div menu :content "Open REPL" :class *builder-menu-context-item-class*))
@@ -243,7 +243,7 @@
(destroy menu)))
(set-on-click opd (lambda (i)
(declare (ignore i))
- (on-dir-win obj :dir item))
+ (on-dir-tree obj :dir item))
:cancel-event t)
(set-on-click ops (lambda (i)
(declare (ignore i))
diff --git a/tools/clog-builder-projects.lisp b/tools/clog-builder-projects.lisp
index 42f4f2b..f2833f0 100644
--- a/tools/clog-builder-projects.lisp
+++ b/tools/clog-builder-projects.lisp
@@ -73,9 +73,9 @@
(defun projects-view-dir (panel)
(let* ((sel (text-value (project-list panel))))
(if (equal sel "None")
- (on-dir-win panel)
+ (on-dir-tree panel)
(let ((sys (asdf:find-system (format nil "~A" sel))))
- (on-dir-win panel :dir (asdf:system-source-directory sys))))))
+ (on-dir-tree panel :dir (asdf:system-source-directory sys))))))
(defun projects-run (panel)
(let ((app (connection-data-item panel "builder-app-data"))
diff --git a/tools/clog-builder.lisp b/tools/clog-builder.lisp
index 85f542b..6fcd6ea 100644
--- a/tools/clog-builder.lisp
+++ b/tools/clog-builder.lisp
@@ -382,8 +382,8 @@ clog-builder window.")
;; Menu -> Project
(create-gui-menu-item src :content "Project Tree" :on-click 'on-project-tree)
(create-gui-menu-item src :content "ASD Project Window" :on-click 'on-show-project)
+ (create-gui-menu-item src :content "New Directory Tree" :on-click 'on-dir-tree)
(create-gui-menu-item src :content "New Project from template" :on-click 'on-new-app-template)
- (create-gui-menu-item src :content "New OS Directory Browser" :on-click 'on-dir-win)
(create-gui-menu-item src :content "New System Source Browser" :on-click 'on-new-sys-browser)
(create-gui-menu-item src :content "New Loaded ASDF System Browser" :on-click 'on-new-asdf-browser)
;; Menu -> Tools
@@ -448,7 +448,7 @@ clog-builder window.")
(open-window (window body) "https://github.com/rabbibotton/clog/blob/main/LEARN.md")))
(create-gui-menu-item help :content "Tutorials DIR" :on-click
(lambda (obj)
- (on-dir-win obj :dir (merge-pathnames "./tutorial/"
+ (on-dir-tree obj :dir (merge-pathnames "./tutorial/"
(asdf:system-source-directory :clog)))))
(create-gui-menu-item help :content "ParenScript Reference" :on-click
(lambda (obj)
@@ -499,13 +499,10 @@ clog-builder window.")
(on-project-tree body :project *start-project*)
(when *start-dir*
(handler-case
- (on-dir-win body :dir *start-dir*)
+ (on-dir-tree body :dir *start-dir*)
(error (msg)
(alert-toast body "Directory Error" (format nil "Unable to open directory ~A. ~A" *start-dir* msg))
- (setf *start-dir* nil)))
- (set-geometry (current-window body) :top 38 :left "" :right 5 :height "" :bottom 22)
- (set-geometry (current-window body) :height (height (current-window body))
- :bottom (bottom (current-window body))))))
+ (setf *start-dir* nil))))))
(set-on-before-unload (window body) (lambda(obj)
(declare (ignore obj))
;; return empty string to prevent nav off page
@@ -537,12 +534,15 @@ clog-builder window.")
(defun clog-builder (&key (port 8080) (start-browser t)
app project dir static-root system clogframe)
- "Start clog-builder. When PORT is 0 choose a random port. When APP is
-t, shutdown applicatoin on termination of first window. If APP eq :BATCH then
-must specific default project :PROJECT and it will be batch rerendered
-and shutdown application. You can set the specific STATIC-ROOT or set SYSTEM
-to use that asdf system's static root. if DIR then the directory window
-instead of the project window will be displayed."
+ "Start clog-builder.
+ :PROJECT - load ASDF Project, start its static root and set as current
+ :DIR - Start with directory tree set to dir
+ :PORT - default 8080, use 0 for random open port
+ :APP - start in app mode shutdown application on termination
+ If APP eq :BATCH then must specify the default project :PROJECT
+ and it will be batch rerendered and shutdown after.
+ :STATIC-ROOT - set static-root dir manually.
+ :SYSTEM - Use projects's asdf system's static root."
(setf *preferances-file*
(format nil "~A/preferences.lisp"
(merge-pathnames "tools"
@@ -555,8 +555,7 @@ instead of the project window will be displayed."
(if project
(progn
(setf *start-project* (string-downcase (format nil "~A" project)))
- (setf *start-dir* (format nil "~A" (asdf:system-source-directory project)))
- (setf static-root (merge-pathnames "./www/" *start-dir*)))
+ (setf static-root (merge-pathnames "./www/" (format nil "~A" (asdf:system-source-directory project)))))
(setf *start-project* nil))
(when dir
(setf *start-dir* dir))
@@ -598,7 +597,8 @@ instead of the project window will be displayed."
(when start-browser
(format t "~%If browser does not start go to http://127.0.0.1:~A/builder~%~%" port)
(open-browser :url (format nil "http://127.0.0.1:~A/builder" port))))
-
+
+#+windows
(in-package #:quicklisp-client)
;; patch, if-exists of :rename-and-delete does not work well on windows
diff --git a/tools/panel-dir-view.clog b/tools/panel-dir-view.clog
deleted file mode 100644
index 1268f99..0000000
--- a/tools/panel-dir-view.clog
+++ /dev/null
@@ -1 +0,0 @@
-
\ No newline at end of file
diff --git a/tools/panel-dir-view.lisp b/tools/panel-dir-view.lisp
deleted file mode 100644
index a18ff15..0000000
--- a/tools/panel-dir-view.lisp
+++ /dev/null
@@ -1,117 +0,0 @@
-;;;; CLOG Builder generated code - modify original .clog file and rerender
-(in-package :clog-tools)
-(defclass dir-view (clog:clog-panel)
- ((pop-clog-lavel :reader pop-clog-lavel) (pop-clog :reader pop-clog)
- (open-ext-label :reader open-ext-label)
- (open-file-ext :reader open-file-ext)
- (rename-button :reader rename-button)
- (del-button :reader del-button) (open-button :reader open-button)
- (rename-dir-button :reader rename-dir-button)
- (del-dir-button :reader del-dir-button)
- (new-dir-button :reader new-dir-button)
- (open-dir-button :reader open-dir-button) (files :reader files)
- (divider :reader divider) (folders :reader folders)
- (current-dir :accessor current-dir :initform ".")))
-(defun create-dir-view
- (clog-obj &key (hidden nil) (class nil) (html-id nil) (auto-place t))
- (let ((panel
- (change-class
- (clog:create-div clog-obj :content
- ""
- :hidden hidden :class class :html-id html-id
- :auto-place auto-place)
- 'dir-view)))
- (setf (slot-value panel 'pop-clog-lavel)
- (attach-as-child clog-obj "CLOGB3920294030" :clog-type
- 'clog:clog-label :new-id t))
- (setf (slot-value panel 'pop-clog)
- (attach-as-child clog-obj "CLOGB3920294029" :clog-type
- 'clog:clog-form-element :new-id t))
- (setf (slot-value panel 'open-ext-label)
- (attach-as-child clog-obj "CLOGB3920294028" :clog-type
- 'clog:clog-label :new-id t))
- (setf (slot-value panel 'open-file-ext)
- (attach-as-child clog-obj "CLOGB3920294027" :clog-type
- 'clog:clog-form-element :new-id t))
- (setf (slot-value panel 'rename-button)
- (attach-as-child clog-obj "CLOGB3920294026" :clog-type
- 'clog:clog-form-element :new-id t))
- (setf (slot-value panel 'del-button)
- (attach-as-child clog-obj "CLOGB3920294025" :clog-type
- 'clog:clog-form-element :new-id t))
- (setf (slot-value panel 'open-button)
- (attach-as-child clog-obj "CLOGB3920294024" :clog-type
- 'clog:clog-form-element :new-id t))
- (setf (slot-value panel 'rename-dir-button)
- (attach-as-child clog-obj "CLOGB3920294023" :clog-type
- 'clog:clog-form-element :new-id t))
- (setf (slot-value panel 'del-dir-button)
- (attach-as-child clog-obj "CLOGB3920294022" :clog-type
- 'clog:clog-form-element :new-id t))
- (setf (slot-value panel 'new-dir-button)
- (attach-as-child clog-obj "CLOGB3920294021" :clog-type
- 'clog:clog-form-element :new-id t))
- (setf (slot-value panel 'open-dir-button)
- (attach-as-child clog-obj "CLOGB3920294020" :clog-type
- 'clog:clog-form-element :new-id t))
- (setf (slot-value panel 'files)
- (attach-as-child clog-obj "CLOGB3920294019" :clog-type
- 'clog:clog-select :new-id t))
- (setf (slot-value panel 'divider)
- (attach-as-child clog-obj "CLOGB3920294018" :clog-type
- 'clog:clog-div :new-id t))
- (setf (slot-value panel 'folders)
- (attach-as-child clog-obj "CLOGB3920294017" :clog-type
- 'clog:clog-select :new-id t))
- (let ((target (folders panel)))
- (declare (ignorable target))
- (on-setup-dir-win panel))
- (let ((target (open-ext-label panel)))
- (declare (ignorable target))
- (setf (attribute target "for")
- (clog:js-query target
- "$('[data-clog-name=\\'open-file-ext\\']').attr('id')")))
- (let ((target (pop-clog-lavel panel)))
- (declare (ignorable target))
- (setf (attribute target "for")
- (clog:js-query target
- "$('[data-clog-name=\\'pop-clog\\']').attr('id')")))
- (clog:set-on-mouse-double-click (folders panel)
- (lambda (target data)
- (declare (ignorable target data))
- (populate-dir-win panel (value target))))
- (clog:set-on-double-click (files panel)
- (lambda (target)
- (declare (ignorable target))
- (on-select-dir-win panel)))
- (clog:set-on-click (open-dir-button panel)
- (lambda (target)
- (declare (ignorable target))
- (populate-dir-win panel (value (folders panel)))))
- (clog:set-on-click (new-dir-button panel)
- (lambda (target)
- (declare (ignorable target))
- (on-new-dir-dir-win panel)))
- (clog:set-on-click (del-dir-button panel)
- (lambda (target)
- (declare (ignorable target))
- (on-delete-dir-dir-win panel
- (value (folders panel)))))
- (clog:set-on-click (rename-dir-button panel)
- (lambda (target)
- (declare (ignorable target))
- (on-rename-dir-dir-win panel
- (value (folders panel)))))
- (clog:set-on-click (open-button panel)
- (lambda (target)
- (declare (ignorable target))
- (on-select-dir-win panel)))
- (clog:set-on-click (del-button panel)
- (lambda (target)
- (declare (ignorable target))
- (on-delete-dir-win panel)))
- (clog:set-on-click (rename-button panel)
- (lambda (target)
- (declare (ignorable target))
- (on-rename-dir-win panel)))
- panel))
\ No newline at end of file
diff --git a/tools/panel-systems.clog b/tools/panel-systems.clog
index 02b0146..9876527 100644
--- a/tools/panel-systems.clog
+++ b/tools/panel-systems.clog
@@ -11,4 +11,4 @@
(projects-load fname)
(setf (text-value (loaded-systems panel)) fname)
(asdf-browser-populate panel))
-">Reload
\ No newline at end of file
+">Reload
diff --git a/tools/panel-systems.lisp b/tools/panel-systems.lisp
index 8b57800..ae13a12 100644
--- a/tools/panel-systems.lisp
+++ b/tools/panel-systems.lisp
@@ -155,7 +155,7 @@
(clog:set-on-click (dir-button panel)
(lambda (target)
(declare (ignorable target))
- (on-dir-win panel :dir
+ (on-dir-tree panel :dir
(asdf:system-source-directory
(text-value (loaded-systems panel))))))
panel))