diff options
-rwxr-xr-x | journal.lisp | 8 | ||||
-rw-r--r-- | macros.lisp | 59 | ||||
-rw-r--r-- | main.lisp | 4 | ||||
-rw-r--r-- | mulk-journal.asd | 3 | ||||
-rw-r--r-- | utils.lisp | 23 |
5 files changed, 61 insertions, 36 deletions
diff --git a/journal.lisp b/journal.lisp index 5353de1..2dfa4bc 100755 --- a/journal.lisp +++ b/journal.lisp @@ -228,14 +228,6 @@ (<:as-is "Veröffentlichen"))))))) -(yaclml:deftag <xhtml (&attribute dir lang xmlns (prologue t) &body body) - (when prologue - (emit-princ "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">")) - (emit-open-tag "html" `(("dir" . ,dir) ("lang" . ,lang) ("xmlns" . ,xmlns))) - (emit-body body) - (emit-close-tag "html")) - - (defun show-web-journal () (http-add-header "Last-Modified" (http-timestamp (compute-journal-last-modified-date))) (http-send-headers "text/html; charset=UTF-8") diff --git a/macros.lisp b/macros.lisp new file mode 100644 index 0000000..c8f2866 --- /dev/null +++ b/macros.lisp @@ -0,0 +1,59 @@ +;;;; -*- coding: utf-8; mode: lisp -*- +;;;; Copyright 2007, Matthias Andreas Benkard. + +;;;------------------------------------------------------------------------ +;;; This file is part of The Mulkblog Project. +;;; +;;; The Mulkblog Project is free software. You can redistribute it and/or +;;; modify it under the terms of the Affero General Public License as +;;; published by Affero, Inc.; either version 1 of the License, or +;;; (at your option) any later version. +;;; +;;; The Mulkblog Project is distributed in the hope that it will be +;;; useful, but WITHOUT ANY WARRANTY; without even the implied warranty +;;; of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; Affero General Public License for more details. +;;; +;;; You should have received a copy of the Affero General Public +;;; License in the COPYING file that comes with The Mulkblog Project; if +;;; not, write to Affero, Inc., 510 Third Street, Suite 225, San +;;; Francisco, CA 94107 USA. +;;;------------------------------------------------------------------------ + +(in-package #:mulk.journal) + + +(yaclml:deftag <xhtml (&attribute dir lang xmlns (prologue t) &body body) + (when prologue + (emit-princ "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\" \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">")) + (emit-open-tag "html" `(("dir" . ,dir) ("lang" . ,lang) ("xmlns" . ,xmlns))) + (emit-body body) + (emit-close-tag "html")) + + +(defmacro with-result-cache ((cache-id &key (younger-than nil younger-than-p)) + &body body) + `(call-with-result-cache ,cache-id + #'(lambda () ,@body) + ,@(and younger-than-p `(:younger-than ,younger-than)))) + + +(defmacro with-initialised-journal (&body body) + `(call-with-initialised-journal #'(lambda () ,@body))) + + +(defmacro regex-case (string &body clauses) + (once-only (string) + `(cond ,@(loop for (keys . forms) in clauses + collect + `(,(if (and (symbolp keys) + (or (eq t keys) + (equal "OTHERWISE" (symbol-name keys)))) + 't + `(or ,@(loop for key in (if (listp keys) + keys + (list keys)) + collect + `(ppcre:scan-to-strings ,key ,string)))) + ,@forms))))) + @@ -65,10 +65,6 @@ (funcall func))) -(defmacro with-initialised-journal (&body body) - `(call-with-initialised-journal #'(lambda () ,@body))) - - #+clisp (defun journal-main () (with-initialised-journal diff --git a/mulk-journal.asd b/mulk-journal.asd index 3742d77..ae3b7c5 100644 --- a/mulk-journal.asd +++ b/mulk-journal.asd @@ -27,8 +27,9 @@ #:yaclml #:lisp-cgi-utils #:alexandria #:xml-emitter #:split-sequence) :components ((:file "defpackage") - (:file "utils") + (:file "macros") (:file "globals") + (:file "utils") (:file "journal-content") (:file "journal") (:file "main")) @@ -67,22 +67,6 @@ markup) -(defmacro regex-case (string &body clauses) - (once-only (string) - `(cond ,@(loop for (keys . forms) in clauses - collect - `(,(if (and (symbolp keys) - (or (eq t keys) - (equal "OTHERWISE" (symbol-name keys)))) - 't - `(or ,@(loop for key in (if (listp keys) - keys - (list keys)) - collect - `(ppcre:scan-to-strings ,key ,string)))) - ,@forms))))) - - (defun name-of-day (day-of-week) (case day-of-week (0 "Montag") @@ -204,13 +188,6 @@ ELEMENT-TYPE as the stream's." string))))) -(defmacro with-result-cache ((cache-id &key (younger-than nil younger-than-p)) - &body body) - `(call-with-result-cache ,cache-id - #'(lambda () ,@body) - ,@(and younger-than-p `(:younger-than ,younger-than)))) - - (defun format-date (destination date-control-string universal-time &optional (time-zone nil time-zone-supplied-p)) (with-result-cache ((format nil "date-format-~D-~A-~A" |