Changes from maxclaims branch (git).
[clinton/lisp-on-lines.git] / src / ucw / standard-components.lisp
index 48eed0d..533e8fd 100644 (file)
                  (apply #'make-instance name args)))
 
 (defun/cc answer (&optional val)
-  (answer-component *source-component* 
-         val))
+  (let ((child *source-component*))
+    (setf *source-component* (ucw::component.calling-component child))
+    (answer-component child val)))
 
-(defclass described-component-class (standard-component-class described-class)
+(defclass described-component-class (described-class standard-component-class )
   ())
 
 (defmacro defaction (&rest args-and-body)
              (return action-id))))
    (call-next-method)))
 
+
+
+
+
 (defcomponent standard-window-component 
-  (ucw:basic-window-component)
+  (ucw::basic-window-component)
   ((body
     :initform nil
     :accessor window-body
     :component t
     :initarg :body)))
 
+(defmethod render-html-head ((window standard-window-component))
+  (let* ((app (context.application *context*))
+        (url-prefix (application.url-prefix app)))
+    (<:meta :http-equiv "Content-Type" :content (window-component.content-type window))
+    (awhen (window-component.title window)
+      (<:title (if (functionp it)
+                  (funcall it window)
+                  (<:as-html it))))
+    (awhen (window-component.icon window)
+      (<:link :rel "icon"
+             :type "image/x-icon"
+             :href (concatenate 'string url-prefix it)))
+    (dolist (stylesheet (effective-window-stylesheets window))
+      (<:link :rel "stylesheet"
+             :href stylesheet
+             :type "text/css"))))
+
 (defmethod render-html-body ((window standard-window-component))
   (ucw:render (window-body window)))