From ce339a4f5689b7f43f3685c1e3dff552e9f4e490 Mon Sep 17 00:00:00 2001 From: David Botton Date: Thu, 9 Jun 2022 19:17:58 -0400 Subject: [PATCH] remove tabs and trailing white spaces --- source/clog-auth.lisp | 14 +- source/clog-base.lisp | 380 ++++----- source/clog-body.lisp | 19 +- source/clog-canvas.lisp | 96 +-- source/clog-connection.lisp | 508 ++++++------ source/clog-data.lisp | 204 ++--- source/clog-dbi.lisp | 216 ++--- source/clog-docs.lisp | 10 +- source/clog-document.lisp | 28 +- source/clog-element-common.lisp | 1004 +++++++++++------------ source/clog-element.lisp | 140 ++-- source/clog-form.lisp | 334 ++++---- source/clog-gui.lisp | 1106 ++++++++++++------------- source/clog-helpers.lisp | 50 +- source/clog-jquery.lisp | 9 +- source/clog-location.lisp | 2 +- source/clog-multimedia.lisp | 346 ++++---- source/clog-navigator.lisp | 3 +- source/clog-panel.lisp | 290 +++---- source/clog-presentations.lisp | 60 +- source/clog-style.lisp | 52 +- source/clog-system.lisp | 65 +- source/clog-utilities.lisp | 108 +-- source/clog-web-dbi.lisp | 468 +++++------ source/clog-web-themes.lisp | 496 ++++++------ source/clog-web.lisp | 590 +++++++------- source/clog-window.lisp | 53 +- tools/clog-builder-settings.lisp | 1284 +++++++++++++++--------------- tools/clog-db-admin.lisp | 188 ++--- tools/clog-new-app.lisp | 10 +- 30 files changed, 4062 insertions(+), 4071 deletions(-) diff --git a/source/clog-auth.lisp b/source/clog-auth.lisp index b60ac63..192d2d3 100644 --- a/source/clog-auth.lisp +++ b/source/clog-auth.lisp @@ -48,7 +48,7 @@ for CLOG") (setf token nil)) (unless token (when auth-path - (url-assign (window body) auth-path))) + (url-assign (window body) auth-path))) token)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -74,10 +74,10 @@ for CLOG") (defun set-on-authentication-change (body handler) (check-type body clog-body) (set-on-storage (window body) (lambda (obj data) - (set-on-storage (window body) nil) - (when (equalp (getf data :key) - "clog-auth-token") - (funcall handler body))))) + (set-on-storage (window body) nil) + (when (equalp (getf data :key) + "clog-auth-token") + (funcall handler body))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Implementation - clog-auth - Authorization @@ -105,6 +105,6 @@ for CLOG") "Given ROLE-LIST is action authorized. If action is nil returns t." (if action (dolist (role role-list nil) - (when (member action (gethash role *authorization-hash*)) - (return t))) + (when (member action (gethash role *authorization-hash*)) + (return t))) t)) diff --git a/source/clog-base.lisp b/source/clog-base.lisp index c5c4243..0c17c03 100644 --- a/source/clog-base.lisp +++ b/source/clog-base.lisp @@ -118,7 +118,7 @@ flushed with FLUSH-CONNECTION-CACHE or a query is made." (when *connection-cache* (dolist (script (reverse *connection-cache*)) (unless (eq script :cache) - (clog-connection:execute (connection-id clog-obj) script))) + (clog-connection:execute (connection-id clog-obj) script))) (setf *connection-cache* (list :cache)))) ;;;;;;;;;;;;;; @@ -153,7 +153,7 @@ result or if time out DEFAULT-ANSWER. see JQUERY-QUERY (Internal)")) (defmethod query ((obj clog-obj) method &key (default-answer nil)) (js-query obj (format nil "~A.~A" (script-id obj) method) - :default-answer default-answer)) + :default-answer default-answer)) ;;;;;;;;;;;;;;;;;;;;;;; ;; bind-event-script ;; @@ -165,7 +165,7 @@ result or if time out DEFAULT-ANSWER. see JQUERY-QUERY (Internal)")) (defmethod bind-event-script ((obj clog-obj) event call-back) (jquery-execute obj (format nil "on('~A',function (e, data){~A})" - event call-back))) + event call-back))) ;;;;;;;;;;;;;;;;;;;;;;;;; ;; unbind-event-script ;; @@ -300,8 +300,8 @@ result or if time out DEFAULT-ANSWER. see JQUERY-QUERY (Internal)")) :shift-key (js-true-p (nth 4 f)) :meta-key (js-true-p (nth 5 f)) :key (if (equal (nth 6 f) "colon") - ":" - (nth 6 f))))) + ":" + (nth 6 f))))) ;;;;;;;;;;;;;;;;;;;;;; ;; parse-drop-event ;; @@ -332,39 +332,39 @@ result or if time out DEFAULT-ANSWER. see JQUERY-QUERY (Internal)")) ;;;;;;;;;;;;;;; (defgeneric set-event (clog-obj event handler - &key call-back-script - eval-script - post-eval - cancel-event - one-time) + &key call-back-script + eval-script + post-eval + cancel-event + one-time) (:documentation "Create the hook for incoming events. (Private)")) (defmethod set-event ((obj clog-obj) event handler - &key (call-back-script "") - (eval-script "") - (post-eval "") - (cancel-event nil) - (one-time nil)) + &key (call-back-script "") + (eval-script "") + (post-eval "") + (cancel-event nil) + (one-time nil)) (let ((hook (format nil "~A:~A" (html-id obj) event))) (cond (handler - (bind-event-script - obj event (format nil "~Aws.send('E:~A '~A)~A~A~A" - eval-script - hook - call-back-script - post-eval - (if one-time - (format nil "; ~A.off('~A')" - (jquery obj) - event) - "") - (if cancel-event - "; return false" - ""))) - (setf (gethash hook (connection-data obj)) handler)) - (t - (unbind-event-script obj event) - (remhash hook (connection-data obj)))))) + (bind-event-script + obj event (format nil "~Aws.send('E:~A '~A)~A~A~A" + eval-script + hook + call-back-script + post-eval + (if one-time + (format nil "; ~A.off('~A')" + (jquery obj) + event) + "") + (if cancel-event + "; return false" + ""))) + (setf (gethash hook (connection-data obj)) handler)) + (t + (unbind-event-script obj event) + (remhash hook (connection-data obj)))))) ;;;;;;;;;;;;;; ;; property ;; @@ -375,7 +375,7 @@ result or if time out DEFAULT-ANSWER. see JQUERY-QUERY (Internal)")) (defmethod property ((obj clog-obj) property-name &key (default-answer nil)) (jquery-query obj (format nil "prop('~A')" property-name) - :default-answer default-answer)) + :default-answer default-answer)) (defgeneric set-property (clog-obj property-name value) (:documentation "Set html property.")) @@ -533,10 +533,10 @@ nil unbind all event handlers. (Internal)")) (defmethod set-on-event ((obj clog-obj) event-name handler) (set-event obj event-name - (when handler - (lambda (data) - (declare (ignore data)) - (funcall handler obj))))) + (when handler + (lambda (data) + (declare (ignore data)) + (funcall handler obj))))) ;;;;;;;;;;;;;;;;;;; @@ -589,21 +589,21 @@ is nil unbind the event.")) ;;;;;;;;;;;;;;;;;;;;;;; (defgeneric set-on-drag-start (clog-obj on-drag-start-handler - &key drag-data drag-type) + &key drag-data drag-type) (:documentation "Set the ON-DRAG-START-HANDLER for CLOG-OBJ. If ON-DRAG-START-HANDLER is nil unbind the event.")) (defmethod set-on-drag-start ((obj clog-obj) handler - &key (drag-data "") (drag-type "text/plain")) + &key (drag-data "") (drag-type "text/plain")) (set-event obj "dragstart" - (when handler - (lambda (data) - (declare (ignore data)) - (funcall handler obj))) - :eval-script (format nil - "e.originalEvent.dataTransfer.setData('~A','~A'); " - drag-type - drag-data))) + (when handler + (lambda (data) + (declare (ignore data)) + (funcall handler obj))) + :eval-script (format nil + "e.originalEvent.dataTransfer.setData('~A','~A'); " + drag-type + drag-data))) ;;;;;;;;;;;;;;;;; ;; set-on-drag ;; @@ -660,12 +660,12 @@ is nil unbind the event.")) (defmethod set-on-drag-over ((obj clog-obj) handler) (set-event obj "dragover" - (when handler - (lambda (data) - (declare (ignore data)) - (funcall handler obj))) - :cancel-event t - :eval-script "e.preventDefault(); ")) + (when handler + (lambda (data) + (declare (ignore data)) + (funcall handler obj))) + :cancel-event t + :eval-script "e.preventDefault(); ")) ;;;;;;;;;;;;;;;;; ;; set-on-drop ;; @@ -677,12 +677,12 @@ is nil unbind the event.")) (defmethod set-on-drop ((obj clog-obj) handler &key (drag-type "text/plain")) (set-event obj "drop" - (when handler - (lambda (data) - (funcall handler obj (parse-drop-event data)))) - :call-back-script (format nil drop-event-script drag-type) - :eval-script "e.preventDefault(); " - :cancel-event t)) + (when handler + (lambda (data) + (funcall handler obj (parse-drop-event data)))) + :call-back-script (format nil drop-event-script drag-type) + :eval-script "e.preventDefault(); " + :cancel-event t)) ;;;;;;;;;;;;;;;;;;;;; ;; set-on-focus-in ;; @@ -717,11 +717,11 @@ this event is bound, you must call the form reset manually.")) (defmethod set-on-reset ((obj clog-obj) handler) (set-event obj "reset" - (when handler - (lambda (data) - (declare (ignore data)) - (funcall handler obj))) - :cancel-event t)) + (when handler + (lambda (data) + (declare (ignore data)) + (funcall handler obj))) + :cancel-event t)) ;;;;;;;;;;;;;;;;;;; ;; set-on-search ;; @@ -757,18 +757,18 @@ form action to be run. See CLOG-Form SUBMIT for more details.")) (defmethod set-on-submit ((obj clog-obj) handler) (set-event obj "submit" - (when handler - (lambda (data) - (declare (ignore data)) - (funcall handler obj))) - :cancel-event t)) + (when handler + (lambda (data) + (declare (ignore data)) + (funcall handler obj))) + :cancel-event t)) ;;;;;;;;;;;;;;;;;;;;;;;;; ;; set-on-context-menu ;; ;;;;;;;;;;;;;;;;;;;;;;;;; (defgeneric set-on-context-menu (clog-obj on-context-menu-handler - &key one-time) + &key one-time) (:documentation "Set the ON-CONTEXT-MENU-HANDLER for CLOG-OBJ. If ON-CONTEXT-MENU-HANDLER is nil unbind the event. Setting on-mouse-right-click will replace this handler. If :ONE-TIME unbind @@ -776,12 +776,12 @@ event on right click.")) (defmethod set-on-context-menu ((obj clog-obj) handler &key (one-time nil)) (set-event obj "contextmenu" - (when handler - (lambda (data) - (declare (ignore data)) - (funcall handler obj))) - :one-time one-time - :cancel-event t)) + (when handler + (lambda (data) + (declare (ignore data)) + (funcall handler obj))) + :one-time one-time + :cancel-event t)) ;;;;;;;;;;;;;;;;;; ;; set-on-click ;; @@ -794,29 +794,29 @@ set. If :ONE-TIME unbind event on click.")) (defmethod set-on-click ((obj clog-obj) handler &key (one-time nil)) (set-event obj "click" - (when handler - (lambda (data) - (declare (ignore data)) - (funcall handler obj))) - :one-time one-time)) + (when handler + (lambda (data) + (declare (ignore data)) + (funcall handler obj))) + :one-time one-time)) ;;;;;;;;;;;;;;;;;;;;;;;;; ;; set-on-double-click ;; ;;;;;;;;;;;;;;;;;;;;;;;;; (defgeneric set-on-double-click (clog-obj on-double-click-handler - &key one-time) + &key one-time) (:documentation "Set the ON-DOUBLE-CLICK-HANDLER for CLOG-OBJ. If ON-DOUBLE-CLICK-HANDLER is nil unbind the event. Setting the on-mouse-double-click event will replace this handler.")) (defmethod set-on-double-click ((obj clog-obj) handler &key (one-time nil)) (set-event obj "dblclick" - (when handler - (lambda (data) - (declare (ignore data)) - (funcall handler obj))) - :one-time one-time)) + (when handler + (lambda (data) + (declare (ignore data)) + (funcall handler obj))) + :one-time one-time)) ;;;;;;;;;;;;;;;;;;;;;;;; ;; set-on-mouse-click ;; @@ -829,49 +829,49 @@ on an on-click event.")) (defmethod set-on-mouse-click ((obj clog-obj) handler &key (one-time nil)) (set-event obj "click" - (when handler - (lambda (data) - (funcall handler obj (parse-mouse-event data)))) - :one-time one-time - :call-back-script mouse-event-script)) + (when handler + (lambda (data) + (funcall handler obj (parse-mouse-event data)))) + :one-time one-time + :call-back-script mouse-event-script)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; set-on-mouse-double-click ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defgeneric set-on-mouse-double-click (clog-obj on-mouse-double-click-handler - &key one-time) + &key one-time) (:documentation "Set the ON-MOUSE-DOUBLE-CLICK-HANDLER for CLOG-OBJ. If ON-MOUSE-DOUBLE-CLICK-HANDLER is nil unbind the event. Setting this event will replace on an on-double-click event.")) (defmethod set-on-mouse-double-click ((obj clog-obj) handler &key (one-time nil)) (set-event obj "dblclick" - (when handler - (lambda (data) - (funcall handler obj (parse-mouse-event data)))) - :one-time one-time - :call-back-script mouse-event-script)) + (when handler + (lambda (data) + (funcall handler obj (parse-mouse-event data)))) + :one-time one-time + :call-back-script mouse-event-script)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; set-on-mouse-right-click ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defgeneric set-on-mouse-right-click (clog-obj on-mouse-right-click-handler - &key one-time) + &key one-time) (:documentation "Set the ON-MOUSE-RIGHT-CLICK-HANDLER for CLOG-OBJ. If ON-MOUSE-RIGHT-CLICK-HANDLER is nil unbind the event. Setting this event will replace on an on-context-menu event.")) (defmethod set-on-mouse-right-click ((obj clog-obj) handler - &key (one-time nil)) + &key (one-time nil)) (set-event obj "contextmenu" - (when handler - (lambda (data) - (funcall handler obj (parse-mouse-event data)))) - :one-time one-time - :call-back-script mouse-event-script - :cancel-event t)) + (when handler + (lambda (data) + (funcall handler obj (parse-mouse-event data)))) + :one-time one-time + :call-back-script mouse-event-script + :cancel-event t)) ;;;;;;;;;;;;;;;;;;;;;;;; ;; set-on-mouse-enter ;; @@ -928,12 +928,12 @@ does not bubble.")) (defmethod set-on-mouse-down ((obj clog-obj) handler &key (one-time nil) (cancel-event nil)) (set-event obj "mousedown" - (when handler - (lambda (data) - (funcall handler obj (parse-mouse-event data)))) - :one-time one-time - :cancel-event cancel-event - :call-back-script mouse-event-script)) + (when handler + (lambda (data) + (funcall handler obj (parse-mouse-event data)))) + :one-time one-time + :cancel-event cancel-event + :call-back-script mouse-event-script)) ;;;;;;;;;;;;;;;;;;;;; ;; set-on-mouse-up ;; @@ -945,10 +945,10 @@ ON-MOUSE-UP-HANDLER is nil unbind the event.")) (defmethod set-on-mouse-up ((obj clog-obj) handler) (set-event obj "mouseup" - (when handler - (lambda (data) - (funcall handler obj (parse-mouse-event data)))) - :call-back-script mouse-event-script)) + (when handler + (lambda (data) + (funcall handler obj (parse-mouse-event data)))) + :call-back-script mouse-event-script)) ;;;;;;;;;;;;;;;;;;;;;;; ;; set-on-mouse-move ;; @@ -960,10 +960,10 @@ ON-MOUSE-MOVE-HANDLER is nil unbind the event.")) (defmethod set-on-mouse-move ((obj clog-obj) handler) (set-event obj "mousemove" - (when handler - (lambda (data) - (funcall handler obj (parse-mouse-event data)))) - :call-back-script mouse-event-script)) + (when handler + (lambda (data) + (funcall handler obj (parse-mouse-event data)))) + :call-back-script mouse-event-script)) ;;;;;;;;;;;;;;;;;;;;;;;;;; ;; set-on-pointer-enter ;; @@ -1014,24 +1014,24 @@ is nil unbind the event.")) ;;;;;;;;;;;;;;;;;;;;;;;;; (defgeneric set-on-pointer-down (clog-obj on-pointer-down-handler - &key capture-pointer one-time cancel-event) + &key capture-pointer one-time cancel-event) (:documentation "Set the ON-POINTER-DOWN-HANDLER for CLOG-OBJ. If ON-POINTER-DOWN-HANDLER is nil unbind the event. If cancel event is t the even does not bubble.")) (defmethod set-on-pointer-down ((obj clog-obj) handler - &key (capture-pointer nil) (one-time nil) (cancel-event nil)) + &key (capture-pointer nil) (one-time nil) (cancel-event nil)) (set-event obj "pointerdown" - (when handler - (lambda (data) - (funcall handler obj (parse-pointer-event data)))) - :post-eval (if capture-pointer - (format nil "; ~A.setPointerCapture(e.pointerId)" - (script-id obj)) - "") - :one-time one-time - :cancel-event cancel-event - :call-back-script pointer-event-script)) + (when handler + (lambda (data) + (funcall handler obj (parse-pointer-event data)))) + :post-eval (if capture-pointer + (format nil "; ~A.setPointerCapture(e.pointerId)" + (script-id obj)) + "") + :one-time one-time + :cancel-event cancel-event + :call-back-script pointer-event-script)) ;;;;;;;;;;;;;;;;;;;;;;; ;; set-on-pointer-up ;; @@ -1043,12 +1043,12 @@ ON-POINTER-UP-HANDLER is nil unbind the event.")) (defmethod set-on-pointer-up ((obj clog-obj) handler) (set-event obj "pointerup" - (when handler - (lambda (data) - (funcall handler obj (parse-pointer-event data)))) - :post-eval (format nil "; ~A.releasePointerCapture(e.pointerId)" - (script-id obj)) - :call-back-script pointer-event-script)) + (when handler + (lambda (data) + (funcall handler obj (parse-pointer-event data)))) + :post-eval (format nil "; ~A.releasePointerCapture(e.pointerId)" + (script-id obj)) + :call-back-script pointer-event-script)) ;;;;;;;;;;;;;;;;;;;;;;;;; ;; set-on-pointer-move ;; @@ -1060,10 +1060,10 @@ ON-POINTER-MOVE-HANDLER is nil unbind the event.")) (defmethod set-on-pointer-move ((obj clog-obj) handler) (set-event obj "pointermove" - (when handler - (lambda (data) - (funcall handler obj (parse-pointer-event data)))) - :call-back-script pointer-event-script)) + (when handler + (lambda (data) + (funcall handler obj (parse-pointer-event data)))) + :call-back-script pointer-event-script)) ;;;;;;;;;;;;;;;;;;;;;;;; ;; set-on-touch-start ;; @@ -1075,11 +1075,11 @@ ON-TOUCH-START-HANDLER is nil unbind the event.")) (defmethod set-on-touch-start ((obj clog-obj) handler &key (one-time nil)) (set-event obj "touchstart" - (when handler - (lambda (data) - (funcall handler obj (parse-touch-event data)))) - :one-time one-time - :call-back-script touch-event-script)) + (when handler + (lambda (data) + (funcall handler obj (parse-touch-event data)))) + :one-time one-time + :call-back-script touch-event-script)) ;;;;;;;;;;;;;;;;;;;;;;; ;; set-on-touch-move ;; @@ -1091,10 +1091,10 @@ ON-TOUCH-MOVE-HANDLER is nil unbind the event.")) (defmethod set-on-touch-move ((obj clog-obj) handler) (set-event obj "touchmove" - (when handler - (lambda (data) - (funcall handler obj (parse-touch-event data)))) - :call-back-script touch-event-script)) + (when handler + (lambda (data) + (funcall handler obj (parse-touch-event data)))) + :call-back-script touch-event-script)) ;;;;;;;;;;;;;;;;;;;;;; ;; set-on-touch-end ;; @@ -1106,10 +1106,10 @@ ON-TOUCH-END-HANDLER is nil unbind the event.")) (defmethod set-on-touch-end ((obj clog-obj) handler) (set-event obj "touchend" - (when handler - (lambda (data) - (funcall handler obj (parse-touch-event data)))) - :call-back-script touch-event-script)) + (when handler + (lambda (data) + (funcall handler obj (parse-touch-event data)))) + :call-back-script touch-event-script)) ;;;;;;;;;;;;;;;;;;;;;;;;; ;; set-on-touch-cancel ;; @@ -1121,52 +1121,52 @@ ON-TOUCH-CANCEL-HANDLER is nil unbind the event.")) (defmethod set-on-touch-cancel ((obj clog-obj) handler) (set-event obj "touchcancel" - (when handler - (lambda (data) - (funcall handler obj (parse-touch-event data)))) - :call-back-script touch-event-script)) + (when handler + (lambda (data) + (funcall handler obj (parse-touch-event data)))) + :call-back-script touch-event-script)) ;;;;;;;;;;;;;;;;;;;;;; ;; set-on-character ;; ;;;;;;;;;;;;;;;;;;;;;; (defgeneric set-on-character (clog-obj on-character-handler - &key one-time disable-default) + &key one-time disable-default) (:documentation "Set the ON-CHARACTER-HANDLER for CLOG-OBJ. If ON-CHARACTER-HANDLER is nil unbind the event. If disable-default is t default key bindings in browser will not occur. Setting this event to nil will unbind on-key-press also.")) (defmethod set-on-character ((obj clog-obj) handler - &key (one-time nil) (disable-default nil)) + &key (one-time nil) (disable-default nil)) (set-event obj "keypress" - (when handler - (lambda (data) - (let ((f (parse-keyboard-event data))) - (funcall handler obj (code-char (getf f :char-code)))))) - :one-time one-time - :cancel-event disable-default - :call-back-script keyboard-event-script)) + (when handler + (lambda (data) + (let ((f (parse-keyboard-event data))) + (funcall handler obj (code-char (getf f :char-code)))))) + :one-time one-time + :cancel-event disable-default + :call-back-script keyboard-event-script)) ;;;;;;;;;;;;;;;;;;;;; ;; set-on-key-down ;; ;;;;;;;;;;;;;;;;;;;;; (defgeneric set-on-key-down (clog-obj on-key-down-handler - &key one-time disable-default) + &key one-time disable-default) (:documentation "Set the ON-KEY-DOWN-HANDLER for CLOG-OBJ. If disable-default is t default key bindings in browser will not occur. If ON-KEY-DOWN-HANDLER is nil unbind the event.")) (defmethod set-on-key-down ((obj clog-obj) handler - &key (one-time nil) (disable-default nil)) + &key (one-time nil) (disable-default nil)) (set-event obj "keydown" - (when handler - (lambda (data) - (funcall handler obj (parse-keyboard-event data)))) - :one-time one-time - :cancel-event disable-default - :call-back-script keyboard-event-script)) + (when handler + (lambda (data) + (funcall handler obj (parse-keyboard-event data)))) + :one-time one-time + :cancel-event disable-default + :call-back-script keyboard-event-script)) ;;;;;;;;;;;;;;;;;;; ;; set-on-key-up ;; @@ -1178,30 +1178,30 @@ ON-KEY-UP-HANDLER is nil unbind the event.")) (defmethod set-on-key-up ((obj clog-obj) handler &key (one-time nil)) (set-event obj "keyup" - (when handler - (lambda (data) - (funcall handler obj (parse-keyboard-event data)))) - :one-time one-time - :call-back-script keyboard-event-script)) + (when handler + (lambda (data) + (funcall handler obj (parse-keyboard-event data)))) + :one-time one-time + :call-back-script keyboard-event-script)) ;;;;;;;;;;;;;;;;;;;;;; ;; set-on-key-press ;; ;;;;;;;;;;;;;;;;;;;;;; (defgeneric set-on-key-press (clog-obj on-key-press-handler - &key one-time disable-default) + &key one-time disable-default) (:documentation "Set the ON-KEY-PRESS-HANDLER for CLOG-OBJ. If ON-KEY-PRESS-HANDLER is nil unbind the event.")) (defmethod set-on-key-press ((obj clog-obj) handler - &key (one-time nil) (disable-default nil)) + &key (one-time nil) (disable-default nil)) (set-event obj "keypress" - (when handler - (lambda (data) - (funcall handler obj (parse-keyboard-event data)))) - :one-time one-time - :cancel-event disable-default - :call-back-script keyboard-event-script)) + (when handler + (lambda (data) + (funcall handler obj (parse-keyboard-event data)))) + :one-time one-time + :cancel-event disable-default + :call-back-script keyboard-event-script)) ;;;;;;;;;;;;;;;;; ;; set-on-copy ;; diff --git a/source/clog-body.lisp b/source/clog-body.lisp index 37bdbec..632bbfd 100644 --- a/source/clog-body.lisp +++ b/source/clog-body.lisp @@ -1,6 +1,6 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; CLOG - The Common Lisp Omnificent GUI ;;;; -;;;; (c) 2020-2021 David Botton ;;;; +;;;; (c) 2020-2022 David Botton ;;;; ;;;; License BSD 3 Clause ;;;; ;;;; ;;;; ;;;; clog-window.lisp ;;;; @@ -34,12 +34,12 @@ (defun make-clog-body (connection-id) "Construct a new clog-body object." (let ((body (make-instance - 'clog-body - :connection-id connection-id :html-id 0 - :window (make-clog-window connection-id) - :html-document (make-clog-document connection-id) - :location (make-clog-location connection-id) - :navigator (make-clog-navigator connection-id)))) + 'clog-body + :connection-id connection-id :html-id 0 + :window (make-clog-window connection-id) + :html-document (make-clog-document connection-id) + :location (make-clog-location connection-id) + :navigator (make-clog-navigator connection-id)))) (set-body (html-document body) body))) ;;;;;;;;; @@ -52,8 +52,8 @@ user close of connection / browser.")) (defmethod run ((obj clog-body)) (loop (if (validp obj) - (sleep 10) - (return)))) + (sleep 10) + (return)))) ;;;;;;;;;;;;;;;;;;;;;;; ;; set-html-on-close ;; @@ -93,4 +93,3 @@ with HTML.")) (defgeneric navigator (clog-body) (:documentation "Reader for CLOG-Navigator object")) - diff --git a/source/clog-canvas.lisp b/source/clog-canvas.lisp index 8cbee3b..dc6daa5 100644 --- a/source/clog-canvas.lisp +++ b/source/clog-canvas.lisp @@ -20,26 +20,26 @@ ;;;;;;;;;;;;;;;;;;; (defgeneric create-canvas (clog-obj &key width height - class hidden html-id auto-place) + class hidden html-id auto-place) (:documentation "Create a new CLOG-Canvas as child of CLOG-OBJ if :AUTO-PLACE (default t) place-inside-bottom-of CLOG-OBJ.")) (defmethod create-canvas ((obj clog-obj) - &key (width 300) (height 150) - (class nil) (hidden nil) - (html-id nil) (auto-place t)) + &key (width 300) (height 150) + (class nil) (hidden nil) + (html-id nil) (auto-place t)) (create-child obj (format nil "" - (if class - (format nil " class='~A'" - (escape-string class)) - "") - (if hidden - " style='visibility:hidden;'" - "") - width height) - :clog-type 'clog-canvas - :html-id html-id - :auto-place auto-place)) + (if class + (format nil " class='~A'" + (escape-string class)) + "") + (if hidden + " style='visibility:hidden;'" + "") + width height) + :clog-type 'clog-canvas + :html-id html-id + :auto-place auto-place)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Implementation - clog-context2d @@ -58,13 +58,13 @@ (defmethod create-context2d ((obj clog-canvas)) (let ((web-id (clog-connection:generate-id))) (clog-connection:execute (connection-id obj) - (format nil "clog['~A']=clog['~A'].getContext('2d')" - web-id - (html-id obj))) + (format nil "clog['~A']=clog['~A'].getContext('2d')" + web-id + (html-id obj))) (make-instance 'clog-context2d - :connection-id (connection-id obj) - :html-id web-id))) + :connection-id (connection-id obj) + :html-id web-id))) ;;;;;;;;;;;;;;;; ;; clear-rect ;; @@ -75,7 +75,7 @@ (defmethod clear-rect ((obj clog-context2d) x y width height) (execute obj (format nil "clearRect(~A,~A,~A,~A)" - x y width height))) + x y width height))) ;;;;;;;;;;;;;;; ;; fill-rect ;; @@ -86,7 +86,7 @@ (defmethod fill-rect ((obj clog-context2d) x y width height) (execute obj (format nil "fillRect(~A,~A,~A,~A)" - x y width height))) + x y width height))) ;;;;;;;;;;;;;;;;; ;; stroke-rect ;; @@ -97,7 +97,7 @@ (defmethod stroke-rect ((obj clog-context2d) x y width height) (execute obj (format nil "strokeRect(~A,~A,~A,~A)" - x y width height))) + x y width height))) ;;;;;;;;;;;;;;; ;; fill-text ;; @@ -108,11 +108,11 @@ (defmethod fill-text ((obj clog-context2d) text x y &key (max-width nil)) (execute obj (format nil "fillText('~A',~A,~A~A)" - (escape-string text) - x y - (if max-width - (format nil ",~A" max-width) - "")))) + (escape-string text) + x y + (if max-width + (format nil ",~A" max-width) + "")))) ;;;;;;;;;;;;;;;;; ;; stroke-text ;; ;;;;;;;;;;;;;;;;; @@ -122,11 +122,11 @@ (defmethod stroke-text ((obj clog-context2d) text x y &key (max-width nil)) (execute obj (format nil "strokeText('~A',~A,~A~A)" - (escape-string text) - x y - (if max-width - (format nil ",~A" max-width) - "")))) + (escape-string text) + x y + (if max-width + (format nil ",~A" max-width) + "")))) ;;;;;;;;;;;;;;;;;; ;; measure-text ;; ;;;;;;;;;;;;;;;;;; @@ -373,7 +373,7 @@ (defmethod bezier-curve-to ((obj clog-context2d) cp1x cp1y cp2x cp2y x y) (execute obj (format nil "bezierCurveTo(~A,~A,~A,~A,~A,~A)" - cp1x cp1y cp2x cp2y x y))) + cp1x cp1y cp2x cp2y x y))) ;;;;;;;;;;;;;;;;;;;;;;;; ;; quadratic-curve-to ;; @@ -390,16 +390,16 @@ ;;;;;;;;; (Defgeneric arc (clog-context2d x y radius start-angle end-angle - &key anticlockwise) + &key anticlockwise) (:documentation "Adds a circular arc to the current path.")) (defmethod arc ((obj clog-context2d) x y radius start-angle end-angle - &key (anticlockwise nil)) + &key (anticlockwise nil)) (execute obj (format nil "arc(~A,~A,~A,~A,~A~A)" - x y radius start-angle end-angle - (if anticlockwise - (format nil ",~A" anticlockwise) - "")))) + x y radius start-angle end-angle + (if anticlockwise + (format nil ",~A" anticlockwise) + "")))) ;;;;;;;;;;;; ;; arc-to ;; @@ -416,18 +416,18 @@ ;;;;;;;;;;;;; (defgeneric ellipse (clog-context2d x y radius-x radius-y rotation - start-angle end-angle - &key anticlockwise) + start-angle end-angle + &key anticlockwise) (:documentation "Adds an elliptical arc to the current path.")) (defmethod ellipse ((obj clog-context2d) x y radius-x radius-y rotation - start-angle end-angle - &key (anticlockwise nil)) + start-angle end-angle + &key (anticlockwise nil)) (execute obj (format nil "ellipse(~A,~A,~A,~A,~A,~A,~A~A)" - x y radius-x radius-y rotation start-angle end-angle - (if anticlockwise - (format nil ",~A" anticlockwise) - "")))) + x y radius-x radius-y rotation start-angle end-angle + (if anticlockwise + (format nil ",~A" anticlockwise) + "")))) ;;;;;;;;;; ;; rect ;; diff --git a/source/clog-connection.lisp b/source/clog-connection.lisp index 5df1c0e..c0bab58 100644 --- a/source/clog-connection.lisp +++ b/source/clog-connection.lisp @@ -1,6 +1,6 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; CLOG - The Common Lisp Omnificent GUI ;;;; -;;;; (c) 2020-2021 David Botton ;;;; +;;;; (c) 2020-2022 David Botton ;;;; ;;;; License BSD 3 Clause ;;;; ;;;; ;;;; ;;;; clog-connection.lisp ;;;; @@ -156,11 +156,11 @@ with DEFAULT-ANSWER in case of a time out. (Private)" the default answer. (Private)" (handler-case (progn - (bordeaux-threads:wait-on-semaphore (gethash id *queries-sems*) :timeout timeout) - (let ((answer (gethash id *queries*))) - (remhash id *queries*) - (remhash id *queries-sems*) - answer)) + (bordeaux-threads:wait-on-semaphore (gethash id *queries-sems*) :timeout timeout) + (let ((answer (gethash id *queries*))) + (remhash id *queries*) + (remhash id *queries-sems*) + answer)) (t (c) (format t "Condition caught in wait-for-answer - ~A.~&" c) (values 0 c)))) @@ -173,27 +173,27 @@ the default answer. (Private)" "Handle new incoming websocket CONNECTIONS with ID from boot page. (Private)" (handler-case (cond (id - (format t "Reconnection id - ~A to ~A~%" id connection) - (setf (gethash id *connection-ids*) connection) - (setf (gethash connection *connections*) id)) - (t - (setf id (generate-id)) - (setf (gethash connection *connections*) id) - (setf (gethash id *connection-ids*) connection) - (setf (gethash id *connection-data*) (make-hash-table* :test #'equal)) - (setf (gethash "connection-id" (get-connection-data id)) id) - (format t "New connection id - ~A - ~A~%" id connection) - (websocket-driver:send connection - (format nil "clog['connection_id']=~A" id)) - (bordeaux-threads:make-thread - (lambda () - (if *break-on-error* - (funcall *on-connect-handler* id) - (handler-case - (funcall *on-connect-handler* id) - (t (c) - (format t "Condition caught connection ~A - ~A.~&" id c) - (values 0 c))))) + (format t "Reconnection id - ~A to ~A~%" id connection) + (setf (gethash id *connection-ids*) connection) + (setf (gethash connection *connections*) id)) + (t + (setf id (generate-id)) + (setf (gethash connection *connections*) id) + (setf (gethash id *connection-ids*) connection) + (setf (gethash id *connection-data*) (make-hash-table* :test #'equal)) + (setf (gethash "connection-id" (get-connection-data id)) id) + (format t "New connection id - ~A - ~A~%" id connection) + (websocket-driver:send connection + (format nil "clog['connection_id']=~A" id)) + (bordeaux-threads:make-thread + (lambda () + (if *break-on-error* + (funcall *on-connect-handler* id) + (handler-case + (funcall *on-connect-handler* id) + (t (c) + (format t "Condition caught connection ~A - ~A.~&" id c) + (values 0 c))))) :name (format nil "CLOG connection ~A" id)))) (t (c) @@ -208,42 +208,42 @@ the default answer. (Private)" "Handle incoming websocket MESSAGE on CONNECTION. (Private)" (handler-case (let ((id (gethash connection *connections*)) - (ml (ppcre:split ":" message :limit 2))) - (cond ((equal (first ml) "0") - (when *verbose-output* - (format t "~A Ping~%" id))) - ((equal (first ml) "E") - (let* ((em (ppcre:split " " (second ml) :limit 2)) + (ml (ppcre:split ":" message :limit 2))) + (cond ((equal (first ml) "0") + (when *verbose-output* + (format t "~A Ping~%" id))) + ((equal (first ml) "E") + (let* ((em (ppcre:split " " (second ml) :limit 2)) (event-id (first em)) (data (second em))) - (when *verbose-output* - (format t "Channel ~A Hook ~A Data ~A~%" - id event-id data)) - (bordeaux-threads:make-thread - (lambda () - (if *break-on-error* - (let* ((event-hash (get-connection-data id)) - (event (when event-hash - (gethash event-id event-hash)))) - (when event - (funcall event data))) - (handler-case - (let* ((event-hash (get-connection-data id)) - (event (when event-hash - (gethash event-id event-hash)))) - (when event - (funcall event data))) - (t (c) - (format t "Condition caught in handle-message for event - ~A.~&" c) - (values 0 c))))) - :name (format nil "CLOG event handler ~A" - event-id)))) - (t - (when *verbose-output* - (format t "~A ~A = ~A~%" id (first ml) (second ml))) - (setf (gethash (parse-integer (first ml)) *queries*) (second ml)) - (bordeaux-threads:signal-semaphore - (gethash (parse-integer (first ml)) *queries-sems*))))) + (when *verbose-output* + (format t "Channel ~A Hook ~A Data ~A~%" + id event-id data)) + (bordeaux-threads:make-thread + (lambda () + (if *break-on-error* + (let* ((event-hash (get-connection-data id)) + (event (when event-hash + (gethash event-id event-hash)))) + (when event + (funcall event data))) + (handler-case + (let* ((event-hash (get-connection-data id)) + (event (when event-hash + (gethash event-id event-hash)))) + (when event + (funcall event data))) + (t (c) + (format t "Condition caught in handle-message for event - ~A.~&" c) + (values 0 c))))) + :name (format nil "CLOG event handler ~A" + event-id)))) + (t + (when *verbose-output* + (format t "~A ~A = ~A~%" id (first ml) (second ml))) + (setf (gethash (parse-integer (first ml)) *queries*) (second ml)) + (bordeaux-threads:signal-semaphore + (gethash (parse-integer (first ml)) *queries-sems*))))) (t (c) (format t "Condition caught in handle-message - ~A.~&" c) (values 0 c)))) @@ -256,12 +256,12 @@ the default answer. (Private)" "Close websocket CONNECTION. (Private)" (handler-case (let ((id (gethash connection *connections*))) - (when id - (when *verbose-output* - (format t "Connection id ~A has closed. ~A~%" id connection)) - (remhash id *connection-data*) - (remhash id *connection-ids*) - (remhash connection *connections*))) + (when id + (when *verbose-output* + (format t "Connection id ~A has closed. ~A~%" id connection)) + (remhash id *connection-data*) + (remhash id *connection-ids*) + (remhash connection *connections*))) (t (c) (format t "Condition caught in handle-message - ~A.~&" c) (values 0 c)))) @@ -274,40 +274,40 @@ the default answer. (Private)" "Setup websocket server on ENV. (Private)" (handler-case (let ((ws (websocket-driver:make-server env))) - (websocket-driver:on :open ws + (websocket-driver:on :open ws (lambda () - (handler-case - (let* ((query (getf env :query-string)) - (items (when query - (quri:url-decode-params query))) - (id (when items - (cdr (assoc "r" items - :test #'equalp))))) - (when (typep id 'string) - (setf id (parse-integer id :junk-allowed t))) - (handle-new-connection ws id)) - (t (c) - (print env) - (format t "Condition caught in clog-server :open - ~A.~&" c) - (values 0 c))))) - (websocket-driver:on :message ws + (handler-case + (let* ((query (getf env :query-string)) + (items (when query + (quri:url-decode-params query))) + (id (when items + (cdr (assoc "r" items + :test #'equalp))))) + (when (typep id 'string) + (setf id (parse-integer id :junk-allowed t))) + (handle-new-connection ws id)) + (t (c) + (print env) + (format t "Condition caught in clog-server :open - ~A.~&" c) + (values 0 c))))) + (websocket-driver:on :message ws (lambda (msg) - (handler-case - (handle-message ws msg) - (t (c) - (format t "Condition caught in clog-server :message - ~A.~&" c) - (values 0 c))))) - (websocket-driver:on :close ws + (handler-case + (handle-message ws msg) + (t (c) + (format t "Condition caught in clog-server :message - ~A.~&" c) + (values 0 c))))) + (websocket-driver:on :close ws (lambda (&key code reason) (declare (ignore code reason)) - (handler-case - (handle-close-connection ws) - (t (c) - (format t "Condition caught in clog-server :message - ~A.~&" c) - (values 0 c))))) - (lambda (responder) - (declare (ignore responder)) - (websocket-driver:start-connection ws))) + (handler-case + (handle-close-connection ws) + (t (c) + (format t "Condition caught in clog-server :message - ~A.~&" c) + (values 0 c))))) + (lambda (responder) + (declare (ignore responder)) + (websocket-driver:start-connection ws))) (t (c) (format t "Condition caught in clog-server start-up - ~A.~&" c) (values 0 c)))) @@ -317,17 +317,17 @@ the default answer. (Private)" ;;;;;;;;;;;;;;;; (defun initialize (on-connect-handler - &key - (host "0.0.0.0") - (port 8080) - (server :hunchentoot) - (extended-routing nil) - (long-poll-first nil) - (boot-file "/boot.html") - (boot-function nil) - (static-boot-html nil) - (static-boot-js nil) - (static-root #P"./static-files/")) + &key + (host "0.0.0.0") + (port 8080) + (server :hunchentoot) + (extended-routing nil) + (long-poll-first nil) + (boot-file "/boot.html") + (boot-function nil) + (static-boot-html nil) + (static-boot-js nil) + (static-root #P"./static-files/")) "Initialize CLOG on a socket using HOST and PORT to serve BOOT-FILE as the default route for '/' to establish web-socket connections and static files located at STATIC-ROOT. The webserver used with CLACK can @@ -348,126 +348,126 @@ brower." (when boot-file (set-clog-path "/" boot-file)) (setf *app* - (lack:builder - (lambda (app) - (lambda (env) - ;; if not static-boot-js use internal compiled boot.js - (if (and (eq static-boot-js nil) - (equalp (getf env :path-info) "/js/boot.js")) - `(200 (:content-type "text/javascript") - (,(compiled-boot-js))) - (funcall app env)))) - (lambda (app) - (lambda (env) - ;; Special handling of "clog paths" - (let* ((url-path (getf env :path-info)) - (clog-path (gethash url-path *url-to-boot-file*))) - (unless clog-path - (when extended-routing - (maphash (lambda (k v) - (unless (equal k "/") - (when (ppcre:scan (format nil "^~A/" k) - url-path) - (setf clog-path v)))) - *url-to-boot-file*))) - (cond (clog-path - (let ((file (uiop:subpathname static-root clog-path))) - (with-open-file (stream file :direction :input - :if-does-not-exist nil) - (let ((page-data (if stream - (make-string (file-length stream)) - (if static-boot-html - "" - (compiled-boot-html nil nil)))) - (post-data nil)) - (when stream - (read-sequence page-data stream)) - (when boot-function - (setf page-data (funcall boot-function - url-path - page-data))) - (when (search "multipart/form-data;" - (getf env :content-type)) - (let ((id (get-universal-time)) - (req (lack.request:make-request env))) - (setf (gethash id *connection-data*) - (lack.request:request-body-parameters req)) - (setf post-data id))) - (when (equal (getf env :content-type) - "application/x-www-form-urlencoded") - (setf post-data (make-string (getf env :content-length))) - (read-sequence post-data (getf env :raw-body))) - (cond (long-poll-first - (let ((id (generate-id))) - (setf (gethash id *connection-data*) (make-hash-table* :test #'equal)) - (setf (gethash "connection-id" (get-connection-data id)) id) - (format t "New html connection id - ~A~%" id) - (lambda (responder) - (let* ((writer (funcall responder '(200 (:content-type "text/html")))) - (stream (lack.util.writer-stream:make-writer-stream writer)) - (*long-poll-url* url-path) - (*long-poll-first* stream)) - (write-sequence page-data stream) - (write-sequence - (format nil "" id) - stream) - (when post-data - (write-sequence - (format nil "" - post-data) - stream)) - (if *break-on-error* - (funcall *on-connect-handler* id) - (handler-case - (funcall *on-connect-handler* id) - (t (c) - (format t "Condition caught connection ~A - ~A.~&" id c) - (values 0 c)))) - (when *long-poll-first* - (setf *long-poll-first* nil) - (handler-case - (finish-output stream) - (t (c) - (format t "Condition caught finish-output ~A - ~A.~&" id c) - (values 0 c)))) - (format t "HTML connection closed - ~A~%" id))))) - (t - (lambda (responder) - (let* ((writer (funcall responder '(200 (:content-type "text/html")))) - (stream (lack.util.writer-stream:make-writer-stream writer))) - (write-sequence page-data stream) - (when post-data - (write-sequence - (format nil "" - post-data) - stream)) - (finish-output stream))))))))) - ;; Pass the handling on to next rule - (t (funcall app env)))))) - (:static :path (lambda (path) - ;; Request is static path if not the websocket connection. - ;; Websocket url is /clog - (cond ((ppcre:scan "^(?:/clog$)" path) nil) - (t path))) - :root static-root) - ;; Handle Websocket connection - (lambda (env) - (clog-server env)))) + (lack:builder + (lambda (app) + (lambda (env) + ;; if not static-boot-js use internal compiled boot.js + (if (and (eq static-boot-js nil) + (equalp (getf env :path-info) "/js/boot.js")) + `(200 (:content-type "text/javascript") + (,(compiled-boot-js))) + (funcall app env)))) + (lambda (app) + (lambda (env) + ;; Special handling of "clog paths" + (let* ((url-path (getf env :path-info)) + (clog-path (gethash url-path *url-to-boot-file*))) + (unless clog-path + (when extended-routing + (maphash (lambda (k v) + (unless (equal k "/") + (when (ppcre:scan (format nil "^~A/" k) + url-path) + (setf clog-path v)))) + *url-to-boot-file*))) + (cond (clog-path + (let ((file (uiop:subpathname static-root clog-path))) + (with-open-file (stream file :direction :input + :if-does-not-exist nil) + (let ((page-data (if stream + (make-string (file-length stream)) + (if static-boot-html + "" + (compiled-boot-html nil nil)))) + (post-data nil)) + (when stream + (read-sequence page-data stream)) + (when boot-function + (setf page-data (funcall boot-function + url-path + page-data))) + (when (search "multipart/form-data;" + (getf env :content-type)) + (let ((id (get-universal-time)) + (req (lack.request:make-request env))) + (setf (gethash id *connection-data*) + (lack.request:request-body-parameters req)) + (setf post-data id))) + (when (equal (getf env :content-type) + "application/x-www-form-urlencoded") + (setf post-data (make-string (getf env :content-length))) + (read-sequence post-data (getf env :raw-body))) + (cond (long-poll-first + (let ((id (generate-id))) + (setf (gethash id *connection-data*) (make-hash-table* :test #'equal)) + (setf (gethash "connection-id" (get-connection-data id)) id) + (format t "New html connection id - ~A~%" id) + (lambda (responder) + (let* ((writer (funcall responder '(200 (:content-type "text/html")))) + (stream (lack.util.writer-stream:make-writer-stream writer)) + (*long-poll-url* url-path) + (*long-poll-first* stream)) + (write-sequence page-data stream) + (write-sequence + (format nil "" id) + stream) + (when post-data + (write-sequence + (format nil "" + post-data) + stream)) + (if *break-on-error* + (funcall *on-connect-handler* id) + (handler-case + (funcall *on-connect-handler* id) + (t (c) + (format t "Condition caught connection ~A - ~A.~&" id c) + (values 0 c)))) + (when *long-poll-first* + (setf *long-poll-first* nil) + (handler-case + (finish-output stream) + (t (c) + (format t "Condition caught finish-output ~A - ~A.~&" id c) + (values 0 c)))) + (format t "HTML connection closed - ~A~%" id))))) + (t + (lambda (responder) + (let* ((writer (funcall responder '(200 (:content-type "text/html")))) + (stream (lack.util.writer-stream:make-writer-stream writer))) + (write-sequence page-data stream) + (when post-data + (write-sequence + (format nil "" + post-data) + stream)) + (finish-output stream))))))))) + ;; Pass the handling on to next rule + (t (funcall app env)))))) + (:static :path (lambda (path) + ;; Request is static path if not the websocket connection. + ;; Websocket url is /clog + (cond ((ppcre:scan "^(?:/clog$)" path) nil) + (t path))) + :root static-root) + ;; Handle Websocket connection + (lambda (env) + (clog-server env)))) (setf *client-handler* (clack:clackup *app* :server server :address host :port port)) (format t "HTTP listening on : ~A:~A~%" host port) (format t "HTML root : ~A~%" static-root) (format t "Long poll first : ~A~%" (if long-poll-first - "yes" - "no")) + "yes" + "no")) (format t "Boot function added : ~A~%" (if boot-function - "yes" - "no")) + "yes" + "no")) (format t "Boot html source use : ~A~%" (if static-boot-html - "static file" - "compiled version, when no file")) + "static file" + "compiled version, when no file")) (format t "Boot js source use : ~A~%" (if static-boot-js - "static file" - "compiled version")) + "static file" + "compiled version")) (format t "Boot file for path / : ~A~%" boot-file) *client-handler*) @@ -501,11 +501,11 @@ brower." "Associate URL path to BOOT-FILE" (if boot-file (setf (gethash path *url-to-boot-file*) - ;; Make clog-path into a relative path of - ;; of site-root. - (if (eql (char boot-file 0) #\/) - (concatenate 'string "." boot-file) - boot-file)) + ;; Make clog-path into a relative path of + ;; of site-root. + (if (eql (char boot-file 0) #\/) + (concatenate 'string "." boot-file) + boot-file)) (remhash path *url-to-boot-file*))) ;;;;;;;;;;;;;;;;;;; @@ -529,10 +529,10 @@ brower." "Execute SCRIPT on CONNECTION-ID, disregard return value." (if *long-poll-first* (write-sequence (format nil "~%" message) - *long-poll-first*) + *long-poll-first*) (let ((con (get-connection connection-id))) - (when con - (websocket-driver:send con message))))) + (when con + (websocket-driver:send con message))))) ;;;;;;;;;;; ;; query ;; @@ -547,16 +547,16 @@ DEFAULT-ANSWER." (finish-output *long-poll-first*) (loop for n from 1 to 10 do - (let ((con (get-connection connection-id))) - (when con - (return)) - (sleep .1)))) + (let ((con (get-connection connection-id))) + (when con + (return)) + (sleep .1)))) (let ((uid (generate-id))) (prep-query uid (when default-answer (format nil "~A" default-answer))) (execute connection-id - (format nil "ws.send (\"~A:\"+eval(\"~A\"));" - uid - (escape-string script))) + (format nil "ws.send (\"~A:\"+eval(\"~A\"));" + uid + (escape-string script))) (wait-for-answer uid))) ;;;;;;;;;;;; @@ -594,7 +594,7 @@ reistablish connectivity." (defun put (connection-id text) "Write TEXT to document object of CONNECTION-ID with out new line." (execute connection-id - (format nil "document.write('~A');" (escape-string text)))) + (format nil "document.write('~A');" (escape-string text)))) ;;;;;;;;;;;;;; ;; put-line ;; @@ -604,7 +604,7 @@ reistablish connectivity." "Write TEXT to document object of CONNECTION-ID with new line and HTML
." (execute connection-id - (format nil "document.writeln('~A
');" (escape-string text)))) + (format nil "document.writeln('~A
');" (escape-string text)))) ;;;;;;;;;;;;;; ;; new-line ;; @@ -638,7 +638,7 @@ HTML
." "Set the client side variable clog['html_on_close'] to replace the browser contents in case of connection loss." (execute connection-id (format nil "clog['html_on_close']='~A'" - (escape-string html)))) + (escape-string html)))) ;;;;;;;;;;;;;;;;;;;;;;;; ;; compiled-boot-html ;; @@ -700,10 +700,10 @@ function Ping_ws() { function Shutdown_ws(event) { if (ws != null) { - ws.onerror = null; - ws.onclose = null; - ws.close (); - ws = null; + ws.onerror = null; + ws.onclose = null; + ws.close (); + ws = null; } clearInterval (pingerid); if (clog['html_on_close'] != '') { @@ -715,7 +715,7 @@ function Setup_ws() { ws.onmessage = function (event) { try { if (clog_debug == true) { - console.log ('eval data = ' + event.data); + console.log ('eval data = ' + event.data); } eval (event.data); } catch (e) { @@ -754,9 +754,9 @@ function Setup_ws() { function Open_ws() { if (location.protocol == 'https:') { - adr = 'wss://' + location.hostname; + adr = 'wss://' + location.hostname; } else { - adr = 'ws://' + location.hostname; + adr = 'ws://' + location.hostname; } if (location.port != '') { adr = adr + ':' + location.port; } @@ -767,21 +767,21 @@ function Open_ws() { } else { adrc = adr } try { - console.log ('connecting to ' + adrc); - ws = new WebSocket (adrc); + console.log ('connecting to ' + adrc); + ws = new WebSocket (adrc); } catch (e) { - console.log ('trying again, connecting to ' + adrc); - ws = new WebSocket (adrc); + console.log ('trying again, connecting to ' + adrc); + ws = new WebSocket (adrc); } if (ws != null) { - ws.onopen = function (event) { + ws.onopen = function (event) { console.log ('connection successful'); Setup_ws(); - } - pingerid = setInterval (function () {Ping_ws ();}, 10000); + } + pingerid = setInterval (function () {Ping_ws ();}, 10000); } else { - document.writeln ('If you are seeing this your browser or your connection to the internet is blocking websockets.'); + document.writeln ('If you are seeing this your browser or your connection to the internet is blocking websockets.'); } } diff --git a/source/clog-data.lisp b/source/clog-data.lisp index 4508b89..869495a 100644 --- a/source/clog-data.lisp +++ b/source/clog-data.lisp @@ -27,24 +27,24 @@ upper cased before attempting to match it to a slot if :UPCASE-KEY t (default). If :ROW-ID-NAME is set returns that fields value." (let ((result)) (loop for (key value) on plist by #'cddr while value - do - (when (consp key) - (setf key (second key))) - (let* ((slot-str (format nil "~A" key)) - (slot-name (if upcase-key - (string-upcase slot-str) - slot-str)) - (slot-sym (find slot-name (closer-mop:compute-slots (class-of obj)) - :key #'closer-mop:slot-definition-name - :test #'string=))) - (when (equalp row-id-name slot-name) - (setf result value)) - (when slot-sym - (setf slot-sym (closer-mop:slot-definition-name slot-sym)) - (if (and (slot-boundp obj slot-sym) - (typep (slot-value obj slot-sym) 'clog:clog-element)) - (setf (text-value (slot-value obj slot-sym)) value) - (setf (slot-value obj slot-sym) value))))) + do + (when (consp key) + (setf key (second key))) + (let* ((slot-str (format nil "~A" key)) + (slot-name (if upcase-key + (string-upcase slot-str) + slot-str)) + (slot-sym (find slot-name (closer-mop:compute-slots (class-of obj)) + :key #'closer-mop:slot-definition-name + :test #'string=))) + (when (equalp row-id-name slot-name) + (setf result value)) + (when slot-sym + (setf slot-sym (closer-mop:slot-definition-name slot-sym)) + (if (and (slot-boundp obj slot-sym) + (typep (slot-value obj slot-sym) 'clog:clog-element)) + (setf (text-value (slot-value obj slot-sym)) value) + (setf (slot-value obj slot-sym) value))))) result)) ;;;;;;;;;;;;;;;;;;;;;; @@ -60,20 +60,20 @@ must be bound." (let ((result)) (dolist (slot (reverse slot-name-list)) (when (consp slot) - (setf slot (second slot))) + (setf slot (second slot))) (when (keywordp slot) - (setf slot (format nil "~A" slot))) + (setf slot (format nil "~A" slot))) (unless (symbolp slot) - (when upcase-key - (setf slot (string-upcase slot)))) + (when upcase-key + (setf slot (string-upcase slot)))) (setf slot (closer-mop:slot-definition-name - (find slot (closer-mop:compute-slots (class-of obj)) - :key #'closer-mop:slot-definition-name - :test #'string=))) + (find slot (closer-mop:compute-slots (class-of obj)) + :key #'closer-mop:slot-definition-name + :test #'string=))) (if (and (slot-boundp obj slot) - (typep (slot-value obj slot) 'clog:clog-element)) - (push (text-value (slot-value obj slot)) result) - (push (slot-value obj slot) result))) + (typep (slot-value obj slot) 'clog:clog-element)) + (push (text-value (slot-value obj slot)) result) + (push (slot-value obj slot) result))) result)) ;;;;;;;;;;;;;;;;;;;;;;; @@ -81,7 +81,7 @@ must be bound." ;;;;;;;;;;;;;;;;;;;;;;; (defun data-write-plist (obj slot-name-list &key (upcase-key t) - (keys-as-keywords t)) + (keys-as-keywords t)) "Returns a plist, one member for each slot name in SLOT-NAME-LIST, the key is the slot name. If a slot contains a CLOG-ELEMENT then TEXT-VALUE is used to retrieve the value otherwise it is the @@ -93,31 +93,31 @@ slot-name does not exist it is left out of returned plist. If :KEYS-AS-KEYWORDS t (default) then the keys will be symbols in the keyword package." (let (result - pname) + pname) (dolist (slot (reverse slot-name-list)) (cond ((consp slot) - (setf pname (first slot)) - (setf slot (second slot))) - (t - (setf pname slot))) + (setf pname (first slot)) + (setf slot (second slot))) + (t + (setf pname slot))) (when (keywordp slot) - (setf slot (format nil "~A" slot))) + (setf slot (format nil "~A" slot))) (unless (symbolp slot) - (when upcase-key - (setf pname (string-upcase pname)) - (setf slot (string-upcase slot)))) + (when upcase-key + (setf pname (string-upcase pname)) + (setf slot (string-upcase slot)))) (setf slot (find slot (closer-mop:compute-slots (class-of obj)) - :key #'closer-mop:slot-definition-name - :test #'string=)) + :key #'closer-mop:slot-definition-name + :test #'string=)) (when slot - (setf slot (closer-mop:slot-definition-name slot)) - (if (and (slot-boundp obj slot) - (typep (slot-value obj slot) 'clog:clog-element)) - (push (text-value (slot-value obj slot)) result) - (push (slot-value obj slot) result)) - (if keys-as-keywords - (push (intern (format nil "~A" pname) 'keyword) result) - (push pname result)))) + (setf slot (closer-mop:slot-definition-name slot)) + (if (and (slot-boundp obj slot) + (typep (slot-value obj slot) 'clog:clog-element)) + (push (text-value (slot-value obj slot)) result) + (push (slot-value obj slot) result)) + (if keys-as-keywords + (push (intern (format nil "~A" pname) 'keyword) result) + (push pname result)))) result)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -143,20 +143,20 @@ stringified first. If :QUOTE-ALL t then all fields are in quotes." (let ((result)) (dolist (field (reverse field-list)) (if (and for-insert - (consp field)) - (setf field (car field))) + (consp field)) + (setf field (car field))) (if (consp field) - (setf field (format nil "~A as '~A'~A" - (if quote-all - (format nil "'~A'" (first field)) - (format nil "~A" (first field))) - (second field) - (if result ", " ""))) - (setf field (format nil "~A~A" - (if quote-all - (format nil "'~A'" field) - (format nil "~A" field)) - (if result ", " "")))) + (setf field (format nil "~A as '~A'~A" + (if quote-all + (format nil "'~A'" (first field)) + (format nil "~A" (first field))) + (second field) + (if result ", " ""))) + (setf field (format nil "~A~A" + (if quote-all + (format nil "'~A'" field) + (format nil "~A" field)) + (if result ", " "")))) (push field result)) (format nil "~{~A~}" result))) @@ -169,13 +169,13 @@ stringified first. If :QUOTE-ALL t then all fields are in quotes." unless is the single character '?'. If value is a list the car is returned unquoted" (cond ((and (stringp value) - (not (equal value "?"))) - (format nil "'~A'" - (ppcre:regex-replace-all "'" value "''"))) - ((consp value) - (car value)) - (t - value))) + (not (equal value "?"))) + (format nil "'~A'" + (ppcre:regex-replace-all "'" value "''"))) + ((consp value) + (car value)) + (t + value))) ;;;;;;;;;;;;;;;;;;;; ;; sql-value-list ;; @@ -187,8 +187,8 @@ use in a SQL insert value list." (let ((result)) (dolist (value (reverse value-list)) (setf value (format nil "~A~A" - (sql-quote value) - (if result ", " ""))) + (sql-quote value) + (if result ", " ""))) (push value result)) (format nil "~{~A~}" result))) @@ -202,14 +202,14 @@ returns a string for use in a SQL update. if the 'key' is a cons the first 'key' used." (let ((result)) (loop for (key value) on plist by #'cddr while value - do - (push (format nil "~A = ~A~A" - (if (consp key) - (car key) - key) - (sql-quote value) - (if result ", " "")) - result)) + do + (push (format nil "~A = ~A~A" + (if (consp key) + (car key) + key) + (sql-quote value) + (if result ", " "")) + result)) (format nil "~{~A~}" result))) ;;;;;;;;;;;;;;;; @@ -219,21 +219,21 @@ first 'key' used." (defun sql-select (table field-list &key where order-by limit) "Build basic sql select statement" (format nil "select ~A from ~A~A~A~A" - (if (consp field-list) - (sql-field-list field-list) - field-list) - (if (consp table) - (sql-field-list table) - table) - (if (and where (not (equal where ""))) - (format nil " where ~A" where) - "") - (if (and order-by (not (equal order-by ""))) - (format nil " order by ~A" order-by) - "") - (if (and limit (not (equal limit ""))) - (format nil " limit ~A" limit) - ""))) + (if (consp field-list) + (sql-field-list field-list) + field-list) + (if (consp table) + (sql-field-list table) + table) + (if (and where (not (equal where ""))) + (format nil " where ~A" where) + "") + (if (and order-by (not (equal order-by ""))) + (format nil " order by ~A" order-by) + "") + (if (and limit (not (equal limit ""))) + (format nil " limit ~A" limit) + ""))) ;;;;;;;;;;;;;;;; ;; sql-insert ;; @@ -242,9 +242,9 @@ first 'key' used." (defun sql-insert (table field-list value-list) "Build basic sql insert statement" (format nil "insert into ~A (~A) values (~A)" - table - (sql-field-list field-list :for-insert t) - (sql-value-list value-list))) + table + (sql-field-list field-list :for-insert t) + (sql-value-list value-list))) ;;;;;;;;;;;;;;;;; ;; sql-insert* ;; @@ -253,9 +253,9 @@ first 'key' used." (defun sql-insert* (table plist) "Build basic sql insert statement using a plist" (loop for (key value) on plist by #'cddr while value - collect key into fields - collect value into values - finally (return (sql-insert table fields values)))) + collect key into fields + collect value into values + finally (return (sql-insert table fields values)))) ;;;;;;;;;;;;;;;; ;; sql-update ;; @@ -264,6 +264,6 @@ first 'key' used." (defun sql-update (table plist where) "Build basic sql update statement" (format nil "update ~A set ~A where ~A" - table - (sql-update-list plist) - where)) + table + (sql-update-list plist) + where)) diff --git a/source/clog-dbi.lisp b/source/clog-dbi.lisp index 94df528..c134d24 100644 --- a/source/clog-dbi.lisp +++ b/source/clog-dbi.lisp @@ -28,22 +28,22 @@ ;;;;;;;;;;;;;;;;;;;;; (defgeneric create-database (clog-obj - &key hidden class html-id auto-place) + &key hidden class html-id auto-place) (:documentation "Create a new CLOG-Database element, for use in CLOG-Builder. If not using builder use to connect: (dbi:connect (database-connection clog-obj) ...) or if a connection exists assign it to the database-connecton.")) (defmethod create-database ((obj clog-obj) - &key (hidden nil) - (class nil) - (html-id nil) (auto-place t)) + &key (hidden nil) + (class nil) + (html-id nil) (auto-place t)) (let ((new-obj (change-class (create-div obj :content "" - :hidden hidden - :class class - :html-id html-id - :auto-place auto-place) - 'clog-database))) + :hidden hidden + :class class + :html-id html-id + :auto-place auto-place) + 'clog-database))) new-obj)) (defgeneric clog-database (clog-obj) @@ -126,24 +126,24 @@ connection exists assign it to the database-connecton.")) ;;;;;;;;;;;;;;;;;;;; (defgeneric create-one-row (clog-obj &key clog-database - hidden class html-id auto-place) + hidden class html-id auto-place) (:documentation "Create a new CLOG-One-Row element. If CLOG-OBJ is of type-of CLOG-DATABASE it is used as database source unless :CLOG-DATABASE is set.")) (defmethod create-one-row ((obj clog-obj) &key (clog-database nil) - (hidden nil) - (class nil) - (html-id nil) (auto-place t)) + (hidden nil) + (class nil) + (html-id nil) (auto-place t)) (let ((new-obj (change-class (create-div obj :content "" - :hidden hidden - :class class - :html-id html-id - :auto-place auto-place) - 'clog-one-row))) + :hidden hidden + :class class + :html-id html-id + :auto-place auto-place) + 'clog-one-row))) (if (and (typep obj 'clog-database) (not clog-database)) - (setf (clog-database new-obj) obj) - (setf (clog-database new-obj) clog-database)) + (setf (clog-database new-obj) obj) + (setf (clog-database new-obj) clog-database)) new-obj)) (defgeneric query-row (clog-one-row panel sql) @@ -153,9 +153,9 @@ slots on panel will be set using DATA-LOAD-PLIST.")) (defmethod query-row ((obj clog-one-row) panel sql) (setf (last-sql obj) sql) (setf (queryid obj) (dbi:execute - (dbi:prepare - (database-connection (clog-database obj)) - sql))) + (dbi:prepare + (database-connection (clog-database obj)) + sql))) (next-row obj panel)) (defgeneric get-row (clog-one-row panel) @@ -167,24 +167,24 @@ be set using DATA-LOAD-PLIST.")) (let ((where (where-clause obj))) (when (slave-to-slot obj) (let ((field (slave-to-slot obj)) - (data (car (data-write-list panel (list (slave-to-slot obj)))))) - (when (consp (slave-to-slot obj)) - (setf field (car field))) - (setf where (format nil "~A='~A'~A" - field - data - (if (equal where "") - "" - (format nil " and ~A" where)))))) + (data (car (data-write-list panel (list (slave-to-slot obj)))))) + (when (consp (slave-to-slot obj)) + (setf field (car field))) + (setf where (format nil "~A='~A'~A" + field + data + (if (equal where "") + "" + (format nil " and ~A" where)))))) (setf (last-sql obj) (sql-select (table-name obj) - (table-columns obj) - :where where - :order-by (order-by obj) - :limit (limit obj))) + (table-columns obj) + :where where + :order-by (order-by obj) + :limit (limit obj))) (setf (queryid obj) (dbi:execute - (dbi:prepare - (database-connection (clog-database obj)) - (last-sql obj))))) + (dbi:prepare + (database-connection (clog-database obj)) + (last-sql obj))))) (next-row obj panel)) (defgeneric next-row (clog-one-row panel) @@ -198,13 +198,13 @@ using DATA-LOAD-PLIST.")) (when (on-fetch obj) (funcall (on-fetch obj) obj)) (setf (rowid obj) (data-load-plist panel - (last-fetch obj) - :row-id-name (row-id-name obj))) + (last-fetch obj) + :row-id-name (row-id-name obj))) (if (rowid obj) (dolist (slave (slaves obj)) - (get-row slave panel)) + (get-row slave panel)) (unless (slave-to-slot obj) - (clear-row obj panel))) + (clear-row obj panel))) (rowid obj)) (defgeneric insert-row (clog-one-row panel) @@ -214,7 +214,7 @@ used to extract data from PANEL items and custom slots.")) (defmethod insert-row ((obj clog-one-row) panel) (dbi:do-sql (database-connection (clog-database obj)) (sql-insert* (table-name obj) - (data-write-plist panel (table-columns obj))))) + (data-write-plist panel (table-columns obj))))) (defgeneric update-row (clog-one-row panel) (:documentation "Update row in database table based on @@ -224,8 +224,8 @@ on panel will be retrieved from PANEL using DATA-WRITE-PLIST.")) (defmethod update-row ((obj clog-one-row) panel) (dbi:do-sql (database-connection (clog-database obj)) (sql-update (table-name obj) - (data-write-plist panel (table-columns obj)) - (format nil "~A=~A" (row-id-name obj) (rowid obj))))) + (data-write-plist panel (table-columns obj)) + (format nil "~A=~A" (row-id-name obj) (rowid obj))))) (defgeneric delete-row (clog-one-row panel) (:documentation "Delete a row from a database table based on @@ -233,9 +233,9 @@ current rowid and then call CLEAR-ROW")) (defmethod delete-row ((obj clog-one-row) panel) (dbi:do-sql (database-connection (clog-database obj)) (format nil "delete from ~A where ~A=~A" - (table-name obj) - (row-id-name obj) - (rowid obj))) + (table-name obj) + (row-id-name obj) + (rowid obj))) (clear-row obj panel)) (defgeneric clear-row (clog-one-row panel) @@ -293,30 +293,30 @@ new-row will block until on-fetch returns.")) (:documentation "Create a new clog-lookup as child of CLOG-OBJ.")) (defmethod create-lookup ((obj clog-obj) - &key (clog-database nil) - (name nil) - (multiple nil) - (label nil) - (class nil) - (html-id nil)) + &key (clog-database nil) + (name nil) + (multiple nil) + (label nil) + (class nil) + (html-id nil)) (let ((element (create-child - obj (format nil "" - (if multiple - " multiple" - "") - (if name - (format nil " name='~A'" name) - "") - (if class - (format nil " class='~A'" - (escape-string class)) - "")) - :clog-type 'clog-lookup :html-id html-id :auto-place t))) + obj (format nil "" + (if multiple + " multiple" + "") + (if name + (format nil " name='~A'" name) + "") + (if class + (format nil " class='~A'" + (escape-string class)) + "")) + :clog-type 'clog-lookup :html-id html-id :auto-place t))) (when label (label-for label element)) (if (and (typep obj 'clog-database) (not clog-database)) - (setf (clog-database element) obj) - (setf (clog-database element) clog-database)) + (setf (clog-database element) obj) + (setf (clog-database element) clog-database)) element)) (defmethod next-row ((obj clog-lookup) panel) @@ -332,20 +332,20 @@ the displayed option." (setf (inner-html obj) "") (loop (let ((selected nil) - (row (dbi:fetch (queryid obj)))) - (unless row - (return)) - (when (on-fetch obj) - (funcall (on-fetch obj) obj)) - (when (equal select-value (getf row (value-field obj))) - (setf selected t) - (setf (rowid obj) (data-load-plist panel - (last-fetch obj) - :row-id-name (row-id-name obj)))) - (add-select-option obj - (getf row (value-field obj)) - (getf row (option-field obj)) - :selected selected)))) + (row (dbi:fetch (queryid obj)))) + (unless row + (return)) + (when (on-fetch obj) + (funcall (on-fetch obj) obj)) + (when (equal select-value (getf row (value-field obj))) + (setf selected t) + (setf (rowid obj) (data-load-plist panel + (last-fetch obj) + :row-id-name (row-id-name obj)))) + (add-select-option obj + (getf row (value-field obj)) + (getf row (option-field obj)) + :selected selected)))) (dolist (slave (slaves obj)) (get-row slave panel)) (rowid obj)) @@ -384,27 +384,27 @@ the displayed option." ;;;;;;;;;;;;;;;;;;;;; (defgeneric create-db-table (clog-obj &key clog-database - hidden class html-id auto-place) + hidden class html-id auto-place) (:documentation "Create a new clog-db-table as child of CLOG-OBJ.")) (defmethod create-db-table ((obj clog-obj) - &key (clog-database nil) - (hidden nil) - (class nil) (html-id nil) (auto-place t)) + &key (clog-database nil) + (hidden nil) + (class nil) (html-id nil) (auto-place t)) (let ((element (create-child obj (format nil "" - (if hidden - " style='visibility:hidden;'" - "") - (if class - (format nil " class='~A'" - (escape-string class)) - "")) - :clog-type 'clog-db-table - :html-id html-id - :auto-place auto-place))) + (if hidden + " style='visibility:hidden;'" + "") + (if class + (format nil " class='~A'" + (escape-string class)) + "")) + :clog-type 'clog-db-table + :html-id html-id + :auto-place auto-place))) (if (and (typep obj 'clog-database) (not clog-database)) - (setf (clog-database element) obj) - (setf (clog-database element) clog-database)) + (setf (clog-database element) obj) + (setf (clog-database element) clog-database)) element)) (defmethod next-row ((obj clog-db-table) panel) @@ -419,17 +419,17 @@ the displayed option." (loop (let ((row (dbi:fetch (queryid obj)))) (unless row - (return)) + (return)) (when (on-fetch obj) - (funcall (on-fetch obj) obj)) + (funcall (on-fetch obj) obj)) (let ((tr (create-table-row obj))) - (when (on-row obj) - (funcall (on-row obj) obj tr)) - (loop for (key value) on row by #'cddr while value - do - (let ((td (create-table-column obj :content value))) - (when (on-column obj) - (funcall (on-column obj) obj key td))))))) + (when (on-row obj) + (funcall (on-row obj) obj tr)) + (loop for (key value) on row by #'cddr while value + do + (let ((td (create-table-column obj :content value))) + (when (on-column obj) + (funcall (on-column obj) obj key td))))))) (when (on-footer obj) (funcall (on-footer obj) obj)) (dolist (slave (slaves obj)) diff --git a/source/clog-docs.lisp b/source/clog-docs.lisp index 23f5a96..3542d88 100644 --- a/source/clog-docs.lisp +++ b/source/clog-docs.lisp @@ -25,7 +25,7 @@ (load "source/clog-style.lisp") (load "source/clog-canvas.lisp") (load "source/clog-form.lisp") - (load "source/clog-multimedia.lisp") + (load "source/clog-multimedia.lisp") (load "source/clog-window.lisp") (load "source/clog-document.lisp") (load "source/clog-location.lisp") @@ -34,7 +34,7 @@ (load "source/clog-system.lisp") (load "source/clog-panel.lisp") (load "source/clog-gui.lisp") - (load "source/clog-web.lisp") + (load "source/clog-web.lisp") (load "source/clog-docs.lisp") (load "source/clog-helpers.lisp") (load "source/clog-panel.lisp") @@ -86,7 +86,7 @@ frameworks and website frameworks. The CLOG package starts up the connectivity to the browser or other websocket client (often a browser embedded in a native template application.) -STATUS: CLOG is complete and all work is on higher order additions, +STATUS: CLOG is complete and all work is on higher order additions, such as full desktop over the web, database tools,etc. See below for some enhacements being worked on. CLOG is actually based on GNOGA, a framework I wrote for Ada in 2013 and used in commercial production @@ -295,7 +295,7 @@ change the even hander, set-on-* function will need to be called.") (defsection @clog-event-data (:title "CLOG Event Data") " Some events in CLOG return in addition to the target event, event data. -The data is passed in the second argument to the event handler as a +The data is passed in the second argument to the event handler as a property list. To retrieve the data use (getf data :property) the available properties (to use for :property) are based on the event type. @@ -410,7 +410,7 @@ keyboard-event-script: (when handler (lambda (data) (funcall handler obj (parse-keyboard-event data)))) - :call-back-script keyboard-event-script)) + :call-back-script keyboard-event-script)) ``` * The script diff --git a/source/clog-document.lisp b/source/clog-document.lisp index ad56597..88928f0 100644 --- a/source/clog-document.lisp +++ b/source/clog-document.lisp @@ -1,6 +1,6 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; CLOG - The Common Lisp Omnificent GUI ;;;; -;;;; (c) 2020-2021 David Botton ;;;; +;;;; (c) 2020-2022 David Botton ;;;; ;;;; License BSD 3 Clause ;;;; ;;;; ;;;; ;;;; clog-document.lisp ;;;; @@ -31,12 +31,12 @@ "Construct a new clog-document. (Private)" (make-instance 'clog-document :connection-id connection-id :html-id "document" - :document-element (make-instance 'clog-element - :connection-id connection-id - :html-id "documentElement") - :head-element (make-instance 'clog-element - :connection-id connection-id - :html-id "head"))) + :document-element (make-instance 'clog-element + :connection-id connection-id + :html-id "documentElement") + :head-element (make-instance 'clog-element + :connection-id connection-id + :html-id "head"))) ;;;;;;;;;;;;;;;;;;;;;; ;; document-element ;; ;;;;;;;;;;;;;;;;;;;;;; @@ -120,10 +120,10 @@ clog-document object. (Private)")) (query obj "title")) (defgeneric set-title (clog-document value)) - + (defmethod set-title ((obj clog-document) value) (execute obj - (format nil "title='~A'" (clog-connection:escape-string value))) + (format nil "title='~A'" (clog-connection:escape-string value))) value) (defsetf title set-title) @@ -156,8 +156,8 @@ clog-document object. (Private)")) (defmethod load-css ((obj clog-document) css-url) (jquery-execute (head-element obj) - (format nil "append('')" - (escape-string css-url)))) + (format nil "append('')" + (escape-string css-url)))) ;;;;;;;;;;;;;;;;; ;; load-script ;; @@ -168,8 +168,8 @@ clog-document object. (Private)")) (defmethod load-script ((obj clog-document) script-url) (jquery-execute (head-element obj) - (format nil "append('