diff --git a/source/clog-base.lisp b/source/clog-base.lisp index dfec400..c376ee4 100644 --- a/source/clog-base.lisp +++ b/source/clog-base.lisp @@ -35,12 +35,23 @@ See macro with-connection-cache.") (html-id :reader html-id :initarg :html-id) + (parent + :accessor parent + :initform nil) (connection-data-mutex :reader connection-data-mutex :initform (bordeaux-threads:make-lock))) (:documentation "CLOG objects (clog-obj) encapsulate the connection between lisp and an HTML DOM element.")) +;;;;;;;;;;;;;;;;;;; +;; create-parent ;; +;;;;;;;;;;;;;;;;;;; + +(defgeneric parent (clog-obj) + (:documentation "Returns the clog-obj of the obj that was used as creation +parent if was set or nil. This is not per se the parent in the DOM.")) + ;;;;;;;;;;;;;;;;;;; ;; connection-id ;; ;;;;;;;;;;;;;;;;;;; diff --git a/source/clog-element.lisp b/source/clog-element.lisp index a255f62..e8aa291 100644 --- a/source/clog-element.lisp +++ b/source/clog-element.lisp @@ -121,6 +121,7 @@ CLOG-OBJ. If HTML-ID is nil one will be generated.")) (let ((child (create-with-html (connection-id obj) (escape-string html) :clog-type clog-type :html-id html-id))) + (setf (parent child) obj) (if auto-place (case auto-place (:bottom (place-inside-bottom-of obj child)) @@ -149,7 +150,9 @@ after attachment is changed to one unique to this session.")) (setf html-id id)) (js-execute obj (format nil "clog['~A']=$('#~A').get(0)" html-id html-id))) - (make-clog-element (connection-id obj) html-id :clog-type clog-type)) + (let ((child (make-clog-element (connection-id obj) html-id :clog-type clog-type))) + (setf (parent child) obj) + child)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; General Properties - clog-element diff --git a/source/clog.lisp b/source/clog.lisp index 04df644..91a4fc3 100644 --- a/source/clog.lisp +++ b/source/clog.lisp @@ -118,7 +118,8 @@ embedded in a native template application.)" (defsection @clog-obj (:title "CLOG Objects") "CLOG-Obj - Base class for CLOG Objects" - (clog-obj class) + (clog-obj class) + (parent generic-function) "CLOG-Obj - General Properties" (property generic-function) diff --git a/tools/clog-builder-repl.lisp b/tools/clog-builder-repl.lisp index d07c9a2..09cc218 100644 --- a/tools/clog-builder-repl.lisp +++ b/tools/clog-builder-repl.lisp @@ -17,19 +17,23 @@ (on-open-console panel))) (defun repl-on-commmand (panel target data) - (if (equalp data "(clog-builder-repl)") - (let* ((*default-title-class* *builder-title-class*) - (*default-border-class* *builder-border-class*) - (win (create-gui-window panel :title "CLOG Builder REPL GUI Window" - :height 400 :width 600 - :has-pinner t - :client-movement *client-side-movement*))) - (setf clog-user::*body* (window-content win))) - (multiple-value-bind (result new-package) - (capture-eval data :clog-obj panel - :capture-console (not *clog-repl-use-console*) - :capture-result (not *clog-repl-send-result-to-console*) - :eval-in-package (text-value (package-div panel))) - (setf (text-value (package-div panel)) - (string-downcase (package-name new-package))) - (clog-terminal:echo target result)))) \ No newline at end of file + (cond ((or (equalp data ":e") + (equalp data ":q")) + (window-close (parent (parent panel)))) + ((equalp data "(clog-builder-repl)") + (let* ((*default-title-class* *builder-title-class*) + (*default-border-class* *builder-border-class*) + (win (create-gui-window panel :title "CLOG Builder REPL GUI Window" + :height 400 :width 600 + :has-pinner t + :client-movement *client-side-movement*))) + (setf clog-user::*body* (window-content win)))) + (t + (multiple-value-bind (result new-package) + (capture-eval data :clog-obj panel + :capture-console (not *clog-repl-use-console*) + :capture-result (not *clog-repl-send-result-to-console*) + :eval-in-package (text-value (package-div panel))) + (setf (text-value (package-div panel)) + (string-downcase (package-name new-package))) + (clog-terminal:echo target result))))) \ No newline at end of file diff --git a/tools/clog-builder-shell.lisp b/tools/clog-builder-shell.lisp index 6d7849e..b9799a6 100644 --- a/tools/clog-builder-shell.lisp +++ b/tools/clog-builder-shell.lisp @@ -19,33 +19,36 @@ (defun shell-on-commmand (panel target data) (handler-case - (if (and (> (length data) 3) - (equalp (subseq data 0 3) "cd ")) - (let* ((dir (subseq data 3 (length data))) - (wc (when (> (length dir) 2) (char dir 1))) - (sw (char dir 0))) - (uiop:with-current-directory ((format nil "~A~A" - (if (or (equal wc #\:) - (equal sw (uiop:directory-separator-for-host)) - (equal sw #\~)) - dir - (format nil "~A~A~A" - (text-value (package-div panel)) - (uiop:directory-separator-for-host) - dir)) - (uiop:directory-separator-for-host))) - (setf (text-value (package-div panel)) (uiop:getcwd)))) - (uiop:with-current-directory ((text-value (package-div panel))) - (multiple-value-bind (result new-package new-dir) - (capture-eval (format nil "(uiop:run-program \"~A\" :output *standard-output*)(uiop:getcwd)" - (ppcre:regex-replace-all "\\" data "\\\\\\")) - :clog-obj panel - :eval-form "~A" - :capture-result-form "" - :capture-console t - :capture-result nil) - (declare (ignore new-package)) - (setf (text-value (package-div panel)) new-dir) - (clog-terminal:echo target result)))) + (cond ((and (> (length data) 3) + (equalp (subseq data 0 3) "cd ")) + (let* ((dir (subseq data 3 (length data))) + (wc (when (> (length dir) 2) (char dir 1))) + (sw (char dir 0))) + (uiop:with-current-directory ((format nil "~A~A" + (if (or (equal wc #\:) + (equal sw (uiop:directory-separator-for-host)) + (equal sw #\~)) + dir + (format nil "~A~A~A" + (text-value (package-div panel)) + (uiop:directory-separator-for-host) + dir)) + (uiop:directory-separator-for-host))) + (setf (text-value (package-div panel)) (uiop:getcwd))))) + ((equalp data "exit") + (window-close (parent (parent panel)))) + (t + (uiop:with-current-directory ((text-value (package-div panel))) + (multiple-value-bind (result new-package new-dir) + (capture-eval (format nil "(uiop:run-program \"~A\" :output *standard-output*)(uiop:getcwd)" + (ppcre:regex-replace-all "\\" data "\\\\\\")) + :clog-obj panel + :eval-form "~A" + :capture-result-form "" + :capture-console t + :capture-result nil) + (declare (ignore new-package)) + (setf (text-value (package-div panel)) new-dir) + (clog-terminal:echo target result))))) (error (c) (clog-terminal:echo target (format nil "~A" c)))))