Commits

Anonymous committed a043014

Added macro to set page title

  • Participants
  • Parent commits 47183b8

Comments (0)

Files changed (1)

   'htmltag
   'render-as-html
   '+@
+  '+title
   'hout
   'expansion
   'tags
   "Output stream for rendering html"
   )
 
+(defvar *page-title* ""
+  "The title of the page as it should be presented to the user in the browser"
+)
+
 (defvar *page-scripts*
       ()
   "A list of strings, each representing a script added to the page"
   (expand-expression-with-libraries expr *available-tag-libraries*)
        )
 
+(defmacro +title (expr)
+  `(progn
+     (setf *page-title* ,expr)
+     nil
+     )
+  )
+
 (defmacro defhtmltag (name
 		      &key
 		      ((:tag tag) nil)
 (defmacro html (&rest body)
   "Interpret the body as html markup, returning an HTML fragment"
   `(let (
+	 (*page-title* ())
 	 (*page-style-sheets* ())
 	 (*page-styles* ())
 	 (*page-script-libraries* ())
 		      )
 	     )
 	   )
-       (values content *page-style-sheets* *page-styles* *page-script-libraries* *page-scripts* *page-ready-scripts*)
+       (values content *page-title* *page-style-sheets* *page-styles* *page-script-libraries* *page-scripts* *page-ready-scripts*)
        )
      )
   )
   "Interpret the raw body as html markup, and return a complete HTML page"
   `(multiple-value-bind (page-attributes body) (separate-initializer-and-body (quote ,raw-body))
      (declare (ignorable page-attributes body ) )
-     (multiple-value-bind (page-content *page-style-sheets* *page-styles* *page-script-libraries* *page-scripts* *page-ready-scripts*) 
+     (multiple-value-bind (page-content *page-title* *page-style-sheets* *page-styles* *page-script-libraries* *page-scripts* *page-ready-scripts*) 
 	   (html (list ,@raw-body) )
 					; now render the page
 	 (with-output-to-string (*html-out*)
 	   (hout "<html xmlns=\"http://www.w3.org/1999/xhtml\">~%")
 	   (hout "<head>~%")
 
+	   (when *page-title*
+	     (hout "<title>~a</title>" *page-title*)
+	     )
+
 	   (when *page-style-sheets*
 	       (dolist (style-sheet *page-style-sheets*)
 		 (hout "<link type='text/css' href='~a' rel='stylesheet' />~%"