;;;=========================================================================== ;;; ;;; macros.lisp ;;; ;;; Eduardo Muñoz ;;; Time-stamp: "Sunday, 02 January 2005 - 00:39:41" ;;; ;;;=========================================================================== (in-package :weblisp) (use-package '(:htout)) (defstruct page address lang public source function) (defmacro with-apache-address (&whole source (address &key lang public) &body body) (let ((adr (gensym "address"))) `(let ((,adr ,address)) (setf (gethash ,adr *apache-address-table*) (make-page :address ,adr :lang ,lang :public ,public :source ',source :function (lambda (command) (declare (ignorable command)) ,@body))) ;; return address ,adr))) (defmacro with-static-page (&whole source (file &key lang public) &body body) (let ((path (gensym "file")) (stream (gensym "stream"))) `(let ((,path (format nil "~A~A" *apache-document-root* ,file))) (with-open-file (,stream ,path :direction :output :if-exists :supersede) (write-line ,@body ,stream)) (setf (gethash ,file *apache-address-table*) (make-page :address ,file :lang ,lang :public ,public :source ',source)) (unix:unix-chmod ,path (logior unix:readown unix:writeown unix:readgrp unix:readoth))))) (defmacro html (&body body) ;; *print-pretty* is a performance killer when doing html output `(let ((*print-pretty* nil)) (with-output-to-string (*html-stream*) (with-html-output (*html-stream*) ,@body)))) (defmacro html (&body body) ;; *print-pretty* is a performance killer when doing html output (let ((html-stream (gensym))) `(let ((*print-pretty* nil)) (with-output-to-string (,html-stream) (with-html-output (,html-stream) ,@body))))) (defmacro standard-page (title &body body) `(html "" (:html (:head ((:meta :http-equiv "Content-Type" :content "text/html; charset=iso-8859-1")) (str (page-style)) (:title ,title)) (:body ((:div :id "main") ((:table :class "layout") (:tbody (:tr ((:td :class "content") ((:div :id "content") ,@body)) ((:td :class "index") ((:div :id "index") (str (page-index))))) ;; (:tr (:td ((:div :id "copyright") (str (page-copyright))))) )) ((:div :id "footer") (str (page-footer)))))))) (defun page-style () (html ((:link :title "weblisp" :href "/weblisp.css" :type "text/css" :rel "stylesheet")))) (defun page-index () (html (:h3 (lnk "Home" "/")) (lnk "AutoLISP" "/misc/autolisp") :br (lnk "Links" "/misc/links") :br (lnk "Site Map" "/misc/site-map") :br (lnk "Powered by" "/misc/powered-by") :br :hr (:h3 (lnk "Emacs" "/misc/emacs")) (lnk "~/.emacs" "/misc/emacs-file") :br (lnk "Gnus" "/misc/gnus") :br (lnk "Tramp" "/misc/tramp") :br (lnk "Slime" "/misc/slime") :br :hr (:h3 (lnk "Lisp" "/lisp")) (lnk "Weblog" "/lisp/weblog") :br (lnk "CLiki" "/cliki/Index") :br (lnk "Server info" "/lisp/server-info") :br (lnk "Playground" "/lisp/play") :br (lnk "Images" "/lisp/images") :br (lnk "Errors" "/lisp/errors") :br )) (defun page-footer () (html (lnk "View source" "/lisp/source") " ~ " (lnk "Validate html" "/lisp/validate") " ~ " (lnk "Validate css" ;; "http://jigsaw.w3.org/css-validator/check/referer" "http://jigsaw.w3.org/css-validator/validator?uri=http://213.97.131.125/weblisp.css"))) (defun page-copyright () (html (:p "© 2003-2004" :br (lnk "Eduardo Muñoz" "mailto:emufer@terra.es")))) (defmacro standard-table (&rest elements) `(htm ((:table :bgcolor "#FFFFFF") ,@(sublis '((:th . (:th :bgcolor "#D0D0D0")) (:td . (:td :bgcolor "#EAEAEA"))) elements)))) (defmacro link (text &rest address) `(htm ((:a :href (concatenate 'string ,@address)) ,text))) (defmacro process-lisp (&body body) `(with-output-to-string (*standard-output*) ,@body))