;;;=========================================================================== ;;; ;;; macros.lisp ;;; ;;; Eduardo Muñoz ;;; Time-stamp: "Sunday, 24 July 2005 - 14:29:25" ;;; ;;;=========================================================================== (in-package :weblisp) (use-package '(:htout)) (defmacro if-bind ((var clause) then &optional else) `(let ((,var ,clause)) (if ,var ,then ,else))) (defmacro with-apache-address (&whole source (address &key (lang "") (public nil)) &body body) (let ((adr (gensym "address"))) `(let ((,adr ,address)) (push-page ,adr ,public nil ,lang ',source (lambda (command) (declare (ignorable command)) ,@body)) ,adr))) (defmacro with-static-page (&whole source (file &key (lang "") (public nil)) &body body) (let ((filesym (gensym "file")) (path (gensym "path")) (stream (gensym "stream"))) `(let* ((,filesym ,file) (,path (format nil "~A~A" *apache-document-root* ,filesym))) (with-open-file (,stream ,path :direction :output :if-exists :supersede) (write-line ,@body ,stream)) (push-page ,filesym ,public t ,lang ',source nil) (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 ((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" "/misc/index")) (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/validator?uri=http://www.boundp.net/weblisp.css"))) (defun page-copyright () (html (:p "© 2003-2005" :br (lnk "Eduardo Muñoz" "mailto:emufer@terra.es")))) (defmacro list-table (&rest elements) `(htm ((:table) ,@(sublis '((:th . (:th :class "list")) (:td . (:td :class "list"))) elements)))) (defmacro link (text &rest address) `(htm ((:a :href (concatenate 'string ,@address)) ,text))) (defmacro with-db ((name spec) &body body) `(let ((,name (apply #'clsql:connect ,spec))) (unwind-protect (multiple-value-prog1 (progn ,@body)) (clsql:disconnect :database ,name)))) ;; (defmacro with-sql-recording (&body body) ;; `(time (clsql:with-default-database (*web-db*) ;; (clsql:start-sql-recording) ;; (prog1 (progn ,@body) ;; (clsql:stop-sql-recording))))) ;; Borken. Maybe http://www.ravenbrook.com/doc/2002/09/13/common-sql/ ;; will be helpful ;; (defun zoot () ;; (with-sql-recording ;; (clsql:select 'ip :from 'log :distinct t :limit 10 ;; :where [in [select 'ip :from 'whois :limit 10]])))