diff --git a/source/clog-gui.lisp b/source/clog-gui.lisp
index 7f59b7f..06497b8 100644
--- a/source/clog-gui.lisp
+++ b/source/clog-gui.lisp
@@ -39,6 +39,10 @@
(menu-bar generic-function)
(menu-bar-height generic-function)
(window-collection generic-function)
+ (window-to-top-by-title generic-function)
+ (window-to-top-by-param generic-function)
+ (window-by-title generic-function)
+ (window-by-param generic-function)
(maximize-all-windows generic-function)
(normalize-all-windows generic-function)
(set-on-window-change generic-function)
@@ -47,6 +51,7 @@
(clog-gui-window class)
(create-gui-window generic-function)
(window-title generic-function)
+ (window-param generic-function)
(window-content generic-function)
(window-focus generic-function)
(window-close generic-function)
@@ -250,6 +255,80 @@ create-gui-menu-bar."))
(let ((app (connection-data-item obj "clog-gui")))
(windows app)))
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; window-to-top-by-title ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defgeneric window-to-top-by-title (clog-obj title)
+ (:documentation "Bring window with TITLE to top and return
+window or nil if not found"))
+
+(defmethod window-to-top-by-title ((obj clog-obj) title)
+ (let ((app (connection-data-item obj "clog-gui"))
+ (r nil))
+ (maphash (lambda (key value)
+ (declare (ignore key))
+ (when (equalp (window-title value) title)
+ (window-focus value)
+ (setf r key)))
+ (windows app))
+ r))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; window-to-top-by-param ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defgeneric window-to-top-by-param (clog-obj param)
+ (:documentation "Bring window with PARAM to top and return
+window or nil if not found"))
+
+(defmethod window-to-top-by-param ((obj clog-obj) param)
+ (let ((app (connection-data-item obj "clog-gui"))
+ (r nil))
+ (maphash (lambda (key value)
+ (declare (ignore key))
+ (when (equalp (win-param value) param)
+ (window-focus value)
+ (setf r key)))
+ (windows app))
+ r))
+
+;;;;;;;;;;;;;;;;;;;;;
+;; window-by-title ;;
+;;;;;;;;;;;;;;;;;;;;;
+
+(defgeneric window-by-title (clog-obj title)
+ (:documentation "Bring window with TITLE to top and return
+window or nil if not found"))
+
+(defmethod window-by-title ((obj clog-obj) title)
+ (let ((app (connection-data-item obj "clog-gui"))
+ (r nil))
+ (maphash (lambda (key value)
+ (declare (ignore key))
+ (when (equalp (window-title value) title)
+ (setf r key)))
+ (windows app))
+ r))
+
+;;;;;;;;;;;;;;;;;;;;;
+;; window-by-param ;;
+;;;;;;;;;;;;;;;;;;;;;
+
+(defgeneric window-by-param (clog-obj param)
+ (:documentation "Bring window with PARAM to top and return
+window or nil if not found"))
+
+(defmethod window-by-param ((obj clog-obj) param)
+ (let ((app (connection-data-item obj "clog-gui"))
+ (r nil))
+ (maphash (lambda (key value)
+ (declare (ignore key))
+ (when (equalp (win-param value) param)
+ (setf r key)))
+ (windows app))
+ r))
+
;;;;;;;;;;;;;;;;;;;;;;;;;;
;; maximize-all-windows ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -498,6 +577,10 @@ The on-window-change clog-obj received is the new window"))
((win-title
:accessor win-title
:documentation "Window title clog-element")
+ (win-param
+ :accessor win-param
+ :initform nil
+ :documentation "Window specific parameter")
(title-bar
:accessor title-bar
:documentation "Window title-bar clog-element")
@@ -678,6 +761,7 @@ The on-window-change clog-obj received is the new window"))
maximize
has-pinner
keep-on-top
+ window-param
hidden
client-movement
border-class
@@ -690,7 +774,8 @@ at end of drag and on-window-resize at start of resize and
on-window-resize-done at end of resize. If has-pinner a toggle wil appear on
title bar to allow pinning the window in place, if keep-on-top t then when
pinned also will keep-on-top. If had-pinned is nil and keep-on-top t then
-the window will be set to keep-on-top always."))
+the window will be set to keep-on-top always. window-param is a general parameter
+for identifiying the window to use with window-to-top-by-param or window-by-param."))
(defmethod create-gui-window ((obj clog-obj) &key (title "New Window")
(content "")
@@ -701,6 +786,7 @@ the window will be set to keep-on-top always."))
(maximize nil)
(has-pinner nil)
(keep-on-top nil)
+ (window-param nil)
(hidden nil)
(client-movement nil)
(border-class "w3-card-4 w3-white w3-border")
@@ -760,6 +846,7 @@ the window will be set to keep-on-top always."))
:html-id html-id)))
(setf (win-title win)
(attach-as-child win (format nil "~A-title" html-id)))
+ (setf (win-param win) window-param)
(setf (title-bar win)
(attach-as-child win (format nil "~A-title-bar" html-id)))
(when has-pinner
@@ -844,6 +931,22 @@ the window will be set to keep-on-top always."))
(setf (inner-html (window-select-item obj)) value))
(setf (inner-html (win-title obj)) value))
+;;;;;;;;;;;;;;;;;;
+;; window-param ;;
+;;;;;;;;;;;;;;;;;;
+
+(defgeneric window-param (clog-gui-window)
+ (:documentation "Get/setf window param"))
+
+(defmethod window-param ((obj clog-gui-window))
+ (win-param obj))
+
+(defgeneric (setf window-param) (value clog-gui-window)
+ (:documentation "Set window param"))
+
+(defmethod (setf window-param) (value (obj clog-gui-window))
+ (setf (win-param obj) value))
+
;;;;;;;;;;;;;;;;;;;;
;; window-content ;;
;;;;;;;;;;;;;;;;;;;;
diff --git a/tools/clog-builder.lisp b/tools/clog-builder.lisp
index 8ec4b7d..52e125c 100644
--- a/tools/clog-builder.lisp
+++ b/tools/clog-builder.lisp
@@ -1739,334 +1739,336 @@ It parse the string TEXT without using READ functions."
(defun on-new-builder-panel (obj &key (open-file nil))
"Open new panel"
- (let* ((app (connection-data-item obj "builder-app-data"))
- (win (create-gui-window obj :top 40 :left 225
- :width 645 :height 430
- :client-movement t))
- (box (create-panel-box-layout (window-content win)
- :left-width 0 :right-width 0
- :top-height 33 :bottom-height 0))
- (tool-bar (create-div (top-panel box) :class "w3-center"))
- (btn-class "w3-button w3-white w3-border w3-border-black w3-ripple")
- (btn-copy (create-img tool-bar :alt-text "copy" :url-src img-btn-copy :class btn-class))
- (btn-paste (create-img tool-bar :alt-text "paste" :url-src img-btn-paste :class btn-class))
- (btn-cut (create-img tool-bar :alt-text "cut" :url-src img-btn-cut :class btn-class))
- (btn-del (create-img tool-bar :alt-text "delete" :url-src img-btn-del :class btn-class))
- (btn-undo (create-img tool-bar :alt-text "undo" :url-src img-btn-undo :class btn-class))
- (btn-redo (create-img tool-bar :alt-text "redo" :url-src img-btn-redo :class btn-class))
- (btn-test (create-img tool-bar :alt-text "test" :url-src img-btn-test :class btn-class))
- (btn-rndr (create-img tool-bar :alt-text "render" :url-src img-btn-rndr :class btn-class))
- (btn-save (create-img tool-bar :alt-text "save" :url-src img-btn-save :class btn-class))
- (btn-load (create-img tool-bar :alt-text "load" :url-src img-btn-load :class btn-class))
- (cbox (create-form-element tool-bar :checkbox :class "w3-margin-left"))
- (cbox-lbl (create-label tool-bar :content " auto render" :label-for cbox :class "w3-black"))
- (spacer (create-span tool-bar :content " "))
- (btn-help (create-span tool-bar :content "?" :class "w3-tiny w3-ripple w3-black"))
- (content (center-panel box))
- (in-simulation nil)
- (undo-chain nil)
- (redo-chain nil)
- (is-dirty nil)
- (file-name "")
- (render-file-name "")
- (panel-id (html-id content)))
- (setf (background-color (top-panel box)) :black)
- (setf (checkedp cbox) t)
- (setf (advisory-title btn-copy) "copy")
- (setf (advisory-title btn-paste) "paste")
- (setf (advisory-title btn-cut) "cut")
- (setf (advisory-title btn-del) "delete")
- (setf (advisory-title btn-undo) "undo")
- (setf (advisory-title btn-redo) "redo")
- (setf (advisory-title btn-test) "test")
- (setf (advisory-title btn-rndr) "render to lisp - shift-click render as...")
- (setf (advisory-title btn-save) "save - shift-click save as...")
- (setf (advisory-title btn-load) "load")
- (setf (advisory-title cbox) "when checked render on save")
- (setf (advisory-title cbox-lbl) "when checked render on save")
- (setf (height btn-copy) "12px")
- (setf (height btn-paste) "12px")
- (setf (height btn-cut) "12px")
- (setf (height btn-del) "12px")
- (setf (height btn-undo) "12px")
- (setf (height btn-redo) "12px")
- (setf (height btn-test) "12px")
- (setf (height btn-rndr) "12px")
- (setf (height btn-save) "12px")
- (setf (height btn-load) "12px")
- (setf (height btn-help) "12px")
- (setf-next-id content 1)
- (setf (overflow content) :auto)
- (init-control-list app panel-id)
- ;; Setup panel window
- (let ((panel-name (format nil "panel-~A" (incf (next-panel-id app)))))
- (setf (window-title win) panel-name)
- (setf (attribute content "data-clog-name") panel-name))
- (setf (attribute content "data-clog-type") "clog-data")
- (setf (attribute content "data-in-package") "clog-user")
- (setf (attribute content "data-custom-slots") "")
- ;; activate associated windows on open
- (on-show-control-events-win win)
- (panel-mode win t)
- (on-populate-control-properties-win content :win win)
- (on-populate-control-list-win content :win win)
- ;; setup window events
- (set-on-window-focus win
- (lambda (obj)
- (declare (ignore obj))
- (panel-mode win t)
- (on-populate-control-properties-win content :win win)
- (on-populate-control-list-win content :win win)))
- (set-on-window-blur win
- (lambda (obj)
- (declare (ignore obj))
- (panel-mode win nil)))
- (set-on-window-close win
- (lambda (obj)
- (declare (ignore obj))
- ;; clear associated windows on close
- (setf (current-control app) nil)
- (destroy-control-list app panel-id)
- (on-populate-control-properties-win content :win win)
- (on-populate-control-list-win content :win win)))
- (set-on-window-size-done win
- (lambda (obj)
- (declare (ignore obj))
- (on-populate-control-properties-win content :win win)))
- ;; setup tool bar events
- (set-on-click btn-help 'on-quick-start)
- (flet (;; copy
- (copy (obj)
- (when (current-control app)
- (maphash
- (lambda (html-id control)
- (declare (ignore html-id))
- (place-inside-bottom-of (bottom-panel box)
- (get-placer control)))
- (get-control-list app panel-id))
- (setf (copy-buf app)
- (js-query content
- (format nil
- "var z=~a.clone(); z=$('').append(z);~
+ (unless (window-to-top-by-param obj open-file)
+ (let* ((app (connection-data-item obj "builder-app-data"))
+ (win (create-gui-window obj :top 40 :left 225
+ :width 645 :height 430
+ :client-movement t))
+ (box (create-panel-box-layout (window-content win)
+ :left-width 0 :right-width 0
+ :top-height 33 :bottom-height 0))
+ (tool-bar (create-div (top-panel box) :class "w3-center"))
+ (btn-class "w3-button w3-white w3-border w3-border-black w3-ripple")
+ (btn-copy (create-img tool-bar :alt-text "copy" :url-src img-btn-copy :class btn-class))
+ (btn-paste (create-img tool-bar :alt-text "paste" :url-src img-btn-paste :class btn-class))
+ (btn-cut (create-img tool-bar :alt-text "cut" :url-src img-btn-cut :class btn-class))
+ (btn-del (create-img tool-bar :alt-text "delete" :url-src img-btn-del :class btn-class))
+ (btn-undo (create-img tool-bar :alt-text "undo" :url-src img-btn-undo :class btn-class))
+ (btn-redo (create-img tool-bar :alt-text "redo" :url-src img-btn-redo :class btn-class))
+ (btn-test (create-img tool-bar :alt-text "test" :url-src img-btn-test :class btn-class))
+ (btn-rndr (create-img tool-bar :alt-text "render" :url-src img-btn-rndr :class btn-class))
+ (btn-save (create-img tool-bar :alt-text "save" :url-src img-btn-save :class btn-class))
+ (btn-load (create-img tool-bar :alt-text "load" :url-src img-btn-load :class btn-class))
+ (cbox (create-form-element tool-bar :checkbox :class "w3-margin-left"))
+ (cbox-lbl (create-label tool-bar :content " auto render" :label-for cbox :class "w3-black"))
+ (spacer (create-span tool-bar :content " "))
+ (btn-help (create-span tool-bar :content "?" :class "w3-tiny w3-ripple w3-black"))
+ (content (center-panel box))
+ (in-simulation nil)
+ (undo-chain nil)
+ (redo-chain nil)
+ (is-dirty nil)
+ (file-name "")
+ (render-file-name "")
+ (panel-id (html-id content)))
+ (setf (background-color (top-panel box)) :black)
+ (setf (checkedp cbox) t)
+ (setf (advisory-title btn-copy) "copy")
+ (setf (advisory-title btn-paste) "paste")
+ (setf (advisory-title btn-cut) "cut")
+ (setf (advisory-title btn-del) "delete")
+ (setf (advisory-title btn-undo) "undo")
+ (setf (advisory-title btn-redo) "redo")
+ (setf (advisory-title btn-test) "test")
+ (setf (advisory-title btn-rndr) "render to lisp - shift-click render as...")
+ (setf (advisory-title btn-save) "save - shift-click save as...")
+ (setf (advisory-title btn-load) "load")
+ (setf (advisory-title cbox) "when checked render on save")
+ (setf (advisory-title cbox-lbl) "when checked render on save")
+ (setf (height btn-copy) "12px")
+ (setf (height btn-paste) "12px")
+ (setf (height btn-cut) "12px")
+ (setf (height btn-del) "12px")
+ (setf (height btn-undo) "12px")
+ (setf (height btn-redo) "12px")
+ (setf (height btn-test) "12px")
+ (setf (height btn-rndr) "12px")
+ (setf (height btn-save) "12px")
+ (setf (height btn-load) "12px")
+ (setf (height btn-help) "12px")
+ (setf-next-id content 1)
+ (setf (overflow content) :auto)
+ (init-control-list app panel-id)
+ ;; Setup panel window
+ (let ((panel-name (format nil "panel-~A" (incf (next-panel-id app)))))
+ (setf (window-title win) panel-name)
+ (setf (attribute content "data-clog-name") panel-name))
+ (setf (attribute content "data-clog-type") "clog-data")
+ (setf (attribute content "data-in-package") "clog-user")
+ (setf (attribute content "data-custom-slots") "")
+ ;; activate associated windows on open
+ (on-show-control-events-win win)
+ (panel-mode win t)
+ (on-populate-control-properties-win content :win win)
+ (on-populate-control-list-win content :win win)
+ ;; setup window events
+ (set-on-window-focus win
+ (lambda (obj)
+ (declare (ignore obj))
+ (panel-mode win t)
+ (on-populate-control-properties-win content :win win)
+ (on-populate-control-list-win content :win win)))
+ (set-on-window-blur win
+ (lambda (obj)
+ (declare (ignore obj))
+ (panel-mode win nil)))
+ (set-on-window-close win
+ (lambda (obj)
+ (declare (ignore obj))
+ ;; clear associated windows on close
+ (setf (current-control app) nil)
+ (destroy-control-list app panel-id)
+ (on-populate-control-properties-win content :win win)
+ (on-populate-control-list-win content :win win)))
+ (set-on-window-size-done win
+ (lambda (obj)
+ (declare (ignore obj))
+ (on-populate-control-properties-win content :win win)))
+ ;; setup tool bar events
+ (set-on-click btn-help 'on-quick-start)
+ (flet (;; copy
+ (copy (obj)
+ (when (current-control app)
+ (maphash
+ (lambda (html-id control)
+ (declare (ignore html-id))
+ (place-inside-bottom-of (bottom-panel box)
+ (get-placer control)))
+ (get-control-list app panel-id))
+ (setf (copy-buf app)
+ (js-query content
+ (format nil
+ "var z=~a.clone(); z=$('').append(z);~
z.find('*').each(function(){~
if($(this).attr('data-clog-composite-control') == 't'){$(this).text('')}~
if($(this).attr('id') !== undefined && ~
$(this).attr('id').substring(0,5)=='CLOGB'){$(this).removeAttr('id')}});~
z.html()"
- (jquery (current-control app)))))
- (system-clipboard-write obj (copy-buf app))
- (let ((c (create-text-area (window-content (copy-history-win app))
- :value (copy-buf app)
- :auto-place nil)))
- (place-inside-top-of (window-content (copy-history-win app)) c)
- (setf (width c) "100%"))
- (maphash
- (lambda (html-id control)
- (declare (ignore html-id))
- (place-after control (get-placer control)))
- (get-control-list app panel-id))))
- ;; paste
- (paste (obj)
- (let ((buf (or (system-clipboard-read obj)
- (copy-buf app))))
- (when buf
- (let ((control (create-control content content
- `(:name "custom"
- :create-type :paste)
- (format nil "CLOGB~A~A"
- (get-universal-time)
- (next-id content))
- :custom-query buf)))
- (setf (attribute control "data-clog-name")
- (format nil "~A-~A" "copy" (next-id content)))
- (incf-next-id content)
- (add-sub-controls control content :win win :paste t)
- (let ((cr (control-info (attribute control "data-clog-type"))))
- (when (getf cr :on-load)
- (funcall (getf cr :on-load) control cr)))
- (setup-control content control :win win)
- (select-control control)
- (on-populate-control-list-win content :win win)
- (jquery-execute (get-placer content) "trigger('clog-builder-snap-shot')")))))
- ;; delete
- (del (obj)
- (declare (ignore obj))
- (when (current-control app)
- (delete-current-control app panel-id (html-id (current-control app)))
- (on-populate-control-properties-win content :win win)
- (on-populate-control-list-win content :win win)
- (jquery-execute (get-placer content) "trigger('clog-builder-snap-shot')"))))
- ;; set up del/cut/copy/paste handlers
- (set-on-copy content #'copy)
- (set-on-click btn-copy #'copy)
- (set-on-paste content #'paste)
- (set-on-click btn-paste #'paste)
- (set-on-click btn-del #'del)
- (set-on-cut content (lambda (obj)
- (copy obj)
- (del obj)))
- (set-on-click btn-cut (lambda (obj)
+ (jquery (current-control app)))))
+ (system-clipboard-write obj (copy-buf app))
+ (let ((c (create-text-area (window-content (copy-history-win app))
+ :value (copy-buf app)
+ :auto-place nil)))
+ (place-inside-top-of (window-content (copy-history-win app)) c)
+ (setf (width c) "100%"))
+ (maphash
+ (lambda (html-id control)
+ (declare (ignore html-id))
+ (place-after control (get-placer control)))
+ (get-control-list app panel-id))))
+ ;; paste
+ (paste (obj)
+ (let ((buf (or (system-clipboard-read obj)
+ (copy-buf app))))
+ (when buf
+ (let ((control (create-control content content
+ `(:name "custom"
+ :create-type :paste)
+ (format nil "CLOGB~A~A"
+ (get-universal-time)
+ (next-id content))
+ :custom-query buf)))
+ (setf (attribute control "data-clog-name")
+ (format nil "~A-~A" "copy" (next-id content)))
+ (incf-next-id content)
+ (add-sub-controls control content :win win :paste t)
+ (let ((cr (control-info (attribute control "data-clog-type"))))
+ (when (getf cr :on-load)
+ (funcall (getf cr :on-load) control cr)))
+ (setup-control content control :win win)
+ (select-control control)
+ (on-populate-control-list-win content :win win)
+ (jquery-execute (get-placer content) "trigger('clog-builder-snap-shot')")))))
+ ;; delete
+ (del (obj)
+ (declare (ignore obj))
+ (when (current-control app)
+ (delete-current-control app panel-id (html-id (current-control app)))
+ (on-populate-control-properties-win content :win win)
+ (on-populate-control-list-win content :win win)
+ (jquery-execute (get-placer content) "trigger('clog-builder-snap-shot')"))))
+ ;; set up del/cut/copy/paste handlers
+ (set-on-copy content #'copy)
+ (set-on-click btn-copy #'copy)
+ (set-on-paste content #'paste)
+ (set-on-click btn-paste #'paste)
+ (set-on-click btn-del #'del)
+ (set-on-cut content (lambda (obj)
(copy obj)
- (del obj))))
- (set-on-click btn-undo (lambda (obj)
- (declare (ignore obj))
- (when undo-chain
- (setf (inner-html content)
- (let ((val (pop undo-chain)))
- (push val redo-chain)
- val))
- (clrhash (get-control-list app panel-id))
- (on-populate-loaded-window content :win win)
- (setf (window-title win) (attribute content "data-clog-name"))
- (on-populate-control-properties-win content :win win)
- (on-populate-control-list-win content :win win))))
- (set-on-event content "clog-builder-snap-shot"
- (lambda (obj)
- (declare (ignore obj))
- (setf is-dirty t)
- (setf redo-chain nil)
- (push (panel-snap-shot content panel-id (bottom-panel box)) undo-chain)
- (when (current-control app)
- (focus (get-placer (current-control app))))))
- (set-on-click btn-redo (lambda (obj)
- (declare (ignore obj))
- (when redo-chain
- (setf (inner-html content)
- (let ((val (pop redo-chain)))
- (push val undo-chain)
- val))
- (clrhash (get-control-list app panel-id))
- (on-populate-loaded-window content :win win)
- (setf (window-title win) (attribute content "data-clog-name"))
- (on-populate-control-properties-win content :win win)
- (on-populate-control-list-win content :win win))))
- (flet ((open-file-name (fname)
- (setf file-name fname)
- (setf render-file-name (format nil "~A~A.lisp"
- (directory-namestring file-name)
- (pathname-name file-name)))
- (setf (inner-html content)
- (or (read-file fname)
- ""))
- (setf is-dirty nil)
- (clrhash (get-control-list app panel-id))
- (on-populate-loaded-window content :win win)
- (setf (window-title win) (attribute content "data-clog-name"))
- (on-populate-control-list-win content :win win)))
- (when open-file
- (open-file-name open-file))
- (set-on-click btn-load (lambda (obj)
- (server-file-dialog obj "Load Panel" (directory-namestring (if (equal file-name "")
- (current-project-dir app)
- file-name))
- (lambda (fname)
- (window-focus win)
- (when fname
- (open-file-name fname)))))))
- (flet ((save (obj data)
- (cond ((or (equal file-name "")
- (getf data :shift-key))
- (when (equal file-name "")
- (setf file-name (format nil "~A~A.clog"
- (current-project-dir app)
- (attribute content "data-clog-name"))))
- (server-file-dialog obj "Save Panel As.." file-name
- (lambda (fname)
- (window-focus win)
- (when fname
- (setf file-name fname)
- (setf render-file-name (format nil "~A~A.lisp"
- (directory-namestring file-name)
- (pathname-name file-name)))
- (add-class btn-save "w3-animate-top")
- (save-panel fname content panel-id (bottom-panel box))
- (when (checkedp cbox)
- (add-class btn-rndr "w3-animate-top")
- (write-file (render-clog-code content (bottom-panel box))
- render-file-name)
- (sleep .5)
- (remove-class btn-rndr "w3-animate-top"))
- (sleep .5)
- (remove-class btn-save "w3-animate-top")
- (cond ((eq is-dirty :close)
- (setf is-dirty nil)
- (window-close win))
- (t
- (setf is-dirty nil)))))
- :initial-filename file-name))
- (t
- (add-class btn-save "w3-animate-top")
- (save-panel file-name content panel-id (bottom-panel box))
- (when (checkedp cbox)
- (add-class btn-rndr "w3-animate-top")
- (write-file (render-clog-code content (bottom-panel box))
- render-file-name)
- (sleep .5)
- (remove-class btn-rndr "w3-animate-top"))
- (sleep .5)
- (remove-class btn-save "w3-animate-top")
- (cond ((eq is-dirty :close)
- (setf is-dirty nil)
- (window-close win))
- (t
- (setf is-dirty nil)))))))
- (set-on-window-can-close win
- (lambda (obj)
- (cond (is-dirty
- (confirm-dialog win "Save panel?"
- (lambda (result)
- (cond (result
- (setf is-dirty :close)
- (save obj nil))
- (t
- (setf is-dirty nil)
- (window-close win))))
- :ok-text "Yes" :cancel-text "No")
- nil)
- (t
- t))))
- (set-on-mouse-click btn-save
- (lambda (obj data)
- (setf is-dirty nil)
- (save obj data))))
- (set-on-click btn-test
- (lambda (obj)
- (do-eval obj (render-clog-code content (bottom-panel box))
- (attribute content "data-clog-name")
- :package (attribute content "data-in-package"))))
- (set-on-mouse-click btn-rndr
- (lambda (obj data)
- (cond ((or (equal render-file-name "")
- (getf data :shift-key))
- (when (equal render-file-name "")
- (if (equal file-name "")
- (setf render-file-name (format nil "~A.lisp" (attribute content "data-clog-name")))
- (setf render-file-name (format nil "~A~A.lisp"
- (directory-namestring file-name)
- (pathname-name file-name)))))
- (server-file-dialog obj "Render As.." render-file-name
+ (del obj)))
+ (set-on-click btn-cut (lambda (obj)
+ (copy obj)
+ (del obj))))
+ (set-on-click btn-undo (lambda (obj)
+ (declare (ignore obj))
+ (when undo-chain
+ (setf (inner-html content)
+ (let ((val (pop undo-chain)))
+ (push val redo-chain)
+ val))
+ (clrhash (get-control-list app panel-id))
+ (on-populate-loaded-window content :win win)
+ (setf (window-title win) (attribute content "data-clog-name"))
+ (on-populate-control-properties-win content :win win)
+ (on-populate-control-list-win content :win win))))
+ (set-on-event content "clog-builder-snap-shot"
+ (lambda (obj)
+ (declare (ignore obj))
+ (setf is-dirty t)
+ (setf redo-chain nil)
+ (push (panel-snap-shot content panel-id (bottom-panel box)) undo-chain)
+ (when (current-control app)
+ (focus (get-placer (current-control app))))))
+ (set-on-click btn-redo (lambda (obj)
+ (declare (ignore obj))
+ (when redo-chain
+ (setf (inner-html content)
+ (let ((val (pop redo-chain)))
+ (push val undo-chain)
+ val))
+ (clrhash (get-control-list app panel-id))
+ (on-populate-loaded-window content :win win)
+ (setf (window-title win) (attribute content "data-clog-name"))
+ (on-populate-control-properties-win content :win win)
+ (on-populate-control-list-win content :win win))))
+ (flet ((open-file-name (fname)
+ (setf file-name fname)
+ (setf render-file-name (format nil "~A~A.lisp"
+ (directory-namestring file-name)
+ (pathname-name file-name)))
+ (setf (inner-html content)
+ (or (read-file fname)
+ ""))
+ (setf is-dirty nil)
+ (clrhash (get-control-list app panel-id))
+ (on-populate-loaded-window content :win win)
+ (setf (window-title win) (attribute content "data-clog-name"))
+ (setf (window-param win) fname)
+ (on-populate-control-list-win content :win win)))
+ (when open-file
+ (open-file-name open-file))
+ (set-on-click btn-load (lambda (obj)
+ (server-file-dialog obj "Load Panel" (directory-namestring (if (equal file-name "")
+ (current-project-dir app)
+ file-name))
(lambda (fname)
(window-focus win)
(when fname
- (setf render-file-name fname)
- (add-class btn-rndr "w3-animate-top")
- (write-file (render-clog-code content (bottom-panel box))
- fname)
- (sleep .5)
- (remove-class btn-rndr "w3-animate-top")))
- :initial-filename render-file-name))
- (t
- (add-class btn-rndr "w3-animate-top")
- (write-file (render-clog-code content (bottom-panel box))
- render-file-name)
- (sleep .5)
- (remove-class btn-rndr "w3-animate-top")))))
- (set-on-mouse-down content
- (lambda (obj data)
- (declare (ignore obj))
- (unless in-simulation
- (when (drop-new-control app content data :win win)
- (incf-next-id content)))))))
+ (open-file-name fname)))))))
+ (flet ((save (obj data)
+ (cond ((or (equal file-name "")
+ (getf data :shift-key))
+ (when (equal file-name "")
+ (setf file-name (format nil "~A~A.clog"
+ (current-project-dir app)
+ (attribute content "data-clog-name"))))
+ (server-file-dialog obj "Save Panel As.." file-name
+ (lambda (fname)
+ (window-focus win)
+ (when fname
+ (setf file-name fname)
+ (setf render-file-name (format nil "~A~A.lisp"
+ (directory-namestring file-name)
+ (pathname-name file-name)))
+ (add-class btn-save "w3-animate-top")
+ (save-panel fname content panel-id (bottom-panel box))
+ (when (checkedp cbox)
+ (add-class btn-rndr "w3-animate-top")
+ (write-file (render-clog-code content (bottom-panel box))
+ render-file-name)
+ (sleep .5)
+ (remove-class btn-rndr "w3-animate-top"))
+ (sleep .5)
+ (remove-class btn-save "w3-animate-top")
+ (cond ((eq is-dirty :close)
+ (setf is-dirty nil)
+ (window-close win))
+ (t
+ (setf is-dirty nil)))))
+ :initial-filename file-name))
+ (t
+ (add-class btn-save "w3-animate-top")
+ (save-panel file-name content panel-id (bottom-panel box))
+ (when (checkedp cbox)
+ (add-class btn-rndr "w3-animate-top")
+ (write-file (render-clog-code content (bottom-panel box))
+ render-file-name)
+ (sleep .5)
+ (remove-class btn-rndr "w3-animate-top"))
+ (sleep .5)
+ (remove-class btn-save "w3-animate-top")
+ (cond ((eq is-dirty :close)
+ (setf is-dirty nil)
+ (window-close win))
+ (t
+ (setf is-dirty nil)))))))
+ (set-on-window-can-close win
+ (lambda (obj)
+ (cond (is-dirty
+ (confirm-dialog win "Save panel?"
+ (lambda (result)
+ (cond (result
+ (setf is-dirty :close)
+ (save obj nil))
+ (t
+ (setf is-dirty nil)
+ (window-close win))))
+ :ok-text "Yes" :cancel-text "No")
+ nil)
+ (t
+ t))))
+ (set-on-mouse-click btn-save
+ (lambda (obj data)
+ (setf is-dirty nil)
+ (save obj data))))
+ (set-on-click btn-test
+ (lambda (obj)
+ (do-eval obj (render-clog-code content (bottom-panel box))
+ (attribute content "data-clog-name")
+ :package (attribute content "data-in-package"))))
+ (set-on-mouse-click btn-rndr
+ (lambda (obj data)
+ (cond ((or (equal render-file-name "")
+ (getf data :shift-key))
+ (when (equal render-file-name "")
+ (if (equal file-name "")
+ (setf render-file-name (format nil "~A.lisp" (attribute content "data-clog-name")))
+ (setf render-file-name (format nil "~A~A.lisp"
+ (directory-namestring file-name)
+ (pathname-name file-name)))))
+ (server-file-dialog obj "Render As.." render-file-name
+ (lambda (fname)
+ (window-focus win)
+ (when fname
+ (setf render-file-name fname)
+ (add-class btn-rndr "w3-animate-top")
+ (write-file (render-clog-code content (bottom-panel box))
+ fname)
+ (sleep .5)
+ (remove-class btn-rndr "w3-animate-top")))
+ :initial-filename render-file-name))
+ (t
+ (add-class btn-rndr "w3-animate-top")
+ (write-file (render-clog-code content (bottom-panel box))
+ render-file-name)
+ (sleep .5)
+ (remove-class btn-rndr "w3-animate-top")))))
+ (set-on-mouse-down content
+ (lambda (obj data)
+ (declare (ignore obj))
+ (unless in-simulation
+ (when (drop-new-control app content data :win win)
+ (incf-next-id content))))))))
(defun on-attach-builder-custom (body)
"New custom builder page has attached"
@@ -2555,89 +2557,90 @@ It parse the string TEXT without using READ functions."
(defun on-open-file (obj &key open-file (title "New Source Editor") text (title-class "w3-black"))
"Open a new text editor"
- (let* ((app (connection-data-item obj "builder-app-data"))
- (win (create-gui-window obj :title title
- :title-class title-class
- :width 645 :height 430
- :client-movement t))
- (box (create-panel-box-layout (window-content win)
- :left-width 0 :right-width 0
- :top-height 33 :bottom-height 0))
- (tool-bar (create-div (top-panel box) :class "w3-center"))
- (btn-class "w3-button w3-white w3-border w3-border-black w3-ripple")
- (btn-copy (create-img tool-bar :alt-text "copy" :url-src img-btn-copy :class btn-class))
- (btn-paste (create-img tool-bar :alt-text "paste" :url-src img-btn-paste :class btn-class))
- (btn-cut (create-img tool-bar :alt-text "cut" :url-src img-btn-cut :class btn-class))
- (btn-del (create-img tool-bar :alt-text "delete" :url-src img-btn-del :class btn-class))
- (btn-undo (create-img tool-bar :alt-text "undo" :url-src img-btn-undo :class btn-class))
- (btn-redo (create-img tool-bar :alt-text "redo" :url-src img-btn-redo :class btn-class))
- (btn-save (create-img tool-bar :alt-text "save" :url-src img-btn-save :class btn-class))
- (btn-load (create-img tool-bar :alt-text "load" :url-src img-btn-load :class btn-class))
- (spacer (create-span tool-bar :content " "))
- (btn-efrm (create-button tool-bar :content "Eval Form" :class (format nil "w3-tiny ~A" btn-class)))
- (btn-esel (create-button tool-bar :content "Eval Sel" :class (format nil "w3-tiny ~A" btn-class)))
- (btn-test (create-button tool-bar :content "Eval All" :class (format nil "w3-tiny ~A" btn-class)))
- (spacer (create-span tool-bar :content " "))
- (btn-help (create-span tool-bar :content "?" :class "w3-tiny w3-ripple"))
- (content (center-panel box))
- (pac-line (create-form-element content :text :class "w3-black"))
- (ace (clog-ace:create-clog-ace-element content))
- (status (create-div content :class "w3-tiny w3-border"))
- (lisp-file t)
- (is-dirty nil)
- (file-name ""))
- (declare (ignore spacer))
- (when text
- (setf (text-value ace) text))
- (set-on-window-focus win
- (lambda (obj)
- (declare (ignore obj))
- (if lisp-file
- (setf (current-editor-is-lisp app) (text-value pac-line))
- (setf (current-editor-is-lisp app) nil))))
- (add-class tool-bar title-class)
- (setf (advisory-title btn-paste) "paste")
- (setf (advisory-title btn-cut) "cut")
- (setf (advisory-title btn-del) "delete")
- (setf (advisory-title btn-undo) "undo")
- (setf (advisory-title btn-redo) "redo")
- (setf (advisory-title btn-save) "save - shift-click save as...")
- (setf (advisory-title btn-load) "load")
- (setf (advisory-title btn-efrm) "evaluate form")
- (setf (advisory-title btn-esel) "evaluate selection")
- (setf (advisory-title btn-test) "evaluate")
- (setf (height btn-copy) "12px")
- (setf (height btn-paste) "12px")
- (setf (height btn-cut) "12px")
- (setf (height btn-del) "12px")
- (setf (height btn-undo) "12px")
- (setf (height btn-redo) "12px")
- (setf (height btn-save) "12px")
- (setf (height btn-load) "12px")
- (setf (height btn-efrm) "12px")
- (setf (height btn-esel) "12px")
- (setf (height btn-test) "12px")
- (setf (height btn-help) "12px")
- (setf (width btn-efrm) "43px")
- (setf (width btn-esel) "43px")
- (setf (width btn-test) "43px")
- (setf (positioning ace) :absolute)
- (setf (positioning status) :absolute)
- (set-geometry pac-line :units "" :top "20px" :left "0px"
- :right "0px" :height "22px" :width "100%")
- (setf (place-holder pac-line) "Current Package")
- (setf (text-value pac-line) "clog-user")
- (setf (current-editor-is-lisp app) "clog-user")
- (set-geometry ace :units "" :width "" :height ""
- :top "22px" :bottom "20px" :left "0px" :right "0px")
- (clog-ace:resize ace)
- (set-geometry status :units "" :width "" :height "20px"
- :bottom "0px" :left "0px" :right "0px")
- (setup-lisp-ace ace status)
- (set-on-click btn-help
- (lambda (obj)
- (alert-dialog win
- "
+ (unless (window-to-top-by-title obj open-file)
+ (let* ((app (connection-data-item obj "builder-app-data"))
+ (win (create-gui-window obj :title title
+ :title-class title-class
+ :width 645 :height 430
+ :client-movement t))
+ (box (create-panel-box-layout (window-content win)
+ :left-width 0 :right-width 0
+ :top-height 33 :bottom-height 0))
+ (tool-bar (create-div (top-panel box) :class "w3-center"))
+ (btn-class "w3-button w3-white w3-border w3-border-black w3-ripple")
+ (btn-copy (create-img tool-bar :alt-text "copy" :url-src img-btn-copy :class btn-class))
+ (btn-paste (create-img tool-bar :alt-text "paste" :url-src img-btn-paste :class btn-class))
+ (btn-cut (create-img tool-bar :alt-text "cut" :url-src img-btn-cut :class btn-class))
+ (btn-del (create-img tool-bar :alt-text "delete" :url-src img-btn-del :class btn-class))
+ (btn-undo (create-img tool-bar :alt-text "undo" :url-src img-btn-undo :class btn-class))
+ (btn-redo (create-img tool-bar :alt-text "redo" :url-src img-btn-redo :class btn-class))
+ (btn-save (create-img tool-bar :alt-text "save" :url-src img-btn-save :class btn-class))
+ (btn-load (create-img tool-bar :alt-text "load" :url-src img-btn-load :class btn-class))
+ (spacer (create-span tool-bar :content " "))
+ (btn-efrm (create-button tool-bar :content "Eval Form" :class (format nil "w3-tiny ~A" btn-class)))
+ (btn-esel (create-button tool-bar :content "Eval Sel" :class (format nil "w3-tiny ~A" btn-class)))
+ (btn-test (create-button tool-bar :content "Eval All" :class (format nil "w3-tiny ~A" btn-class)))
+ (spacer (create-span tool-bar :content " "))
+ (btn-help (create-span tool-bar :content "?" :class "w3-tiny w3-ripple"))
+ (content (center-panel box))
+ (pac-line (create-form-element content :text :class "w3-black"))
+ (ace (clog-ace:create-clog-ace-element content))
+ (status (create-div content :class "w3-tiny w3-border"))
+ (lisp-file t)
+ (is-dirty nil)
+ (file-name ""))
+ (declare (ignore spacer))
+ (when text
+ (setf (text-value ace) text))
+ (set-on-window-focus win
+ (lambda (obj)
+ (declare (ignore obj))
+ (if lisp-file
+ (setf (current-editor-is-lisp app) (text-value pac-line))
+ (setf (current-editor-is-lisp app) nil))))
+ (add-class tool-bar title-class)
+ (setf (advisory-title btn-paste) "paste")
+ (setf (advisory-title btn-cut) "cut")
+ (setf (advisory-title btn-del) "delete")
+ (setf (advisory-title btn-undo) "undo")
+ (setf (advisory-title btn-redo) "redo")
+ (setf (advisory-title btn-save) "save - shift-click save as...")
+ (setf (advisory-title btn-load) "load")
+ (setf (advisory-title btn-efrm) "evaluate form")
+ (setf (advisory-title btn-esel) "evaluate selection")
+ (setf (advisory-title btn-test) "evaluate")
+ (setf (height btn-copy) "12px")
+ (setf (height btn-paste) "12px")
+ (setf (height btn-cut) "12px")
+ (setf (height btn-del) "12px")
+ (setf (height btn-undo) "12px")
+ (setf (height btn-redo) "12px")
+ (setf (height btn-save) "12px")
+ (setf (height btn-load) "12px")
+ (setf (height btn-efrm) "12px")
+ (setf (height btn-esel) "12px")
+ (setf (height btn-test) "12px")
+ (setf (height btn-help) "12px")
+ (setf (width btn-efrm) "43px")
+ (setf (width btn-esel) "43px")
+ (setf (width btn-test) "43px")
+ (setf (positioning ace) :absolute)
+ (setf (positioning status) :absolute)
+ (set-geometry pac-line :units "" :top "20px" :left "0px"
+ :right "0px" :height "22px" :width "100%")
+ (setf (place-holder pac-line) "Current Package")
+ (setf (text-value pac-line) "clog-user")
+ (setf (current-editor-is-lisp app) "clog-user")
+ (set-geometry ace :units "" :width "" :height ""
+ :top "22px" :bottom "20px" :left "0px" :right "0px")
+ (clog-ace:resize ace)
+ (set-geometry status :units "" :width "" :height "20px"
+ :bottom "0px" :left "0px" :right "0px")
+ (setup-lisp-ace ace status)
+ (set-on-click btn-help
+ (lambda (obj)
+ (alert-dialog win
+ "
| cmd/alt-, | Configure editor |
| cmd/alt-. | Launch system browser |
| cmd/alt-[ | Evaluate form |
@@ -2645,136 +2648,136 @@ It parse the string TEXT without using READ functions."
| ctl-= | Expand region |
| opt/alt-m | Macroexpand |
"
- :width 400 :height 300
- :title "Help")))
- (set-on-window-size-done win
- (lambda (obj)
- (declare (ignore obj))
- (clog-ace:resize ace)))
- (flet ((open-file-name (fname)
- (window-focus win)
- (when fname
- (setf file-name fname)
- (setf (window-title win) fname)
- (let ((c (or (read-file fname) "")))
- (cond ((or (equalp (pathname-type fname) "lisp")
- (equalp (pathname-type fname) "asd"))
- (setf (clog-ace:mode ace) "ace/mode/lisp")
- (setf (text-value pac-line) (get-package-from-string c))
- (setf lisp-file t)
- (setf (current-editor-is-lisp app) (text-value pac-line)))
- (t
- (setf lisp-file nil)
- (setf (current-editor-is-lisp app) nil)
- (setf (clog-ace:mode ace) (clog-ace:get-mode-from-extension ace fname))))
- (setf (clog-ace:text-value ace) c)))))
- (when 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 "")
- (current-project-dir app)
- file-name))
- (lambda (fname)
- (open-file-name fname)
- (setf is-dirty nil))))))
- (set-on-input ace (lambda (obj)
- (declare (ignore obj))
- (setf is-dirty t)))
- (set-on-event ace "clog-save-ace"
- (lambda (obj)
- (declare (ignore obj))
- (unless (equal file-name "")
+ :width 400 :height 300
+ :title "Help")))
+ (set-on-window-size-done win
+ (lambda (obj)
+ (declare (ignore obj))
+ (clog-ace:resize ace)))
+ (flet ((open-file-name (fname)
+ (window-focus win)
+ (when fname
+ (setf file-name fname)
+ (setf (window-title win) fname)
+ (let ((c (or (read-file fname) "")))
+ (cond ((or (equalp (pathname-type fname) "lisp")
+ (equalp (pathname-type fname) "asd"))
+ (setf (clog-ace:mode ace) "ace/mode/lisp")
+ (setf (text-value pac-line) (get-package-from-string c))
+ (setf lisp-file t)
+ (setf (current-editor-is-lisp app) (text-value pac-line)))
+ (t
+ (setf lisp-file nil)
+ (setf (current-editor-is-lisp app) nil)
+ (setf (clog-ace:mode ace) (clog-ace:get-mode-from-extension ace fname))))
+ (setf (clog-ace:text-value ace) c)))))
+ (when 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 "")
+ (current-project-dir app)
+ file-name))
+ (lambda (fname)
+ (open-file-name fname)
+ (setf is-dirty nil))))))
+ (set-on-input ace (lambda (obj)
+ (declare (ignore obj))
+ (setf is-dirty t)))
+ (set-on-event ace "clog-save-ace"
+ (lambda (obj)
+ (declare (ignore obj))
+ (unless (equal file-name "")
+ (add-class btn-save "w3-animate-top")
+ (write-file (text-value ace) file-name)
+ (sleep .5)
+ (remove-class btn-save "w3-animate-top"))))
+ (flet ((save (obj data)
+ (cond ((or (equal file-name "")
+ (getf data :shift-key))
+ (server-file-dialog obj "Save Source As.." (if (equal file-name "")
+ (current-project-dir app)
+ file-name)
+ (lambda (fname)
+ (window-focus win)
+ (when fname
+ (setf file-name fname)
+ (add-class btn-save "w3-animate-top")
+ (write-file (text-value ace) fname)
+ (sleep .5)
+ (remove-class btn-save "w3-animate-top"))
+ :initial-filename file-name)))
+ (t
(add-class btn-save "w3-animate-top")
(write-file (text-value ace) file-name)
(sleep .5)
- (remove-class btn-save "w3-animate-top"))))
- (flet ((save (obj data)
- (cond ((or (equal file-name "")
- (getf data :shift-key))
- (server-file-dialog obj "Save Source As.." (if (equal file-name "")
- (current-project-dir app)
- file-name)
- (lambda (fname)
- (window-focus win)
- (when fname
- (setf file-name fname)
- (add-class btn-save "w3-animate-top")
- (write-file (text-value ace) fname)
- (sleep .5)
- (remove-class btn-save "w3-animate-top"))
- :initial-filename file-name)))
- (t
- (add-class btn-save "w3-animate-top")
- (write-file (text-value ace) file-name)
- (sleep .5)
- (remove-class btn-save "w3-animate-top")))))
- (set-on-window-can-close win
- (lambda (obj)
- (cond (is-dirty
- (confirm-dialog obj "Save File?"
- (lambda (result)
- (setf is-dirty nil)
- (when result
- (save obj nil))
- (window-close win))
- :ok-text "Yes" :cancel-text "No")
- nil)
- (t
- t))))
- (set-on-mouse-click btn-save
- (lambda (obj data)
- (save obj data)
- (setf is-dirty nil))))
- (set-on-click btn-copy (lambda (obj)
- (declare (ignore obj))
- (clog-ace:clipboard-copy ace)))
- (set-on-click btn-cut (lambda (obj)
- (declare (ignore obj))
- (clog-ace:clipboard-cut ace)))
- (set-on-click btn-paste (lambda (obj)
+ (remove-class btn-save "w3-animate-top")))))
+ (set-on-window-can-close win
+ (lambda (obj)
+ (cond (is-dirty
+ (confirm-dialog obj "Save File?"
+ (lambda (result)
+ (setf is-dirty nil)
+ (when result
+ (save obj nil))
+ (window-close win))
+ :ok-text "Yes" :cancel-text "No")
+ nil)
+ (t
+ t))))
+ (set-on-mouse-click btn-save
+ (lambda (obj data)
+ (save obj data)
+ (setf is-dirty nil))))
+ (set-on-click btn-copy (lambda (obj)
+ (declare (ignore obj))
+ (clog-ace:clipboard-copy ace)))
+ (set-on-click btn-cut (lambda (obj)
(declare (ignore obj))
- (clog-ace:clipboard-paste ace)))
- (set-on-click btn-del (lambda (obj)
- (declare (ignore obj))
- (clog-ace:execute-command ace "del")))
- (set-on-click btn-undo (lambda (obj)
- (declare (ignore obj))
- (clog-ace:execute-command ace "undo")))
- (set-on-click btn-redo (lambda (obj)
- (declare (ignore obj))
- (clog-ace:execute-command ace "redo")))
- (set-on-click btn-efrm (lambda (obj)
- (let ((p (parse-integer
- (js-query obj
- (format nil "~A.session.doc.positionToIndex (~A.selection.getCursor(), 0);"
- (clog-ace::js-ace ace)
- (clog-ace::js-ace ace)))
- :junk-allowed t))
- (tv (text-value ace))
- (lf nil)
- (cp 0))
- (loop
- (setf (values lf cp) (read-from-string tv nil nil :start cp))
- (unless lf (return nil))
- (when (> cp p) (return lf)))
- (when lf
- (let ((result (capture-eval lf
- :clog-obj (connection-body obj)
- :eval-in-package (text-value pac-line))))
- (on-open-file obj :title-class "w3-blue" :title "form eval" :text result))))))
- (set-on-click btn-esel (lambda (obj)
- (let ((val (clog-ace:selected-text ace)))
- (unless (equal val "")
- (let ((result (capture-eval val :clog-obj obj
- :eval-in-package (text-value pac-line))))
- (on-open-file obj :title-class "w3-blue" :title "selection eval" :text result))))))
+ (clog-ace:clipboard-cut ace)))
+ (set-on-click btn-paste (lambda (obj)
+ (declare (ignore obj))
+ (clog-ace:clipboard-paste ace)))
+ (set-on-click btn-del (lambda (obj)
+ (declare (ignore obj))
+ (clog-ace:execute-command ace "del")))
+ (set-on-click btn-undo (lambda (obj)
+ (declare (ignore obj))
+ (clog-ace:execute-command ace "undo")))
+ (set-on-click btn-redo (lambda (obj)
+ (declare (ignore obj))
+ (clog-ace:execute-command ace "redo")))
+ (set-on-click btn-efrm (lambda (obj)
+ (let ((p (parse-integer
+ (js-query obj
+ (format nil "~A.session.doc.positionToIndex (~A.selection.getCursor(), 0);"
+ (clog-ace::js-ace ace)
+ (clog-ace::js-ace ace)))
+ :junk-allowed t))
+ (tv (text-value ace))
+ (lf nil)
+ (cp 0))
+ (loop
+ (setf (values lf cp) (read-from-string tv nil nil :start cp))
+ (unless lf (return nil))
+ (when (> cp p) (return lf)))
+ (when lf
+ (let ((result (capture-eval lf
+ :clog-obj (connection-body obj)
+ :eval-in-package (text-value pac-line))))
+ (on-open-file obj :title-class "w3-blue" :title "form eval" :text result))))))
+ (set-on-click btn-esel (lambda (obj)
+ (let ((val (clog-ace:selected-text ace)))
+ (unless (equal val "")
+ (let ((result (capture-eval val :clog-obj obj
+ :eval-in-package (text-value pac-line))))
+ (on-open-file obj :title-class "w3-blue" :title "selection eval" :text result))))))
- (set-on-click btn-test (lambda (obj)
- (let ((val (text-value ace)))
- (unless (equal val "")
- (let ((result (capture-eval val :clog-obj obj
- :eval-in-package (text-value pac-line))))
- (on-open-file obj :title-class "w3-blue" :title "file eval" :text result))))))))
+ (set-on-click btn-test (lambda (obj)
+ (let ((val (text-value ace)))
+ (unless (equal val "")
+ (let ((result (capture-eval val :clog-obj obj
+ :eval-in-package (text-value pac-line))))
+ (on-open-file obj :title-class "w3-blue" :title "file eval" :text result)))))))))
(defun on-repl (obj)
"Open a REPL"