mirror of
https://github.com/rabbibotton/clog.git
synced 2025-12-06 02:30:42 -08:00
window-center
This commit is contained in:
David Botton
parent
29122904ec
commit
339b3cce6d
5 changed files with 71 additions and 57 deletions
|
|
@ -8,10 +8,7 @@
|
|||
(in-package :clog-user)
|
||||
|
||||
(defclass app-data ()
|
||||
((body
|
||||
:accessor body
|
||||
:documentation "Top level access to browser window")
|
||||
(copy-buf
|
||||
((copy-buf
|
||||
:accessor copy-buf
|
||||
:initform ""
|
||||
:documentation "Copy buffer")))
|
||||
|
|
@ -65,35 +62,32 @@
|
|||
(html-id win)))))
|
||||
|
||||
(defun do-ide-file-open (obj)
|
||||
(let ((app (connection-data-item obj "app-data")))
|
||||
(server-file-dialog obj "Open..." "./"
|
||||
(lambda (fname)
|
||||
(when fname
|
||||
(do-ide-file-new obj)
|
||||
(setf (window-title (current-window obj)) fname)
|
||||
(js-execute obj
|
||||
(format nil "editor_~A.setValue('~A');editor_~A.moveCursorTo(0,0);"
|
||||
(html-id (current-window obj))
|
||||
(escape-string (read-file fname))
|
||||
(html-id (current-window obj))))))
|
||||
:top 10
|
||||
:left (- (/ (width (body app)) 2) 200))))
|
||||
(server-file-dialog obj "Open..." "./"
|
||||
(lambda (fname)
|
||||
(when fname
|
||||
(do-ide-file-new obj)
|
||||
(setf (window-title (current-window obj)) fname)
|
||||
(js-execute obj
|
||||
(format nil
|
||||
"editor_~A.setValue('~A');editor_~A.moveCursorTo(0,0);"
|
||||
(html-id (current-window obj))
|
||||
(escape-string (read-file fname))
|
||||
(html-id (current-window obj))))))))
|
||||
|
||||
(defun do-ide-file-save-as (obj)
|
||||
(let* ((app (connection-data-item obj "app-data"))
|
||||
(cw (current-window obj))
|
||||
(let* ((cw (current-window obj))
|
||||
(dir (directory-namestring (window-title cw))))
|
||||
(when cw
|
||||
(server-file-dialog obj "Save As.." dir
|
||||
(lambda (fname)
|
||||
(window-focus cw)
|
||||
(when fname
|
||||
(setf (window-title cw) fname)
|
||||
(write-file (js-query obj (format nil "editor_~A.getValue()"
|
||||
(html-id cw)))
|
||||
fname)))
|
||||
:top 10
|
||||
:left (- (/ (width (body app)) 2) 200)
|
||||
:initial-filename (window-title cw)))))
|
||||
:initial-filename (when (equal (window-title cw) "New Window")
|
||||
(window-title cw))))))
|
||||
|
||||
(defun do-ide-file-save (obj)
|
||||
(if (equalp (window-title (current-window obj)) "New Window")
|
||||
|
|
@ -124,7 +118,7 @@
|
|||
(defun do-ide-edit-copy (obj)
|
||||
(let ((cw (current-window obj)))
|
||||
(when cw
|
||||
(let* ((app (connection-data-item obj "app-data")))
|
||||
(let ((app (connection-data-item obj "app-data")))
|
||||
(setf (copy-buf app) (js-query obj
|
||||
(format nil "editor_~A.execCommand('copy');~
|
||||
navigator.clipboard.writeText(editor_~A.getCopyText());~
|
||||
|
|
@ -141,13 +135,12 @@
|
|||
(defun do-ide-edit-paste (obj)
|
||||
(let ((cw (current-window obj)))
|
||||
(when cw
|
||||
(let ((app (connection-data-item obj "app-data")))
|
||||
;; Note this methods uses the global clip buffer and not (copy-buf app)
|
||||
;; on copy and paste we set both the global and local buffer.
|
||||
(js-execute obj (format nil "navigator.clipboard.readText().then(function(text) {~
|
||||
;; Note this methods uses the global clip buffer and not (copy-buf app)
|
||||
;; on copy and paste we set both the global and local buffer.
|
||||
(js-execute obj (format nil "navigator.clipboard.readText().then(function(text) {~
|
||||
editor_~A.execCommand('paste', text)~
|
||||
})"
|
||||
(html-id cw)))))))
|
||||
(html-id cw))))))
|
||||
|
||||
(defun do-ide-lisp-eval-file (obj)
|
||||
(let ((cw (current-window obj)))
|
||||
|
|
@ -164,26 +157,23 @@
|
|||
(html-id cw)))))))
|
||||
|
||||
(defun do-ide-help-about (obj)
|
||||
(let* ((app (connection-data-item obj "app-data"))
|
||||
(about (create-gui-window obj
|
||||
:title "About"
|
||||
:content "<div class='w3-black'>
|
||||
(let ((about (create-gui-window obj
|
||||
:title "About"
|
||||
:content "<div class='w3-black'>
|
||||
<center><img src='/img/clogwicon.png'></center>
|
||||
<center>CLOG</center>
|
||||
<center>The Common Lisp Omnificent GUI</center></div>
|
||||
<div><p><center>Demo 3</center>
|
||||
<center>(c) 2021 - David Botton</center></p></div>"
|
||||
:left (- (/ (inner-width (window (body app))) 2.0) 100)
|
||||
:top (- (/ (inner-height (window (body app))) 2.0) 100)
|
||||
:width 200
|
||||
:height 200)))
|
||||
:width 200
|
||||
:height 200)))
|
||||
(window-center about)
|
||||
(set-on-window-can-size about (lambda (obj)
|
||||
(declare (ignore obj))()))))
|
||||
|
||||
(defun on-new-window (body)
|
||||
(let ((app (make-instance 'app-data)))
|
||||
(setf (connection-data-item body "app-data") app)
|
||||
(setf (body app) body))
|
||||
(setf (connection-data-item body "app-data") app))
|
||||
(clog-gui-initialize body)
|
||||
(load-script (html-document body) "https://pagecdn.io/lib/ace/1.4.12/ace.js")
|
||||
(add-class body "w3-teal")
|
||||
|
|
|
|||
|
|
@ -823,7 +823,21 @@ interactions. Use window-end-modal to undo."))
|
|||
(let ((app (connection-data-item obj "clog-gui")))
|
||||
(remove-from-dom (modal-background app))
|
||||
(window-focus obj)))
|
||||
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;
|
||||
;; window-center ;;
|
||||
;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(defgeneric window-center (clog-gui-window)
|
||||
(:documentation "Center CLOG-GUI-WINDOW in browser."))
|
||||
|
||||
(defmethod window-center ((obj clog-gui-window))
|
||||
(let ((body (connection-data-item obj "clog-body")))
|
||||
(setf (top obj) (unit :px (- (/ (inner-height (window body)) 2.0)
|
||||
(/ (height obj) 2.0))))
|
||||
(setf (left obj) (unit :px (- (/ (inner-width (window body)) 2.0)
|
||||
(/ (width obj) 2.0))))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; window-toggle-maximize ;;
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
|
@ -1029,7 +1043,8 @@ interactions. Use window-end-modal to undo."))
|
|||
(initial-filename nil))
|
||||
"Create a local file dialog box called TITLE using INITIAL-DIR on server
|
||||
machine, upon close ON-FILE-NAME called with filename or nil if failure."
|
||||
(let* ((win (create-gui-window obj
|
||||
(let* ((body (connection-data-item obj "clog-body"))
|
||||
(win (create-gui-window obj
|
||||
:title title
|
||||
:maximize maximize
|
||||
:top top
|
||||
|
|
@ -1044,6 +1059,12 @@ machine, upon close ON-FILE-NAME called with filename or nil if failure."
|
|||
(create-label form :content "File Name:")))
|
||||
(ok (create-button form :content "OK"))
|
||||
(cancel (create-button form :content "Cancel")))
|
||||
(unless top
|
||||
(setf (top win) (unit :px (- (/ (inner-height (window body)) 2.0)
|
||||
(/ (height win) 2.0)))))
|
||||
(unless left
|
||||
(setf (left win) (unit :px (- (/ (inner-width (window body)) 2.0)
|
||||
(/ (width win) 2.0)))))
|
||||
(setf (size dirs) 4)
|
||||
(setf (box-width dirs) "100%")
|
||||
(setf (size files) 8)
|
||||
|
|
|
|||
|
|
@ -689,6 +689,7 @@ embedded in a native template application.)"
|
|||
(window-keep-on-top generic-function)
|
||||
(window-make-modal generic-function)
|
||||
(window-end-modal generic-function)
|
||||
(window-center generic-function)
|
||||
(set-on-window-focused generic-function)
|
||||
(set-on-window-blurred generic-function)
|
||||
(set-on-window-can-close generic-function)
|
||||
|
|
|
|||
|
|
@ -7,7 +7,11 @@
|
|||
(defclass app-data ()
|
||||
((body
|
||||
:accessor body
|
||||
:documentation "Top level access to browser window")))
|
||||
:documentation "Top level access to browser window")
|
||||
(db-connection
|
||||
:accessor db-connection
|
||||
:initform nil
|
||||
:documentation "Access to database connection")))
|
||||
|
||||
(defun on-db-open (obj)
|
||||
(let* ((app (connection-data-item obj "app-data"))
|
||||
|
|
@ -41,12 +45,15 @@
|
|||
<button class='w3-btn w3-black' id=odb-cancel>Cancel</button>
|
||||
|
||||
</form>"
|
||||
:left (- (/ (inner-width (window (body app))) 2.0) 200)
|
||||
:top (- (/ (inner-height (window (body app))) 2.0) 225)
|
||||
:width 400
|
||||
:height 450)))
|
||||
(set-on-click (attach-as-child obj "odb-open") (lambda (obj)
|
||||
(print "submit")))
|
||||
:width 400
|
||||
:height 450)))
|
||||
(window-center win)
|
||||
(set-on-click (attach-as-child obj "odb-open")
|
||||
(lambda (obj)
|
||||
(format t "open db : ~A" (name-value obj "db-name"))
|
||||
(setf (db-connection app)
|
||||
(dbi:connect :sqlite3
|
||||
:database-name (name-value obj "db-name")))))
|
||||
(set-on-click (attach-as-child obj "odb-cancel") (lambda (obj)
|
||||
(window-close win)))))
|
||||
|
||||
|
|
@ -62,11 +69,9 @@
|
|||
<center>The Common Lisp Omnificent GUI</center></div>
|
||||
<div><p><center>CLOG DB Admin</center>
|
||||
<center>(c) 2021 - David Botton</center></p></div>"
|
||||
:left (- (/ (inner-width (window (body app))) 2.0) 100)
|
||||
:top (- (/ (inner-height (window (body app))) 2.0) 100)
|
||||
:width 200
|
||||
:height 200)))
|
||||
(print (- (/ (inner-width (window (body app))) 2.0) 100))
|
||||
(window-center about)
|
||||
(set-on-window-can-size about (lambda (obj)
|
||||
(declare (ignore obj))()))))
|
||||
|
||||
|
|
|
|||
|
|
@ -44,20 +44,18 @@
|
|||
|
||||
(defun on-file-pinned (obj)
|
||||
(let ((win (create-gui-window obj :title "Pinned"
|
||||
:top (unit :px 50)
|
||||
:left (unit :px 0)
|
||||
:top 200
|
||||
:left 0
|
||||
:width 100
|
||||
:height 100)))
|
||||
(flet ((can-do (obj)()))
|
||||
(set-on-window-can-close win #'can-do)
|
||||
(set-on-window-can-move win #'can-do)
|
||||
(set-on-window-can-size win #'can-do))
|
||||
(window-keep-on-top win)
|
||||
(create-div win :content "I am pinned")))
|
||||
|
||||
(defun on-help-about (obj)
|
||||
(let* ((body (connection-data-item obj "clog-body"))
|
||||
(about (create-gui-window obj
|
||||
(let* ((about (create-gui-window obj
|
||||
:title "About"
|
||||
:content "<div class='w3-black'>
|
||||
<center><img src='/img/clogwicon.png'></center>
|
||||
|
|
@ -65,10 +63,9 @@
|
|||
<center>The Common Lisp Omnificent GUI</center></div>
|
||||
<div><p><center>Tutorial 22</center>
|
||||
<center>(c) 2021 - David Botton</center></p></div>"
|
||||
:left (- (/ (inner-width (window body)) 2.0) 100)
|
||||
:top (- (/ (inner-height (window body)) 2.0) 100)
|
||||
:width 200
|
||||
:height 200)))
|
||||
(window-center about)
|
||||
(set-on-window-can-size about (lambda (obj)
|
||||
(declare (ignore obj))()))))
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue