X-Git-Url: http://git.kpe.io/?p=wol.git;a=blobdiff_plain;f=genpage.lisp;h=3da30068c9fbd9cf47be6827410577893b739cad;hp=9e34467e5744f30facdeead1ee3ba05ad19091c8;hb=HEAD;hpb=1fa7614ba895d7a1bccd310cf9d8e8e1e2472d14 diff --git a/genpage.lisp b/genpage.lisp index 9e34467..3da3006 100644 --- a/genpage.lisp +++ b/genpage.lisp @@ -39,32 +39,32 @@ (defmacro def-stdsite-header (site &body body) `(setf (gethash ',site *header-table*) - #'(lambda (plist command) - (declare (ignorable plist command)) - ,@body))) + #'(lambda (plist command) + (declare (ignorable plist command)) + ,@body))) (defmacro def-stdsite-footer (site &body body) `(setf (gethash ',site *footer-table*) - #'(lambda (plist command) - (declare (ignorable plist command)) - ,@body))) + #'(lambda (plist command) + (declare (ignorable plist command)) + ,@body))) (defmacro def-stdsite-banner (site &body body) `(setf (gethash ',site *banner-table*) - #'(lambda (plist command) - (declare (ignorable plist command)) - ,@body))) + #'(lambda (plist command) + (declare (ignorable plist command)) + ,@body))) (defmacro def-stdsite-contents (site &body body) `(setf (gethash ',site *contents-table*) - #'(lambda (plist command) - (declare (ignorable plist command)) - ,@body))) + #'(lambda (plist command) + (declare (ignorable plist command)) + ,@body))) (defmacro gen-std-head (title site plist command &body body) `(html - (:head + (:head (when ,title (html (:title ,title))) (maybe-gen-header ',site ,plist ,command) @@ -82,39 +82,35 @@ (html ((:div class "stdbodytable") ((:div :style "width:160px;position:fixed;left:3;right:auto;top:0") - ((:img :src "/images/umlisp-logo.png" :alt "logo" - :style "border:0;width:160;height:55")) + ((:img :src "/images/umlisp-logo.png" :alt "logo" + :style "border:0;width:160;height:55")) (maybe-gen-contents ',site ,plist ,command)) ((:div :style "position:absolute;left:170px;top:0") ((:div :style - "font-size:20pt;color:#777;text-align:center;margin-bottom:4pt") - "High Performance Common Lisp Interface to the Unified Medical Langauge System") + "font-size:20pt;color:#777;text-align:center;margin-bottom:4pt") + "High Performance Common Lisp Interface to the Unified Medical Langauge System") ,@body - (gen-std-footer ,site ,plist ,command)))))) + (gen-std-footer ,site ,plist ,command)))))) -(defun ml-head (title-str &optional (css "http://b9.com/main.css") altcss) +(defun ml-head (title-str &optional (css "http://kpe.io/main.css") altcss) (html (:head ((:link :rel "stylesheet" :href css :type "text/css")) (when altcss (html ((:link :rel "stylesheet" :type "text/css" - :href (if (eq altcss t) - "http://b9.com/umls.css" altcss))))) + :href (if (eq altcss t) + "http://kpe.io/umls.css" altcss))))) (when title-str (html (:title (lml-write-string title-str))))))) -(defvar +std-entities+ " - -") - (defun page-prologue (title format css altcss) (ecase format (:xml - (dtd-prologue format :entities +std-entities+) + (dtd-prologue format) (lml-format "~%" - (aif css it "http://b9.com/umlsxml.css")) + (aif css it "http://kpe.io/umlsxml.css")) (lml-write-string "") (lml-write-char #\Newline) (when title @@ -123,14 +119,14 @@ (:html (dtd-prologue format) (lml-write-string "") - (ml-head title (aif css it "http://b9.com/main.css") altcss) + (ml-head title (aif css it "http://kpe.io/main.css") altcss) (lml-write-string "")) ((:xhtml :xhtml11 :xhtml10-strict :xhtml10-transitional :xhtml10-frameset) - (dtd-prologue format :entities +std-entities+) + (dtd-prologue format) (lml-write-string "") - (ml-head title (aif css it "http://b9.com/main.css") altcss) + (ml-head title (aif css it "http://kpe.io/main.css") altcss) (lml-write-string "")) (:text ;; nothing to do @@ -152,7 +148,7 @@ (defun page-keyword-format (format) (ecase format ((:html :xhtml :xhtml11 :xhtml10-strict :xhtml10-transitional - :xhtml10-frameset) + :xhtml10-frameset) :html) (:xml :xml) @@ -160,24 +156,24 @@ :text))) (defmacro with-lml-page ((title &key (format :xhtml) css altcss (precompute t)) - &rest body) + &rest body) (let ((fmt (gensym "FMT-"))) `(let ((,fmt ,format)) (with-ml-page (:format (page-keyword-format ,fmt) :precompute ,precompute) - (let ((*html-stream* *modlisp-socket*)) - (prog1 - (progn - (page-prologue ,title ,format ,css ,altcss) - ,@body) - (page-epilogue ,format))))))) + (let ((*html-stream* *modlisp-socket*)) + (prog1 + (progn + (page-prologue ,title ,format ,css ,altcss) + ,@body) + (page-epilogue ,format))))))) (defmacro gen-std-page ((site plist command title &key css altcss - (precompute t) (format :xhtml)) - &body body) + (precompute t) (format :xhtml)) + &body body) `(let ((*print-circle* nil)) (with-lml-page (,title :css ,css :altcss ,altcss :format ,format - :precompute ,precompute) + :precompute ,precompute) (gen-std-body ,site ,plist ,command ,@body)))) @@ -198,7 +194,7 @@ ,@body (lml-princ "")) ((:html :xhtml :xhtml11 :xhtml10-strict :xhtml10-transitional - :xhtml10-frameset) + :xhtml10-frameset) (lml-princ "") @@ -208,17 +204,17 @@ (defun ml-link (page name session-id &key (format :html)) (case format ((:html :xhtml :xhtml11 :xhtml10-strict :xhtml10-transitional - :xhtml10-frameset) + :xhtml10-frameset) (html ((:div class "homelink") "Return to " (with-ml-link ((make-ml-url page :session-id session-id :html t)) - (lml-write-string name)) + (lml-write-string name)) " page."))) ((:xml :ie-xml) (lml-princ "Return to ") (with-ml-link ((make-ml-url page :session-id session-id :html t) - :format format) + :format format) (lml-write-string name)) (lml-write-string " page."))))