diff --git a/CONCEPT.md b/CONCEPT.md index 9db68d5..ad8200a 100644 --- a/CONCEPT.md +++ b/CONCEPT.md @@ -108,4 +108,3 @@ and were it is deficient to your needs please contact me to see if it makes sense to meet your needs and so for CLOG to reach a broader set of use cases within it's conceptual purpose, UIs for lisp applications from single user utilities to massive concurrent multiuser systems. - diff --git a/FUTURE.md b/FUTURE.md index a29f869..4aeaeba 100644 --- a/FUTURE.md +++ b/FUTURE.md @@ -24,11 +24,10 @@ remove need for websocket transport. Some notes on this 1) Sending data to the page - https://wiki.gnome.org/Projects/WebKitGtk/ProgrammingGuide/Cookbook - look there for executing JavaScript (CLOG is JS snipits) or better https://webkitgtk.org/reference/webkitgtk/stable/webkitgtk-webkitwebview.html#webkit-web-view-execute-script also see https://github.com/webview/webview/issues/8 - + 2) Sending the boot.js file - Certainly a local file load will work file:// but nice if also have direct way to send html/js 3) Way to receive data from the page - This is one way but not ideal - https://webkitgtk.org/reference/webkit2gtk/stable/WebKitWebContext.html#webkit-web-context-register-uri-scheme and seems most all here https://blogs.igalia.com/carlosgc/2013/09/10/webkit2gtk-web-process-extensions/ - clog-monitor - logging, usage, etc. - diff --git a/LEARN.md b/LEARN.md index 58e040d..c503214 100644 --- a/LEARN.md +++ b/LEARN.md @@ -1,4 +1,3 @@ - ``` L EEEE A RRR NN N CCCC L OOOOO GGGGG L E A A R R N N N C L O O G @@ -105,7 +104,7 @@ CLOG Demos - Learn through Projects (see source if editor dosen't load) - [04-demo.lisp](demos/04-demo.lisp) - CMS Website - A very simple database driven website - [clos-encounters](https://github.com/rabbibotton/clos-encounters) - Full Project - Game -- [clos-contact](https://github.com/rabbibotton/clos-contact) - Full Project - Business App +- [clos-contact](https://github.com/rabbibotton/clos-contact) - Full Project - Business App Misc CLOG Tutorials diff --git a/NATIVE.md b/NATIVE.md index 95ac8c2..117a9fa 100644 --- a/NATIVE.md +++ b/NATIVE.md @@ -1,4 +1,3 @@ - # Creating Native Applications with CLOG 1. Open app using chrome in app mode @@ -57,15 +56,15 @@ In the REPL let's load the new project: (defun start-app (&key (port 8080)) (ceramic:start) (initialize 'on-new-window - :port port - :static-root (ceramic:resource-directory 'www)) + :port port + :static-root (ceramic:resource-directory 'www)) (setf *window* (ceramic:make-window :url (format nil "http://127.0.0.1:~D/" port))) (ceramic:show *window*)) (ceramic:define-resources :elect () (www #p"www/")) - + (ceramic:define-entry-point :elect () (start-app)) ``` @@ -87,4 +86,3 @@ That should start up a native application with your CLOG app To package you applicaton use: 1. (ceramic:bundle :elect) - diff --git a/README.md b/README.md index 9d13971..8cbebba 100644 --- a/README.md +++ b/README.md @@ -248,7 +248,7 @@ CLOG Builder Tutorials https://www.reddit.com/r/lisp/comments/t61sib/clog_builder_tutorial_4_a_complete_database_app/ 5. Using and Creating Custom Controls https://www.reddit.com/r/lisp/comments/w2d6dr/builder_tutorial_5_using_and_creating_lisp_custom/ - + CLOG Tutorials - [01-tutorial.lisp](tutorial/01-tutorial.lisp) - Hello World diff --git a/VSCODE.md b/VSCODE.md index 046abf2..61a9393 100644 --- a/VSCODE.md +++ b/VSCODE.md @@ -8,7 +8,7 @@ Using VSCODE instead of emacs: - Update asdf by git cloning the latest version in to ~/common-lisp or another asdf reachable location -git clone https://github.com/fare/asdf.git +git clone https://github.com/fare/asdf.git - Download and install vscode diff --git a/WEBSERVER.md b/WEBSERVER.md index 4d6f6ef..a8e622b 100644 --- a/WEBSERVER.md +++ b/WEBSERVER.md @@ -2,7 +2,7 @@ CLOG is configured to handle both standard http and https connections. The following is the configuration I used for Apache on the clogpower.com site using the rewrite engine to expose my site externally as clogpower.com -but interanlly as localhost on port 8081 (or other port) and is typically +but interanlly as localhost on port 8081 (or other port) and is typically how I configure my CLOG based servers: (Note use of *.443 also and use of SSLEngine, if not using SSL remove both) diff --git a/WINDOWS.md b/WINDOWS.md index 9df0afe..e984dec 100644 --- a/WINDOWS.md +++ b/WINDOWS.md @@ -1,4 +1,3 @@ - ## Installing Common Lisp on Windows 64bit from Scratch 1. Download and install rho-emacs: diff --git a/clean b/clean index 7507747..4e17bbd 100755 --- a/clean +++ b/clean @@ -1,4 +1,5 @@ +for file in *.lisp; do emacs -batch $file -l "~/.emacs.d/init.el" -f mark-whole-buffer -f untabify -f whitespace-cleanup -f save-buffer -kill; done; rm -r *.fas rm -r *.fasl rm -r *~ - +rm -r *.bak diff --git a/demos/01-demo.lisp b/demos/01-demo.lisp index 49010a2..ef97946 100644 --- a/demos/01-demo.lisp +++ b/demos/01-demo.lisp @@ -15,8 +15,8 @@ (deftype snake-direction-type () '(member :left :right :up :down)) (defun new-food () - (list (random (floor (- (/ display-width segment-size) 1))) - (random (floor (- (/ display-height segment-size) 1))))) + (list (random (floor (- (/ display-width segment-size) 1))) + (random (floor (- (/ display-height segment-size) 1))))) (defclass app-data () ((snake-direction @@ -34,7 +34,7 @@ (defun display-splash (body) (let* ((splash - (create-div body :content + (create-div body :content "

(Sparky The Snake)


Use your keyboard to move Sparky to pick up batteries.

@@ -42,7 +42,7 @@ If sparky hits his tail he electrocute himself to death!!

Use the arrow keys or a,w,s,d for direction keys.

")) - (ticker (create-span splash))) + (ticker (create-span splash))) (setf (width splash) "100%") (setf (text-alignment splash) :center) (dotimes (n 10) @@ -52,96 +52,96 @@ (defun paint (body cx app) (let ((game-over nil) - (head-cell (car (snake app)))) + (head-cell (car (snake app)))) (flet ((draw-segment (cell) - (fill-rect cx - (* (car cell) segment-size) - (* (cadr cell) segment-size) - segment-size - segment-size)) - (self-collision () - (dolist (cell (snake app)) - (when (equal cell head-cell) - (return t))))) + (fill-rect cx + (* (car cell) segment-size) + (* (cadr cell) segment-size) + segment-size + segment-size)) + (self-collision () + (dolist (cell (snake app)) + (when (equal cell head-cell) + (return t))))) (cond ((eq :right (snake-direction app)) - (setf head-cell (list (1+ (car head-cell)) - (cadr head-cell)))) - ((eq :left (snake-direction app)) - (setf head-cell (list (1- (car head-cell)) - (cadr head-cell)))) - ((eq :up (snake-direction app)) - (setf head-cell (list (car head-cell) - (1- (cadr head-cell))))) - ((eq :down (snake-direction app)) - (setf head-cell (list (car head-cell) - (1+ (cadr head-cell)))))) + (setf head-cell (list (1+ (car head-cell)) + (cadr head-cell)))) + ((eq :left (snake-direction app)) + (setf head-cell (list (1- (car head-cell)) + (cadr head-cell)))) + ((eq :up (snake-direction app)) + (setf head-cell (list (car head-cell) + (1- (cadr head-cell))))) + ((eq :down (snake-direction app)) + (setf head-cell (list (car head-cell) + (1+ (cadr head-cell)))))) (cond ((or (< (car head-cell) 0) - (< (cadr head-cell) 0) - (>= (* (car head-cell) segment-size) display-width) - (>= (* (cadr head-cell) segment-size) display-height) - (self-collision)) - (fill-style cx :red) - (font-style cx "bold 20px sans-serif") - (fill-text cx "GAME OVER" 30 30) - (play-media (create-audio body :source "/demo/game-over.wav" :controls nil)) - (setf game-over t)) - (t - (fill-style cx :purple) - (push head-cell (snake app)) - (dolist (cell (snake app)) - (draw-segment cell)) - (fill-style cx :white) - (cond ((equal head-cell (food app)) - (fill-text cx (format nil "Score: ~A" (score app)) - 5 (- display-height 15)) - (setf (score app) (+ (score app) 10)) - (fill-style cx :green) - (fill-text cx (format nil "Score: ~A" (score app)) - 5 (- display-height 15)) - (play-media (create-audio body :source "/demo/eat.wav" :controls nil)) - (setf (food app) (new-food))) - (t - (draw-segment (car (last (snake app)))) - (setf (snake app) (butlast (snake app))))) - (fill-style cx :brown) - (draw-segment (food app)))) - game-over))) + (< (cadr head-cell) 0) + (>= (* (car head-cell) segment-size) display-width) + (>= (* (cadr head-cell) segment-size) display-height) + (self-collision)) + (fill-style cx :red) + (font-style cx "bold 20px sans-serif") + (fill-text cx "GAME OVER" 30 30) + (play-media (create-audio body :source "/demo/game-over.wav" :controls nil)) + (setf game-over t)) + (t + (fill-style cx :purple) + (push head-cell (snake app)) + (dolist (cell (snake app)) + (draw-segment cell)) + (fill-style cx :white) + (cond ((equal head-cell (food app)) + (fill-text cx (format nil "Score: ~A" (score app)) + 5 (- display-height 15)) + (setf (score app) (+ (score app) 10)) + (fill-style cx :green) + (fill-text cx (format nil "Score: ~A" (score app)) + 5 (- display-height 15)) + (play-media (create-audio body :source "/demo/eat.wav" :controls nil)) + (setf (food app) (new-food))) + (t + (draw-segment (car (last (snake app)))) + (setf (snake app) (butlast (snake app))))) + (fill-style cx :brown) + (draw-segment (food app)))) + game-over))) (defun on-key-down (obj event) (let ((app (connection-data-item obj "app-data")) - (key (getf event :key))) + (key (getf event :key))) (cond ((or (equalp key "ArrowLeft") (equalp key "a")) - (setf (snake-direction app) :left)) - ((or (equalp key "ArrowUp") (equalp key "w")) - (setf (snake-direction app) :up)) - ((or (equalp key "ArrowDown") (equalp key "s")) - (setf (snake-direction app) :down)) - ((or (equalp key "ArrowRight") (equalp key "d")) - (setf (snake-direction app) :right))))) - + (setf (snake-direction app) :left)) + ((or (equalp key "ArrowUp") (equalp key "w")) + (setf (snake-direction app) :up)) + ((or (equalp key "ArrowDown") (equalp key "s")) + (setf (snake-direction app) :down)) + ((or (equalp key "ArrowRight") (equalp key "d")) + (setf (snake-direction app) :right))))) + (defun on-click (obj) (let ((app (connection-data-item obj "app-data")) - (btn-txt (text obj))) + (btn-txt (text obj))) (cond ((equal btn-txt "<--") (setf (snake-direction app) :left)) - ((equal btn-txt "-->") (setf (snake-direction app) :right)) - ((equal btn-txt "-^-") (setf (snake-direction app) :up)) - ((equal btn-txt "-v-") (setf (snake-direction app) :down))))) + ((equal btn-txt "-->") (setf (snake-direction app) :right)) + ((equal btn-txt "-^-") (setf (snake-direction app) :up)) + ((equal btn-txt "-v-") (setf (snake-direction app) :down))))) (defun start-game (body) (let* ((app (connection-data-item body "app-data")) - (disp (create-canvas body - :width display-width - :height display-height)) - (br (create-br body)) - (controls (create-div body)) - (left-btn (create-button controls :content "<--")) - (right-btn (create-button controls :content "-->")) - (up-btn (create-button controls :content "-^-")) - (down-btn (create-button controls :content "-v-")) - context) + (disp (create-canvas body + :width display-width + :height display-height)) + (br (create-br body)) + (controls (create-div body)) + (left-btn (create-button controls :content "<--")) + (right-btn (create-button controls :content "-->")) + (up-btn (create-button controls :content "-^-")) + (down-btn (create-button controls :content "-v-")) + context) (declare (ignore br)) ;; Initialize display - (setf (background-color body) :orange) + (setf (background-color body) :orange) (setf (display disp) :block) (setf (background-color disp) :white) (set-margin disp :auto :auto :auto :auto) @@ -155,7 +155,7 @@ (font-style context "normal 20px sans-serif") (fill-style context :green) (fill-text context (format nil "Score: ~A" (score app)) - 5 (- display-height 15)) + 5 (- display-height 15)) (set-on-key-down body #'on-key-down :disable-default t) (set-on-click left-btn #'on-click) (set-on-click right-btn #'on-click) diff --git a/demos/02-demo.lisp b/demos/02-demo.lisp index ca068fb..d693a67 100644 --- a/demos/02-demo.lisp +++ b/demos/02-demo.lisp @@ -9,10 +9,10 @@ (defun send-message (user msg) (maphash (lambda (key value) - (declare (ignore key)) - (create-span value :content (format nil "~A : ~A
" user msg)) - (setf (scroll-top value) (scroll-height value))) - *global-list-box-hash*)) + (declare (ignore key)) + (create-span value :content (format nil "~A : ~A
" user msg)) + (setf (scroll-top value) (scroll-height value))) + *global-list-box-hash*)) (defun on-new-window (body) (set-html-on-close body "Connection Lost") @@ -20,21 +20,21 @@ (setf (title (html-document body)) "CLOG Chat") (let* ((backdrop (create-div body :class "w3-container w3-cyan")) - (form-box (create-div backdrop :class "w3-container w3-white")) - (start-form (create-form form-box)) - (caption (create-section start-form :h3 :content "Sign In")) - (name-entry (create-form-element start-form :input :label - (create-label start-form :content "Chat Handle:"))) - (ok-button (create-button start-form :content "OK")) - (p (create-p start-form)) - (chat-box (create-form form-box)) - (br (create-br chat-box)) - (messages (create-div chat-box)) - (br (create-br chat-box)) - (out-entry (create-form-element chat-box :input)) - (out-ok (create-button chat-box :content "OK")) - (p (create-p chat-box)) - (user-name)) + (form-box (create-div backdrop :class "w3-container w3-white")) + (start-form (create-form form-box)) + (caption (create-section start-form :h3 :content "Sign In")) + (name-entry (create-form-element start-form :input :label + (create-label start-form :content "Chat Handle:"))) + (ok-button (create-button start-form :content "OK")) + (p (create-p start-form)) + (chat-box (create-form form-box)) + (br (create-br chat-box)) + (messages (create-div chat-box)) + (br (create-br chat-box)) + (out-entry (create-form-element chat-box :input)) + (out-ok (create-button chat-box :content "OK")) + (p (create-p chat-box)) + (user-name)) (declare (ignore caption)(ignore br)(ignore p)) (setf (hiddenp chat-box) t) (setf (background-color backdrop) :blue) @@ -51,17 +51,17 @@ (set-border messages :thin :solid :black) (setf (overflow messages) :scroll) (set-on-click ok-button - (lambda (obj) - (declare (ignore obj)) - (setf (hiddenp start-form) t) - (setf user-name (value name-entry)) - (setf (gethash user-name *global-list-box-hash*) messages) - (setf (hiddenp chat-box) nil))) + (lambda (obj) + (declare (ignore obj)) + (setf (hiddenp start-form) t) + (setf user-name (value name-entry)) + (setf (gethash user-name *global-list-box-hash*) messages) + (setf (hiddenp chat-box) nil))) (set-on-click out-ok - (lambda (obj) - (declare (ignore obj)) - (send-message user-name (value out-entry)) - (setf (value out-entry) ""))) + (lambda (obj) + (declare (ignore obj)) + (send-message user-name (value out-entry)) + (setf (value out-entry) ""))) (run body) (remhash user-name *global-list-box-hash*))) diff --git a/demos/04-demo.lisp b/demos/04-demo.lisp index 44c087c..b407b0d 100644 --- a/demos/04-demo.lisp +++ b/demos/04-demo.lisp @@ -37,7 +37,7 @@ ;; ;; Header (setf (head app) (create-web-panel body :content "

Demo 4:

A simple Lisp CMS

" - :class "w3-yellow")) + :class "w3-yellow")) ;; Sidebar (setf (side app) (create-web-sidebar body)) (setf (box-width (side app)) (unit :px side-panel-size)) @@ -58,14 +58,14 @@ (defun new-content (app) (setf (inner-html (main app)) "") (let ((new-page (create-form-element (main app) :text :value "New Title")) - (tmp (create-br (main app))) - (text-area (create-text-area (main app) :rows 10 :columns 40))) + (tmp (create-br (main app))) + (text-area (create-text-area (main app) :rows 10 :columns 40))) (declare (ignore tmp)) (create-br (main app)) (set-on-click (create-button (main app) :content "Insert") - (lambda (obj) - (declare (ignore obj)) - (insert-content app new-page text-area))))) + (lambda (obj) + (declare (ignore obj)) + (insert-content app new-page text-area))))) (defun update-content (app page text-area) (dbi:do-sql @@ -84,84 +84,84 @@ (defun edit-content (app page) (setf (inner-html (main app)) "") (let ((contents (dbi:fetch-all - (dbi:execute - (dbi:prepare - *sql-connection* - "select main from config where menu= ?") - (list page))))) + (dbi:execute + (dbi:prepare + *sql-connection* + "select main from config where menu= ?") + (list page))))) (dolist (content contents) (let ((text-area (create-text-area (main app) :rows 10 :columns 40 - :value (second content)))) - (create-br (main app)) - (set-on-click (create-button (main app) :content "Update") - (lambda (obj) - (declare (ignore obj)) - (update-content app page text-area))) - (unless (equal page "Home") - (set-on-click (create-button (main app) :content "Delete") - (lambda (obj) - (declare (ignore obj)) - (delete-content app page)))))))) + :value (second content)))) + (create-br (main app)) + (set-on-click (create-button (main app) :content "Update") + (lambda (obj) + (declare (ignore obj)) + (update-content app page text-area))) + (unless (equal page "Home") + (set-on-click (create-button (main app) :content "Delete") + (lambda (obj) + (declare (ignore obj)) + (delete-content app page)))))))) (defun route-content (app page) (setf (inner-html (main app)) "") (let ((contents (dbi:fetch-all - (dbi:execute - (dbi:prepare - *sql-connection* - "select main from config where menu= ?") - (list page))))) + (dbi:execute + (dbi:prepare + *sql-connection* + "select main from config where menu= ?") + (list page))))) (dolist (content contents) (setf (inner-html (main app)) (second content)) (create-br (main app)) (create-br (main app)) (when (sysop app) - (set-on-click (create-a (main app) :content "edit") - (lambda (obj) - (declare (ignore obj)) - (edit-content app page))))))) + (set-on-click (create-a (main app) :content "edit") + (lambda (obj) + (declare (ignore obj)) + (edit-content app page))))))) (defun id-me (app) (setf (inner-html (main app)) "") (clog-web-form (main app) "Validate:" - '(("Password" "pass" :password)) - (lambda (res) - (if (equal (second (first res)) sysop-password) - (progn - (setf (sysop app) t) - (reset-menu app) - (setf (inner-html (main app)) "You are logged in.")) - (setf (inner-html (main app)) "Invalid password."))))) + '(("Password" "pass" :password)) + (lambda (res) + (if (equal (second (first res)) sysop-password) + (progn + (setf (sysop app) t) + (reset-menu app) + (setf (inner-html (main app)) "You are logged in.")) + (setf (inner-html (main app)) "Invalid password."))))) (defun reset-menu (app) (setf (inner-html (side app)) "") (let ((menu-items (dbi:fetch-all - (dbi:execute - (dbi:prepare *sql-connection* - "select menu from config"))))) + (dbi:execute + (dbi:prepare *sql-connection* + "select menu from config"))))) (dolist (menu-item menu-items) (set-on-click (create-web-sidebar-item (side app) :content (second menu-item)) (lambda (obj) - (declare (ignore obj)) - (route-content app (second menu-item)))))) + (declare (ignore obj)) + (route-content app (second menu-item)))))) (create-br (side app)) (if (sysop app) (progn - (set-on-click (create-a (side app) :content "new") - (lambda (obj) - (declare (ignore obj)) - (new-content app))) - (create-br (side app)) - (set-on-click (create-a (side app) :content "logout") - (lambda (obj) - (declare (ignore obj)) - (setf (sysop app) nil) - (reset-menu app) - (route-content app "Home")))) + (set-on-click (create-a (side app) :content "new") + (lambda (obj) + (declare (ignore obj)) + (new-content app))) + (create-br (side app)) + (set-on-click (create-a (side app) :content "logout") + (lambda (obj) + (declare (ignore obj)) + (setf (sysop app) nil) + (reset-menu app) + (route-content app "Home")))) (set-on-click (create-a (side app) :content "login") - (lambda (obj) - (declare (ignore obj)) - (id-me app))))) + (lambda (obj) + (declare (ignore obj)) + (id-me app))))) (defun on-new-window (body) (set-html-on-close body "Connection Lost") diff --git a/demos/README.md b/demos/README.md index ad9743b..d8c5b76 100644 --- a/demos/README.md +++ b/demos/README.md @@ -1,5 +1,3 @@ - - To run a demo, start emacs/slime or your CL Lisp in the common-lisp/clog directory: ``` diff --git a/doc/clog-manual.html b/doc/clog-manual.html index 52d4c05..e4fb5b5 100644 --- a/doc/clog-manual.html +++ b/doc/clog-manual.html @@ -554,7 +554,7 @@ their

  • [generic-function] CONNECTION-DATA-ITEM CLOG-OBJ ITEM-NAME

    -

    Get/Setf from connection-data the item-name in hash.

    • +

    Get/Setf item-name from connection-data.

    @@ -744,7 +744,7 @@ an application share per connection the same queue of serialized events.

  • [generic-function] REMOVE-CONNECTION-DATA-ITEM CLOG-OBJ ITEM-NAME

    -

    Remove from connection-data the item-name in hash.

    • +

    Remove item-name from connection-data.

    @@ -889,6 +889,16 @@ is nil unbind the event.

    is nil unbind the event.

    +

    +

    + + +

    @@ -1474,6 +1484,15 @@ after attachment is changed to one unique to this session.

    Remove html tag attribute. (eg. src on img tag)

    +

    +

    + + +

    CLOG-Element - Properties

    @@ -5277,7 +5296,7 @@ or CLOG Data-List objects.

    CLOG-Data-List - Class for CLOG Option Data Lists

    @@ -8783,10 +8802,10 @@ sufficient in this example:

    (defmethod set-on-click ((obj clog-obj) handler)
   (set-event obj "click"
-         (when handler
-           (lambda (data)
-         (declare (ignore data))
-         (funcall handler obj)))))
    + (when handler + (lambda (data) + (declare (ignore data)) + (funcall handler obj)))))

    If there is data for the event an additional string containing the needed JavaScript to return the even data and a function to parse out the data.

    @@ -8801,10 +8820,10 @@ keyboard-event-script:

    (defmethod set-on-key-down ((obj clog-obj) handler)
   (set-event obj "keydown"
-         (when handler
-           (lambda (data)
-         (funcall handler obj (parse-keyboard-event data))))
-         :call-back-script keyboard-event-script))
    + (when handler + (lambda (data) + (funcall handler obj (parse-keyboard-event data)))) + :call-back-script keyboard-event-script))