mirror of
https://github.com/rabbibotton/clog.git
synced 2025-12-06 10:40:45 -08:00
fix source editor in new tab not openning
This commit is contained in:
David Botton
parent
249e8450b8
commit
dfc8d60c2d
3 changed files with 121 additions and 123 deletions
|
|
@ -45,3 +45,121 @@
|
||||||
(setf (positioning control-list) :absolute)
|
(setf (positioning control-list) :absolute)
|
||||||
(set-geometry control-list :left 0 :top 0 :right 0)))
|
(set-geometry control-list :left 0 :top 0 :right 0)))
|
||||||
|
|
||||||
|
(defun on-populate-control-properties-win (obj &key win)
|
||||||
|
"Populate the control properties for the current control"
|
||||||
|
;; obj if current-control is nil must be content
|
||||||
|
(with-sync-event (obj)
|
||||||
|
(bordeaux-threads:make-thread (lambda () (on-populate-control-events-win obj)))
|
||||||
|
(let ((app (connection-data-item obj "builder-app-data")))
|
||||||
|
(let* ((prop-win (control-properties-win app))
|
||||||
|
(control (if (current-control app)
|
||||||
|
(current-control app)
|
||||||
|
obj))
|
||||||
|
(placer (when control
|
||||||
|
(get-placer control)))
|
||||||
|
(table (properties-list app)))
|
||||||
|
(when prop-win
|
||||||
|
(setf (inner-html table) "")
|
||||||
|
(let ((info (control-info (attribute control "data-clog-type")))
|
||||||
|
props)
|
||||||
|
(dolist (prop (reverse (getf info :properties)))
|
||||||
|
(cond ((eq (third prop) :style)
|
||||||
|
(push `(,(getf prop :name) ,(style control (getf prop :style)) ,(getf prop :setup)
|
||||||
|
,(lambda (obj)
|
||||||
|
(setf (style control (getf prop :style)) (text obj))))
|
||||||
|
props))
|
||||||
|
((or (eq (third prop) :get)
|
||||||
|
(eq (third prop) :set)
|
||||||
|
(eq (third prop) :setup))
|
||||||
|
(push `(,(getf prop :name) ,(when (getf prop :get)
|
||||||
|
(funcall (getf prop :get) control))
|
||||||
|
,(getf prop :setup)
|
||||||
|
,(lambda (obj)
|
||||||
|
(when (getf prop :set)
|
||||||
|
(funcall (getf prop :set) control obj))))
|
||||||
|
props))
|
||||||
|
((eq (third prop) :prop)
|
||||||
|
(push `(,(getf prop :name) ,(property control (getf prop :prop)) ,(getf prop :setup)
|
||||||
|
,(lambda (obj)
|
||||||
|
(setf (property control (getf prop :prop)) (text obj))))
|
||||||
|
props))
|
||||||
|
((eq (third prop) :attr)
|
||||||
|
(push `(,(getf prop :name) ,(attribute control (getf prop :attr)) ,(getf prop :setup)
|
||||||
|
,(lambda (obj)
|
||||||
|
(setf (attribute control (getf prop :attr)) (text obj))))
|
||||||
|
props))
|
||||||
|
(t (print "Configuration error."))))
|
||||||
|
(when (current-control app)
|
||||||
|
(let* (panel-controls
|
||||||
|
(cname (attribute control "data-clog-name"))
|
||||||
|
(panel-id (attribute placer "data-panel-id"))
|
||||||
|
(panel (attach-as-child obj panel-id)))
|
||||||
|
(maphash (lambda (k v)
|
||||||
|
(declare (ignore k))
|
||||||
|
(let ((n (attribute v "data-clog-name"))
|
||||||
|
(p (attribute (parent-element v) "data-clog-name")))
|
||||||
|
(unless (or (equal cname n)
|
||||||
|
(equal cname p))
|
||||||
|
(push n panel-controls))))
|
||||||
|
(get-control-list app panel-id))
|
||||||
|
(push (attribute panel "data-clog-name") panel-controls)
|
||||||
|
(push
|
||||||
|
`("parent" nil
|
||||||
|
,(lambda (control td1 td2)
|
||||||
|
(declare (ignore td1))
|
||||||
|
(let ((dd (create-select td2))
|
||||||
|
(v (attribute (parent-element control) "data-clog-name")))
|
||||||
|
(set-geometry dd :width "100%")
|
||||||
|
(add-select-options dd panel-controls)
|
||||||
|
(setf (value dd) v)
|
||||||
|
(set-on-change dd
|
||||||
|
(lambda (obj)
|
||||||
|
(place-inside-bottom-of
|
||||||
|
(attach-as-child control
|
||||||
|
(js-query
|
||||||
|
control
|
||||||
|
(format nil "$(\"[data-clog-name='~A']\").attr('id')"
|
||||||
|
(value obj))))
|
||||||
|
control)
|
||||||
|
(place-after control placer)
|
||||||
|
(on-populate-control-list-win panel :win win))))
|
||||||
|
nil)
|
||||||
|
nil)
|
||||||
|
props)
|
||||||
|
(push
|
||||||
|
`("name" ,cname
|
||||||
|
nil
|
||||||
|
,(lambda (obj)
|
||||||
|
(let ((vname (text obj)))
|
||||||
|
(unless (equal vname "")
|
||||||
|
(when (equal (subseq vname 0 1) "(")
|
||||||
|
(setf vname (format nil "|~A|" vname)))
|
||||||
|
(setf (attribute control "data-clog-name") vname)
|
||||||
|
(when (equal (getf info :name) "clog-data")
|
||||||
|
(when win
|
||||||
|
(setf (window-title win) vname)))))))
|
||||||
|
props)))
|
||||||
|
(dolist (item props)
|
||||||
|
(let* ((tr (create-table-row table))
|
||||||
|
(td1 (create-table-column tr :content (first item)))
|
||||||
|
(td2 (if (second item)
|
||||||
|
(create-table-column tr :content (second item))
|
||||||
|
(create-table-column tr))))
|
||||||
|
(setf (width td1) "30%")
|
||||||
|
(setf (width td2) "70%")
|
||||||
|
(setf (spellcheckp td2) nil)
|
||||||
|
(set-border td1 "1px" :dotted :black)
|
||||||
|
(cond ((third item)
|
||||||
|
(unless (eq (third item) :read-only)
|
||||||
|
(setf (editablep td2) (funcall (third item) control td1 td2))))
|
||||||
|
(t
|
||||||
|
(setf (editablep td2) t)))
|
||||||
|
(set-on-blur td2
|
||||||
|
(lambda (obj)
|
||||||
|
(funcall (fourth item) obj)
|
||||||
|
(when placer
|
||||||
|
(jquery-execute placer "trigger('clog-builder-snap-shot')")
|
||||||
|
(set-geometry placer :top (position-top control)
|
||||||
|
:left (position-left control)
|
||||||
|
:width (client-width control)
|
||||||
|
:height (client-height control)))))))))))))
|
||||||
|
|
|
||||||
|
|
@ -169,7 +169,8 @@
|
||||||
(error (condition)
|
(error (condition)
|
||||||
(alert-toast obj "File Error" (format nil "Error: ~A" condition))
|
(alert-toast obj "File Error" (format nil "Error: ~A" condition))
|
||||||
(format t "Error: ~A" condition)))))
|
(format t "Error: ~A" condition)))))
|
||||||
(when open-file
|
(when (and open-file
|
||||||
|
(not (equalp open-file " ")))
|
||||||
(open-file-name open-file))
|
(open-file-name open-file))
|
||||||
(set-on-click btn-load (lambda (obj)
|
(set-on-click btn-load (lambda (obj)
|
||||||
(server-file-dialog obj "Load Source" (directory-namestring (if (equal file-name "")
|
(server-file-dialog obj "Load Source" (directory-namestring (if (equal file-name "")
|
||||||
|
|
|
||||||
|
|
@ -168,127 +168,6 @@ clog-builder window.")
|
||||||
:initform (make-hash-table* :test #'equalp)
|
:initform (make-hash-table* :test #'equalp)
|
||||||
:documentation "Panel -> Control List - hash table")))
|
:documentation "Panel -> Control List - hash table")))
|
||||||
|
|
||||||
;; Population of utility windows
|
|
||||||
|
|
||||||
(defun on-populate-control-properties-win (obj &key win)
|
|
||||||
"Populate the control properties for the current control"
|
|
||||||
;; obj if current-control is nil must be content
|
|
||||||
(with-sync-event (obj)
|
|
||||||
(bordeaux-threads:make-thread (lambda () (on-populate-control-events-win obj)))
|
|
||||||
(let ((app (connection-data-item obj "builder-app-data")))
|
|
||||||
(let* ((prop-win (control-properties-win app))
|
|
||||||
(control (if (current-control app)
|
|
||||||
(current-control app)
|
|
||||||
obj))
|
|
||||||
(placer (when control
|
|
||||||
(get-placer control)))
|
|
||||||
(table (properties-list app)))
|
|
||||||
(when prop-win
|
|
||||||
(setf (inner-html table) "")
|
|
||||||
(let ((info (control-info (attribute control "data-clog-type")))
|
|
||||||
props)
|
|
||||||
(dolist (prop (reverse (getf info :properties)))
|
|
||||||
(cond ((eq (third prop) :style)
|
|
||||||
(push `(,(getf prop :name) ,(style control (getf prop :style)) ,(getf prop :setup)
|
|
||||||
,(lambda (obj)
|
|
||||||
(setf (style control (getf prop :style)) (text obj))))
|
|
||||||
props))
|
|
||||||
((or (eq (third prop) :get)
|
|
||||||
(eq (third prop) :set)
|
|
||||||
(eq (third prop) :setup))
|
|
||||||
(push `(,(getf prop :name) ,(when (getf prop :get)
|
|
||||||
(funcall (getf prop :get) control))
|
|
||||||
,(getf prop :setup)
|
|
||||||
,(lambda (obj)
|
|
||||||
(when (getf prop :set)
|
|
||||||
(funcall (getf prop :set) control obj))))
|
|
||||||
props))
|
|
||||||
((eq (third prop) :prop)
|
|
||||||
(push `(,(getf prop :name) ,(property control (getf prop :prop)) ,(getf prop :setup)
|
|
||||||
,(lambda (obj)
|
|
||||||
(setf (property control (getf prop :prop)) (text obj))))
|
|
||||||
props))
|
|
||||||
((eq (third prop) :attr)
|
|
||||||
(push `(,(getf prop :name) ,(attribute control (getf prop :attr)) ,(getf prop :setup)
|
|
||||||
,(lambda (obj)
|
|
||||||
(setf (attribute control (getf prop :attr)) (text obj))))
|
|
||||||
props))
|
|
||||||
(t (print "Configuration error."))))
|
|
||||||
(when (current-control app)
|
|
||||||
(let* (panel-controls
|
|
||||||
(cname (attribute control "data-clog-name"))
|
|
||||||
(panel-id (attribute placer "data-panel-id"))
|
|
||||||
(panel (attach-as-child obj panel-id)))
|
|
||||||
(maphash (lambda (k v)
|
|
||||||
(declare (ignore k))
|
|
||||||
(let ((n (attribute v "data-clog-name"))
|
|
||||||
(p (attribute (parent-element v) "data-clog-name")))
|
|
||||||
(unless (or (equal cname n)
|
|
||||||
(equal cname p))
|
|
||||||
(push n panel-controls))))
|
|
||||||
(get-control-list app panel-id))
|
|
||||||
(push (attribute panel "data-clog-name") panel-controls)
|
|
||||||
(push
|
|
||||||
`("parent" nil
|
|
||||||
,(lambda (control td1 td2)
|
|
||||||
(declare (ignore td1))
|
|
||||||
(let ((dd (create-select td2))
|
|
||||||
(v (attribute (parent-element control) "data-clog-name")))
|
|
||||||
(set-geometry dd :width "100%")
|
|
||||||
(add-select-options dd panel-controls)
|
|
||||||
(setf (value dd) v)
|
|
||||||
(set-on-change dd
|
|
||||||
(lambda (obj)
|
|
||||||
(place-inside-bottom-of
|
|
||||||
(attach-as-child control
|
|
||||||
(js-query
|
|
||||||
control
|
|
||||||
(format nil "$(\"[data-clog-name='~A']\").attr('id')"
|
|
||||||
(value obj))))
|
|
||||||
control)
|
|
||||||
(place-after control placer)
|
|
||||||
(on-populate-control-list-win panel :win win))))
|
|
||||||
nil)
|
|
||||||
nil)
|
|
||||||
props)
|
|
||||||
(push
|
|
||||||
`("name" ,cname
|
|
||||||
nil
|
|
||||||
,(lambda (obj)
|
|
||||||
(let ((vname (text obj)))
|
|
||||||
(unless (equal vname "")
|
|
||||||
(when (equal (subseq vname 0 1) "(")
|
|
||||||
(setf vname (format nil "|~A|" vname)))
|
|
||||||
(setf (attribute control "data-clog-name") vname)
|
|
||||||
(when (equal (getf info :name) "clog-data")
|
|
||||||
(when win
|
|
||||||
(setf (window-title win) vname)))))))
|
|
||||||
props)))
|
|
||||||
(dolist (item props)
|
|
||||||
(let* ((tr (create-table-row table))
|
|
||||||
(td1 (create-table-column tr :content (first item)))
|
|
||||||
(td2 (if (second item)
|
|
||||||
(create-table-column tr :content (second item))
|
|
||||||
(create-table-column tr))))
|
|
||||||
(setf (width td1) "30%")
|
|
||||||
(setf (width td2) "70%")
|
|
||||||
(setf (spellcheckp td2) nil)
|
|
||||||
(set-border td1 "1px" :dotted :black)
|
|
||||||
(cond ((third item)
|
|
||||||
(unless (eq (third item) :read-only)
|
|
||||||
(setf (editablep td2) (funcall (third item) control td1 td2))))
|
|
||||||
(t
|
|
||||||
(setf (editablep td2) t)))
|
|
||||||
(set-on-blur td2
|
|
||||||
(lambda (obj)
|
|
||||||
(funcall (fourth item) obj)
|
|
||||||
(when placer
|
|
||||||
(jquery-execute placer "trigger('clog-builder-snap-shot')")
|
|
||||||
(set-geometry placer :top (position-top control)
|
|
||||||
:left (position-left control)
|
|
||||||
:width (client-width control)
|
|
||||||
:height (client-height control)))))))))))))
|
|
||||||
|
|
||||||
;; Show windows
|
;; Show windows
|
||||||
|
|
||||||
(defun on-show-copy-history-win (obj)
|
(defun on-show-copy-history-win (obj)
|
||||||
|
|
@ -485,7 +364,7 @@ clog-builder window.")
|
||||||
(create-gui-menu-item src :content "New Source Editor (New Tab)" :on-click
|
(create-gui-menu-item src :content "New Source Editor (New Tab)" :on-click
|
||||||
(lambda (obj)
|
(lambda (obj)
|
||||||
(declare (ignore obj))
|
(declare (ignore obj))
|
||||||
(open-window (window body) "/source-editor")))
|
(open-window (window body) "/source-editor?open-file=%20")))
|
||||||
(create-gui-menu-item src :content "New System Browser" :on-click 'on-new-sys-browser)
|
(create-gui-menu-item src :content "New System Browser" :on-click 'on-new-sys-browser)
|
||||||
(create-gui-menu-item src :content "New ASDF System Browser" :on-click 'on-new-asdf-browser)
|
(create-gui-menu-item src :content "New ASDF System Browser" :on-click 'on-new-asdf-browser)
|
||||||
(create-gui-menu-item tools :content "Control CLOG Events" :on-click 'on-show-control-events-win)
|
(create-gui-menu-item tools :content "Control CLOG Events" :on-click 'on-show-control-events-win)
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue