mirrors/clog
1
Fork 0
mirror of https://github.com/rabbibotton/clog.git synced 2025-12-06 02:30:42 -08:00
Code Issues Projects Releases Wiki Activity

clog:parent returns parent object used to create the clog-obj

Browse source
This commit is contained in:
David Botton 2024-04-12 13:36:40 -04:00
parent aa0e567ae4
commit 9e5f9184d7
5 changed files with 68 additions and 46 deletions
Download patch file Download diff file Expand all files Collapse all files

11
source/clog-base.lisp
View file

@ -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 ;;
;;;;;;;;;;;;;;;;;;;

5
source/clog-element.lisp
View file

@ -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

3
source/clog.lisp
View file

@ -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)

36
tools/clog-builder-repl.lisp
View file

@ -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))))
(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)))))

59
tools/clog-builder-shell.lisp
View file

@ -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)))))