;;; -*- mode: Lisp; Syntax: Common-Lisp; -*- ;;; ;;; Copyright (c) 2009 by the authors. ;;; ;;; See LICENCE for details. (in-package :hu.dwim.web-server) ;;;;;; ;;; Variables (def (special-variable e) *dojo-skin-name*) (def (special-variable e) *dojo-script-uri*) (def (special-variable e) *dojo-base-uri*) ;;;;;; ;;; application-with-dojo-support (def (class* ea) application-with-dojo-support (application) ((dojo-skin-name "tundra") (dojo-script-uri nil) (dojo-base-uri nil))) (def method startup-broker :before ((self application-with-dojo-support)) (bind (((:slots dojo-base-uri dojo-script-uri) self)) (unless dojo-base-uri (awhen (find-latest-dojo-directory-name (system-relative-pathname :hu.dwim.web-server "www/libraries/") :otherwise :warn) (setf dojo-base-uri (net.uri:parse-uri (string+ "static/hdws/libraries/" it))))) (setf dojo-script-uri (hu.dwim.uri:ensure-parsed-uri dojo-script-uri)) (setf dojo-base-uri (hu.dwim.uri:ensure-parsed-uri dojo-base-uri)))) (def method startup-broker :after ((self application-with-dojo-support)) (unless (dojo-base-uri-of self) (warn "The ~S slot of application ~A is not initialized by the time the server was started! Please refer to the install guide (e.g. on http://dwim.hu) or the sources for details on how to build dojo." 'dojo-base-uri self))) (def method call-in-application-environment :around ((application application-with-dojo-support) session thunk) (bind ((*dojo-skin-name* (or (dojo-skin-name-of application) *dojo-skin-name*)) (*dojo-script-uri* (or (dojo-script-uri-of application) *dojo-script-uri*)) (*dojo-base-uri* (hu.dwim.uri:prepend-path (hu.dwim.uri:clone-uri (dojo-base-uri-of application)) (path-of application)))) (call-next-method))) ;;;;;; ;;; Rendering (def special-variable *dojo-widgets*) (macrolet ((x (&body entries) `(progn ,@(iter (for (name dojo-name) :on entries :by #'cddr) (collect `(def (constant e) ,name ,dojo-name)))))) (x +dijit/accordion-container+ "dijit.layout.AccordionContainer" +dijit/border-container+ "dijit.layout.BorderContainer" +dijit/content-pane+ "dijit.layout.ContentPane" +dijit/split-container+ "dijit.layout.SplitContainer" +dijit/tab-container+ "dijit.layout.TabContainer" +dijit/form+ "dijit.form.Form" +dijit/button+ "dijit.form.Button" +dijit/drop-down-button+ "dijit.form.DropDownButton" +dijit/date-text-box+ "dijit.form.DateTextBox" +dijit/simple-text-area+ "dijit.form.SimpleTextarea" +dijit/text-box+ "dijit.form.TextBox" +dijit/time-text-box+ "dijit.form.TimeTextBox" +dijit/combo-box+ "dijit.form.ComboBox" +dijit/filtering-select+ "dijit.form.FilteringSelect" +dijit/number-text-box+ "dijit.form.NumberTextBox" +dijit/dialog+ "dijit.Dialog" +dijit/tooltip-dialog+ "dijit.TooltipDialog" +dijit/editor+ "dijit.Editor" +dijit/menu+ "dijit.Menu" +dijit/menu-bar+ "dijit.MenuBar" +dijit/menu-item+ "dijit.MenuItem" +dijit/menu-bar-item+ "dijit.MenuBarItem" +dijit/menu-separator+ "dijit.MenuSeparator" +dijit/popup-menu-item+ "dijit.PopupMenuItem" +dijit/popup-menu-bar-item+ "dijit.PopupMenuBarItem" +dijit/inline-edit-box+ "dijit.InlineEditBox" )) (def (function e) find-latest-dojo-directory-name (directory &key (otherwise :cerror)) (loop (with-simple-restart (retry "Try searching for dojo directories again in ~A" directory) (bind ((dojo-dir (first (sort (remove-if [or (not (starts-with-subseq "dojo" !1)) (ends-with-subseq "disabled" !1)] (mapcar [last-elt (pathname-directory !1)] (uiop:subdirectories directory))) #'string>=)))) (return (if dojo-dir (string+ dojo-dir "/") (handle-otherwise/value otherwise :default-message (list "Seems like there's not any dojo directory in ~S. Hint: see hu.dwim.web-server/etc/build-dojo.sh" directory)))))))) (pushnew 'dojo-widget-collector/wrapper *xhtml-body-environment-wrappers*) (def function dojo-widget-collector/wrapper (thunk) (bind ((*dojo-widgets* '())) (multiple-value-prog1 (funcall thunk) (when *dojo-widgets* ;; NOTE: instantiation must happen before any other js code tinkers with the dojo widgets, ;; therefore we wrap here again with the js script collapser to emit us before the parent ;; WITH-XHTML-BODY-ENVIRONMENT emits the rest of the js stuff. `xml,@(with-xhtml-body-environment (:wrappers '(js-script-collapser/wrapper)) ;; NOTE don't use `js-onload here (comes later in *xhtml-body-environment-wrappers*, and it's better to have a visually more standalone entry in the output for this) `js(on-load (hdws.io.instantiate-dojo-widgets (array ,@(iter (for entry :in *dojo-widgets*) (bind (((id dojo-type &rest dojo-properties) entry)) (collect (if dojo-properties `js-piece(create :node ,id "data-dojo-type" ,dojo-type :inherited (dojo.mixin (lambda ()) (create ,@(iter (for (name value) :on dojo-properties :by #'cddr) ;; we would render a js null here otherwise, and there's no (easy?) way to differentiate ;; between the two situations, so just drop the whole thing... (when value (collect (if (keywordp name) (hyphened-to-camel-case (string-downcase (symbol-name name))) name)) (collect value)))))) `js-piece(create :node ,id "data-dojo-type" ,dojo-type))))))))))))) (def (with-macro* e) render-dojo-widget (dojo-type &optional (dojo-properties '()) &key (id (generate-unique-string "_w"))) (multiple-value-prog1 (-with-macro/body- (id '-id-)) (push (list* id dojo-type dojo-properties) *dojo-widgets*))) #+() ; TODO decide about this (def (function e) render-dojo-widget* (dojo-type &optional (dojo-properties '()) &key (id (generate-unique-string "_w"))) (render-dojo-widget (dojo-type dojo-properties :id id)
))