From dfc8d60c2db93b09d9a6a55e22dd989ef40111c9 Mon Sep 17 00:00:00 2001 From: David Botton Date: Wed, 20 Mar 2024 07:51:14 -0400 Subject: [PATCH] fix source editor in new tab not openning --- tools/clog-builder-control-properties.lisp | 118 ++++++++++++++++++++ tools/clog-builder-files.lisp | 3 +- tools/clog-builder.lisp | 123 +-------------------- 3 files changed, 121 insertions(+), 123 deletions(-) diff --git a/tools/clog-builder-control-properties.lisp b/tools/clog-builder-control-properties.lisp index fbf390a..772403d 100644 --- a/tools/clog-builder-control-properties.lisp +++ b/tools/clog-builder-control-properties.lisp @@ -45,3 +45,121 @@ (setf (positioning control-list) :absolute) (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))))))))))))) diff --git a/tools/clog-builder-files.lisp b/tools/clog-builder-files.lisp index d7f12f9..9057b25 100644 --- a/tools/clog-builder-files.lisp +++ b/tools/clog-builder-files.lisp @@ -169,7 +169,8 @@ (error (condition) (alert-toast obj "File Error" (format nil "Error: ~A" condition)) (format t "Error: ~A" condition))))) - (when open-file + (when (and open-file + (not (equalp open-file " "))) (open-file-name open-file)) (set-on-click btn-load (lambda (obj) (server-file-dialog obj "Load Source" (directory-namestring (if (equal file-name "") diff --git a/tools/clog-builder.lisp b/tools/clog-builder.lisp index 2eae122..cbb6b44 100644 --- a/tools/clog-builder.lisp +++ b/tools/clog-builder.lisp @@ -168,127 +168,6 @@ clog-builder window.") :initform (make-hash-table* :test #'equalp) :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 (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 (lambda (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 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)