summaryrefslogtreecommitdiff
path: root/macros.lisp
blob: b319c98ec1f0ba3cb6408cc6311769e246988c9f (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
;;;; -*- 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 "<?xml version='1.0' encoding='utf-8'?>")
    (emit-princ (format nil "~%"))
    (emit-princ "<!DOCTYPE html>")
    (emit-princ (format nil "~%")))
  (emit-open-tag "html" #+clisp `(("dir" . ,dir)
                                  ("lang" . ,lang)
                                  ("xml:lang" . ,lang)
                                  ("xmlns" . ,xmlns))
                        #-clisp `("dir" ,dir
                                  "lang" ,lang
                                  "xml:lang" ,lang
                                  "xmlns" ,xmlns))
  (emit-body body)
  (emit-close-tag "html"))


(defmacro with-web-journal ((page-title &key canonical-uri) &body body)
  `(call-with-web-journal ,page-title #'(lambda () ,@body) :canonical-uri ,canonical-uri))


(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)))))