mirror of
https://github.com/rabbibotton/clog.git
synced 2025-12-06 02:30:42 -08:00
Add menus to the panel editor
This commit is contained in:
David Botton
parent
a696f63133
commit
73ab5d9362
4 changed files with 354 additions and 308 deletions
|
|
@ -73,7 +73,7 @@
|
|||
(m-test (create-gui-menu-item m-lisp :content "Evaluate All"))
|
||||
(m-help (create-gui-menu-drop-down menu :content "Help"))
|
||||
(m-helpk (create-gui-menu-item m-help :content "Keyboard Help"))
|
||||
(tool-bar (create-div (top-panel box) :class "w3-center"))
|
||||
(tool-bar (create-div (top-panel box)))
|
||||
(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))
|
||||
|
|
@ -154,10 +154,10 @@
|
|||
(declare (ignore obj))
|
||||
(alert-dialog win
|
||||
"<table>
|
||||
<tr><td>cmd/alt-,</td><td>Configure editor</td></tr>
|
||||
<tr><td>cmd/ctrl-,</td><td>Configure editor</td></tr>
|
||||
<tr><td>cmd/alt-.</td><td> Launch system browser</td></tr>
|
||||
<tr><td>cmd/alt-[</td><td> Evaluate form</td></tr>
|
||||
<tr><td>cmd/ctl-s</td><td> Save</td></tr>
|
||||
<tr><td>cmd/ctrl-s</td><td> Save</td></tr>
|
||||
<tr><td>ctl-=</td><td>Expand region</td></tr>
|
||||
<tr><td>opt/alt-m</td><td>Macroexpand</td></tr>
|
||||
</table><p><a target='_blank' href='https://github.com/ajaxorg/ace/wiki/Default-Keyboard-Shortcuts'>Default Keybindings</a>"
|
||||
|
|
@ -169,38 +169,40 @@
|
|||
(lambda (obj)
|
||||
(declare (ignore obj))
|
||||
(clog-ace:resize ace)))
|
||||
(flet ((open-file-name (fname)
|
||||
(window-focus win)
|
||||
(handler-case
|
||||
(when fname
|
||||
(setf last-date (file-write-date fname))
|
||||
(setf file-name fname)
|
||||
(setf (window-title win) fname)
|
||||
(let ((c (or (read-file fname :clog-obj obj) "")))
|
||||
(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)))
|
||||
(error (condition)
|
||||
(alert-toast obj "File Error" (format nil "Error: ~A" condition))
|
||||
(format t "Error: ~A" condition)))))
|
||||
(labels ((open-file-name (fname)
|
||||
(window-focus win)
|
||||
(handler-case
|
||||
(when fname
|
||||
(setf last-date (file-write-date fname))
|
||||
(setf file-name fname)
|
||||
(setf (window-title win) fname)
|
||||
(let ((c (or (read-file fname :clog-obj obj) "")))
|
||||
(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)))
|
||||
(error (condition)
|
||||
(alert-toast obj "File Error" (format nil "Error: ~A" condition))
|
||||
(format t "Error: ~A" condition))))
|
||||
(load-file (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)))))
|
||||
(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 "")
|
||||
(current-project-dir app)
|
||||
file-name))
|
||||
(lambda (fname)
|
||||
(open-file-name fname)
|
||||
(setf is-dirty nil))))))
|
||||
(set-on-click btn-load (lambda (obj) (load-file obj)))
|
||||
(set-on-click m-load (lambda (obj) (load-file obj))))
|
||||
(set-on-input ace (lambda (obj)
|
||||
(declare (ignore obj))
|
||||
(setf is-dirty t)))
|
||||
|
|
|
|||
|
|
@ -500,8 +500,30 @@ not a temporarily attached one when using select-control."
|
|||
:client-movement *client-side-movement*))
|
||||
(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"))
|
||||
:top-height 70 :bottom-height 0))
|
||||
(menu (create-gui-menu-bar (top-panel box) :main-menu nil))
|
||||
(m-file (create-gui-menu-drop-down menu :content "File"))
|
||||
(m-load (create-gui-menu-item m-file :content "load"))
|
||||
(m-save (create-gui-menu-item m-file :content "save (cmd/ctrl-s)"))
|
||||
(m-saveas (create-gui-menu-item m-file :content "save as.."))
|
||||
(m-edit (create-gui-menu-drop-down menu :content "Edit"))
|
||||
(m-undo (create-gui-menu-item m-edit :content "undo"))
|
||||
(m-redo (create-gui-menu-item m-edit :content "redo"))
|
||||
(m-copy (create-gui-menu-item m-edit :content "copy"))
|
||||
(m-paste (create-gui-menu-item m-edit :content "paste"))
|
||||
(m-cut (create-gui-menu-item m-edit :content "cut"))
|
||||
(m-del (create-gui-menu-item m-edit :content "delete"))
|
||||
(m-lisp (create-gui-menu-drop-down menu :content "Lisp"))
|
||||
(m-rndr (create-gui-menu-item m-lisp :content "render form to lisp"))
|
||||
(m-rndras (create-gui-menu-item m-lisp :content "render form to lisp as..."))
|
||||
(m-test (create-gui-menu-item m-lisp :content "evaluate and test"))
|
||||
(m-events (create-gui-menu-drop-down menu :content "Events"))
|
||||
(tmp (create-gui-menu-item m-events :content "Control CLOG Events" :on-click 'on-show-control-events-win))
|
||||
(tmp (create-gui-menu-item m-events :content "Control JavaScript Events" :on-click 'on-show-control-js-events-win))
|
||||
(tmp (create-gui-menu-item m-events :content "Control ParenScript Events" :on-click 'on-show-control-ps-events-win))
|
||||
(m-help (create-gui-menu-drop-down menu :content "Help"))
|
||||
(m-helpk (create-gui-menu-item m-help :content "quick start"))
|
||||
(tool-bar (create-div (top-panel box)))
|
||||
(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))
|
||||
|
|
@ -527,6 +549,8 @@ not a temporarily attached one when using select-control."
|
|||
(render-file-name "")
|
||||
(panel-id (html-id content)))
|
||||
(declare (ignore spacer))
|
||||
(add-class menu "w3-small")
|
||||
(setf (overflow (top-panel box)) :visible) ; let menus leave the top panel
|
||||
(setf (background-color (top-panel box)) :black)
|
||||
(setf (checkedp cbox) t)
|
||||
(setf (advisory-title btn-copy) "copy")
|
||||
|
|
@ -590,93 +614,6 @@ not a temporarily attached one when using select-control."
|
|||
(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=$('<div />').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)
|
||||
(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))
|
||||
|
|
@ -685,43 +622,140 @@ not a temporarily attached one when using select-control."
|
|||
(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 last-date (file-write-date 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 :clog-obj obj)
|
||||
""))
|
||||
(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)))
|
||||
;; setup tool bar events
|
||||
(set-on-click btn-help 'on-quick-start)
|
||||
(set-on-click m-helpk 'on-quick-start)
|
||||
(labels (;; 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=$('<div />').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')")))
|
||||
(cut (obj)
|
||||
(copy obj)
|
||||
(del obj))
|
||||
(undo (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)))
|
||||
(redo (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))))
|
||||
;; set up del/cut/copy/paste handlers
|
||||
(set-on-copy content #'copy)
|
||||
(set-on-click btn-copy #'copy)
|
||||
(set-on-click m-copy #'copy)
|
||||
(set-on-paste content #'paste)
|
||||
(set-on-click btn-paste #'paste)
|
||||
(set-on-click m-paste #'paste)
|
||||
(set-on-click btn-del #'del)
|
||||
(set-on-click m-del #'del)
|
||||
(set-on-cut content #'cut)
|
||||
(set-on-click btn-cut #'cut)
|
||||
(set-on-click m-cut #'cut)
|
||||
(set-on-click btn-undo #'undo)
|
||||
(set-on-click m-undo #'undo)
|
||||
(set-on-click btn-redo #'redo)
|
||||
(set-on-click m-redo #'redo))
|
||||
(labels ((open-file-name (fname)
|
||||
(setf file-name fname)
|
||||
(setf last-date (file-write-date 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 :clog-obj obj)
|
||||
""))
|
||||
(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))
|
||||
(load-file (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))))))
|
||||
(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)))))))
|
||||
(set-on-click btn-load #'load-file)
|
||||
(set-on-click m-load #'load-file))
|
||||
(labels ((do-save (obj fname data)
|
||||
(declare (ignore data))
|
||||
(setf file-name fname)
|
||||
|
|
@ -744,8 +778,9 @@ not a temporarily attached one when using select-control."
|
|||
(window-close win))
|
||||
(t
|
||||
(setf is-dirty nil))))
|
||||
(save (obj data)
|
||||
(save (obj data &key save-as)
|
||||
(cond ((or (equal file-name "")
|
||||
save-as
|
||||
(getf data :shift-key))
|
||||
(when (equal file-name "")
|
||||
(setf file-name (format nil "~A~A.clog"
|
||||
|
|
@ -763,7 +798,38 @@ not a temporarily attached one when using select-control."
|
|||
(confirm-dialog obj "Panel changed on file system. Save?"
|
||||
(lambda (result)
|
||||
(when result
|
||||
(do-save obj file-name data)))))))))
|
||||
(do-save obj file-name data))))))))
|
||||
(eval-test (obj)
|
||||
(do-eval obj (render-clog-code content (bottom-panel box))
|
||||
(attribute content "data-clog-name")
|
||||
:package (attribute content "data-in-package")))
|
||||
(render (obj data &key save-as)
|
||||
(cond ((or (equal render-file-name "")
|
||||
save-as
|
||||
(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 :clog-obj obj)
|
||||
(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 :clog-obj obj)
|
||||
(sleep .5)
|
||||
(remove-class btn-rndr "w3-animate-top")))))
|
||||
(set-on-window-can-close win
|
||||
(lambda (obj)
|
||||
(cond (is-dirty
|
||||
|
|
@ -781,40 +847,16 @@ not a temporarily attached one when using select-control."
|
|||
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 :clog-obj obj)
|
||||
(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 :clog-obj obj)
|
||||
(sleep .5)
|
||||
(remove-class btn-rndr "w3-animate-top")))))
|
||||
(save obj data)))
|
||||
(set-on-click m-save (lambda (obj)
|
||||
(save obj nil)))
|
||||
(set-on-click m-saveas (lambda (obj)
|
||||
(save obj nil :save-as t)))
|
||||
(set-on-click btn-test #'eval-test)
|
||||
(set-on-click m-test #'eval-test)
|
||||
(set-on-mouse-click btn-rndr (lambda (obj data) (render obj data)))
|
||||
(set-on-click m-rndr (lambda (obj) (render obj nil)))
|
||||
(set-on-click m-rndras (lambda (obj) (render obj nil :save-as t))))
|
||||
(set-on-mouse-down content
|
||||
(lambda (obj data)
|
||||
(declare (ignore obj))
|
||||
|
|
|
|||
|
|
@ -14,120 +14,122 @@
|
|||
(clog-ace:resize (src-box panel))))))
|
||||
|
||||
(defun sys-browser-populate (panel)
|
||||
(setf (inner-html (class-box panel)) "")
|
||||
(setf (text-value (src-box panel)) "")
|
||||
(setf (text-value (doc-box panel)) "")
|
||||
(setf (text-value (file-name panel)) "")
|
||||
(setf (fname panel) nil)
|
||||
(let* ((filter (text-value (search-box panel)))
|
||||
(has-pac (position #\: filter :test #'equal))
|
||||
(class-only (checkedp (class-only panel)))
|
||||
(pac (text-value (package-box panel))))
|
||||
(when has-pac
|
||||
(setf pac (string-upcase (subseq filter 0 has-pac)))
|
||||
(setf (text-value (package-box panel)) pac)
|
||||
(unless (equalp (text-value (package-box panel)) pac)
|
||||
(setf (text-value (package-box panel)) "All")
|
||||
(setf pac "All"))
|
||||
(setf filter (subseq filter (+ has-pac 1)))
|
||||
(setf (text-value (search-box panel)) filter))
|
||||
(cond ((equalp pac "All")
|
||||
(setf class-only nil)
|
||||
(setf (classes panel) nil)
|
||||
(unless (equal filter "")
|
||||
(setf (classes panel) (definitions:apropos-definitions
|
||||
filter
|
||||
:type (find-symbol
|
||||
(text-value (type-box panel))
|
||||
(find-package :definitions))))))
|
||||
(t
|
||||
(setf (classes panel) (definitions:find-definitions
|
||||
(text-value (package-box panel))
|
||||
:package (find-package :key)
|
||||
:type (find-symbol
|
||||
(text-value (type-box panel))
|
||||
(find-package :definitions))))))
|
||||
(let ((i 0))
|
||||
(dolist (c (classes panel))
|
||||
(let ((name (format nil "~A" (definitions:designator c))))
|
||||
(if (or (equal filter "")
|
||||
(search filter name :test #'char-equal))
|
||||
(if class-only
|
||||
(if (equalp (package-name (definitions:package c))
|
||||
pac)
|
||||
(add-select-option (class-box panel) i
|
||||
(format nil "~A - ~A"
|
||||
name
|
||||
(definitions:type c))))
|
||||
(add-select-option (class-box panel) i
|
||||
(format nil "~A:~A - ~A"
|
||||
(package-name (definitions:package c))
|
||||
name
|
||||
(definitions:type c)))))
|
||||
(incf i))))))
|
||||
(ignore-errors ; ignore invalid searches
|
||||
(setf (inner-html (class-box panel)) "")
|
||||
(setf (text-value (src-box panel)) "")
|
||||
(setf (text-value (doc-box panel)) "")
|
||||
(setf (text-value (file-name panel)) "")
|
||||
(setf (fname panel) nil)
|
||||
(let* ((filter (text-value (search-box panel)))
|
||||
(has-pac (position #\: filter :test #'equal))
|
||||
(class-only (checkedp (class-only panel)))
|
||||
(pac (text-value (package-box panel))))
|
||||
(when has-pac
|
||||
(setf pac (string-upcase (subseq filter 0 has-pac)))
|
||||
(setf (text-value (package-box panel)) pac)
|
||||
(unless (equalp (text-value (package-box panel)) pac)
|
||||
(setf (text-value (package-box panel)) "All")
|
||||
(setf pac "All"))
|
||||
(setf filter (subseq filter (+ has-pac 1)))
|
||||
(setf (text-value (search-box panel)) filter))
|
||||
(cond ((equalp pac "All")
|
||||
(setf class-only nil)
|
||||
(setf (classes panel) nil)
|
||||
(unless (equal filter "")
|
||||
(setf (classes panel) (definitions:apropos-definitions
|
||||
filter
|
||||
:type (find-symbol
|
||||
(text-value (type-box panel))
|
||||
(find-package :definitions))))))
|
||||
(t
|
||||
(setf (classes panel) (definitions:find-definitions
|
||||
(text-value (package-box panel))
|
||||
:package (find-package :key)
|
||||
:type (find-symbol
|
||||
(text-value (type-box panel))
|
||||
(find-package :definitions))))))
|
||||
(let ((i 0))
|
||||
(dolist (c (classes panel))
|
||||
(let ((name (format nil "~A" (definitions:designator c))))
|
||||
(if (or (equal filter "")
|
||||
(search filter name :test #'char-equal))
|
||||
(if class-only
|
||||
(if (equalp (package-name (definitions:package c))
|
||||
pac)
|
||||
(add-select-option (class-box panel) i
|
||||
(format nil "~A - ~A"
|
||||
name
|
||||
(definitions:type c))))
|
||||
(add-select-option (class-box panel) i
|
||||
(format nil "~A:~A - ~A"
|
||||
(package-name (definitions:package c))
|
||||
name
|
||||
(definitions:type c)))))
|
||||
(incf i)))))))
|
||||
|
||||
(defun sys-browser-select (panel target)
|
||||
(let* ((item (nth (parse-integer (text-value (class-box panel))) (classes panel))))
|
||||
(setf (fname panel) (getf (definitions:source-location item) :file))
|
||||
(setf (text-value (doc-box panel))
|
||||
(or (definitions:documentation item)
|
||||
"No documentation"))
|
||||
(cond ((fname panel)
|
||||
(let ((c (read-file (fname panel))))
|
||||
(setf (text-value (src-box panel)) c)
|
||||
(setf (text-value (pac-box panel)) (get-package-from-string c)))
|
||||
(setf (text-value (file-name panel)) (fname panel))
|
||||
(setf (disabledp (eval-button panel)) nil)
|
||||
(setf (disabledp (eval-sel-button panel)) nil)
|
||||
(setf (disabledp (eval-form-button panel)) nil)
|
||||
(setf (state panel) nil)
|
||||
(let* ((type (type-of item))
|
||||
(name (format nil "~A" (definitions:designator item))))
|
||||
(setf name (ppcre:regex-replace-all "\\\\" name "\\x5C\\x5C"))
|
||||
(setf name (ppcre:regex-replace-all "\\\(" name "\\x5C("))
|
||||
(setf name (ppcre:regex-replace-all "\\\)" name "\\x5C)"))
|
||||
(setf name (ppcre:regex-replace-all "\\\*" name "\\x5C*"))
|
||||
(js-execute target (format nil "~A.find('~A',{caseSensitive:false,regExp:true})"
|
||||
(clog-ace::js-ace (src-box panel))
|
||||
(cond ((eq type 'definitions:generic-function)
|
||||
(format nil "defgeneric\\\\s+~A" name))
|
||||
((eq type 'definitions:method)
|
||||
(format nil "defmethod\\\\s+~A" name))
|
||||
((eq type 'definitions:function)
|
||||
(format nil "defun\\\\s+~A" name))
|
||||
((eq type 'definitions:macro)
|
||||
(format nil "defmacro\\\\s+~A" name))
|
||||
((eq type 'definitions:class)
|
||||
(format nil "defclass\\\\s+~A" name))
|
||||
((eq type 'definitions:compiler-macro)
|
||||
(format nil "define-compiler-macro\\\\s+~A" name))
|
||||
((eq type 'definitions:condition)
|
||||
(format nil "define-condition\\\\s+~A" name))
|
||||
((eq type 'definitions:alien-type)
|
||||
(format nil "define-alien-type ~A" name))
|
||||
((eq type 'definitions:constant)
|
||||
(format nil "defconstant\\\\s+~A" name))
|
||||
((eq type 'definitions:package)
|
||||
(format nil "defpackage\\\\s+~A" name))
|
||||
((eq type 'definitions:special-variable)
|
||||
(format nil "(defsection|defparameter|defvar)\\\\s+~A" name))
|
||||
((eq type 'definitions:vop)
|
||||
(format nil "define-type-vop\\\\s+~A" name))
|
||||
((eq type 'definitions:structure)
|
||||
(format nil "defstruct\\\\s*\\\\(\\\\s*~A" name))
|
||||
((eq type 'definitions:setf-expander)
|
||||
(format nil "(defsetf|def)\\\\s+~A" name))
|
||||
((eq type 'definitions:optimizer)
|
||||
(format nil "defoptimizer\\\\s*\\\\(\\\\s*~A" name))
|
||||
((eq type 'definitions:ir1-convert)
|
||||
(format nil "def-ir1-translator\\\\s+~A" name))
|
||||
(t
|
||||
name))))))
|
||||
(t
|
||||
(setf (text-value (file-name panel)) "")
|
||||
(setf (disabledp (eval-button panel)) t)
|
||||
(setf (disabledp (eval-sel-button panel)) t)
|
||||
(setf (disabledp (eval-form-button panel)) t)
|
||||
(setf (disabledp (save-button panel)) t)
|
||||
(setf (state panel) t)
|
||||
(setf (text-value (src-box panel)) "No file information")))))
|
||||
(ignore-errors
|
||||
(let* ((item (nth (parse-integer (text-value (class-box panel))) (classes panel))))
|
||||
(setf (fname panel) (getf (definitions:source-location item) :file))
|
||||
(setf (text-value (doc-box panel))
|
||||
(or (definitions:documentation item)
|
||||
"No documentation"))
|
||||
(cond ((fname panel)
|
||||
(let ((c (read-file (fname panel))))
|
||||
(setf (text-value (src-box panel)) c)
|
||||
(setf (text-value (pac-box panel)) (get-package-from-string c)))
|
||||
(setf (text-value (file-name panel)) (fname panel))
|
||||
(setf (disabledp (eval-button panel)) nil)
|
||||
(setf (disabledp (eval-sel-button panel)) nil)
|
||||
(setf (disabledp (eval-form-button panel)) nil)
|
||||
(setf (state panel) nil)
|
||||
(let* ((type (type-of item))
|
||||
(name (format nil "~A" (definitions:designator item))))
|
||||
(setf name (ppcre:regex-replace-all "\\\\" name "\\x5C\\x5C"))
|
||||
(setf name (ppcre:regex-replace-all "\\\(" name "\\x5C("))
|
||||
(setf name (ppcre:regex-replace-all "\\\)" name "\\x5C)"))
|
||||
(setf name (ppcre:regex-replace-all "\\\*" name "\\x5C*"))
|
||||
(js-execute target (format nil "~A.find('~A',{caseSensitive:false,regExp:true})"
|
||||
(clog-ace::js-ace (src-box panel))
|
||||
(cond ((eq type 'definitions:generic-function)
|
||||
(format nil "defgeneric\\\\s+~A" name))
|
||||
((eq type 'definitions:method)
|
||||
(format nil "defmethod\\\\s+~A" name))
|
||||
((eq type 'definitions:function)
|
||||
(format nil "defun\\\\s+~A" name))
|
||||
((eq type 'definitions:macro)
|
||||
(format nil "defmacro\\\\s+~A" name))
|
||||
((eq type 'definitions:class)
|
||||
(format nil "defclass\\\\s+~A" name))
|
||||
((eq type 'definitions:compiler-macro)
|
||||
(format nil "define-compiler-macro\\\\s+~A" name))
|
||||
((eq type 'definitions:condition)
|
||||
(format nil "define-condition\\\\s+~A" name))
|
||||
((eq type 'definitions:alien-type)
|
||||
(format nil "define-alien-type ~A" name))
|
||||
((eq type 'definitions:constant)
|
||||
(format nil "defconstant\\\\s+~A" name))
|
||||
((eq type 'definitions:package)
|
||||
(format nil "defpackage\\\\s+~A" name))
|
||||
((eq type 'definitions:special-variable)
|
||||
(format nil "(defsection|defparameter|defvar)\\\\s+~A" name))
|
||||
((eq type 'definitions:vop)
|
||||
(format nil "define-type-vop\\\\s+~A" name))
|
||||
((eq type 'definitions:structure)
|
||||
(format nil "defstruct\\\\s*\\\\(\\\\s*~A" name))
|
||||
((eq type 'definitions:setf-expander)
|
||||
(format nil "(defsetf|def)\\\\s+~A" name))
|
||||
((eq type 'definitions:optimizer)
|
||||
(format nil "defoptimizer\\\\s*\\\\(\\\\s*~A" name))
|
||||
((eq type 'definitions:ir1-convert)
|
||||
(format nil "def-ir1-translator\\\\s+~A" name))
|
||||
(t
|
||||
name))))))
|
||||
(t
|
||||
(setf (text-value (file-name panel)) "")
|
||||
(setf (disabledp (eval-button panel)) t)
|
||||
(setf (disabledp (eval-sel-button panel)) t)
|
||||
(setf (disabledp (eval-form-button panel)) t)
|
||||
(setf (disabledp (save-button panel)) t)
|
||||
(setf (state panel) t)
|
||||
(setf (text-value (src-box panel)) "No file information"))))))
|
||||
|
|
|
|||
|
|
@ -337,7 +337,7 @@ clog-builder window.")
|
|||
(open-panel (form-data-item (form-get-data body) "open-panel")))
|
||||
(setf (connection-data-item body "builder-app-data") app)
|
||||
(setf (title (html-document body)) "CLOG Builder")
|
||||
(clog-gui-initialize body :body-left-offset 10 :body-right-offset 10)
|
||||
(clog-gui-initialize body)
|
||||
(add-class body "w3-blue-grey")
|
||||
(setf (z-index (create-panel body :positioning :fixed
|
||||
:bottom 0 :left 222
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue