helpers.lisp 5.18 KB
Newer Older
Cheshire Yang's avatar
Cheshire Yang committed
1
2
3
;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
(in-package :cl-site)

4

5
(defun make-path (prefix suffix &optional page)
6
7
8
9
10
11
12
13
14
15
  "Constructs a pathname from `prefix` and `suffix`.
  `suffix` can be one of
    1. a context (an alist) with a ':content' element
    2. a pathname
    3. a string identifying a path

  `prefix` can be one of
    1. a pathname
    2. a string identifying a path
  "
16
  (let ((path (if page (cdr (assoc :content suffix)) suffix)))
Cheshire Yang's avatar
Cheshire Yang committed
17
18
19
20
21
22
    (if (pathnamep prefix)
        (merge-pathnames path prefix)
        (pathname (concatenate 'string 
                               prefix path)))))

(defun file-to-string (filepath)
23
24
  "Reads the file designated by pathname `filepath` into memory,
   returning the string with the sequence read from the file"
Cheshire Yang's avatar
Cheshire Yang committed
25
26
27
  (with-open-file (stream filepath)
    (let ((data (make-string (file-length stream))))
      (read-sequence data stream)
28
29
      data)))

Erik Huelsmann's avatar
Erik Huelsmann committed
30
31
32
33
34
35
(defun file-to-list (path)
   (with-open-file (f path :direction :input)
      (loop for line = (read-line f nil)
            while line
            collect line)))

36

37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
(defun header-lines (lines)
   "Returns a list of lines (subset of `lines`)
    which form the header of the document `lines` were read from
   "
   (loop for line in lines
         thereis (when (string= line "---") header-lines)
         collect line into header-lines))

(defun content-lines (lines)
   "Returns a list of lines (subset of `lines`)
    which remain after the header (if any) has been discarded
   "
   (loop with found-header-p = nil
         for line in lines
         when found-header-p
         collect line into post-header-lines
         when (string= line "---")
           do (setf found-header-p t)
         collect line into content-lines
         finally (return (if found-header-p post-header-lines content-lines))))

58
59
60
(defun populate-pages ()
  "Each page is an alist containing info to be sent to the template via the context."
  (mapcar (lambda (p)
61
            (list (cons :content (enough-namestring p *pages-dir*))
62
63
64
65
66
                  (cons :title (file-namestring p))))
	  ;;
	  ;; At this point there could be duplicate, i.e. a .html and a .lisp file. 
	  ;;
	  (append
67
68
69
	   (directory (merge-pathnames #P"**/*.html" *pages-dir*))
	   (directory (merge-pathnames #P"**/*.md" *pages-dir*))
	   (directory (merge-pathnames #P"**/*.lisp" *pages-dir*)))))
70
71


72
73
74
75
76
77
78
79
80
81
82
83
84
85
(defvar *render-hooks* '()
  "A list of hooks wrapping the rendering of the page.")

(defmacro def-render-hook (name (&rest args) &rest body)
   "Registers a hook to wrap the rendering of the page.

    Provides a `call-next-hook` function which dispatches
    execution to the next wrapper and ultimately to the
    page renderer.

    The wrapper should return the value received from
    a `call-next-hook` to its caller as it is the content
    of the rendered page.
    "
86
87
88
89
90
91
92
   (let ((next-hooks-sym (gensym)))
     `(progn
         (defun ,name (,@args ,next-hooks-sym)
            (flet ((call-next-hook (content context)
                      (funcall (pop ,next-hooks-sym) content context ,next-hooks-sym)))
              ,@body))
         (push (function ,name) *render-hooks*))))
93
94
95
96
97
98
99
100
101

(defun render-page-with-hooks (content context)
  (let ((hooks (reverse (cons #'(lambda (p c next-processors)
                                  (process-page p c))
                              *render-hooks*))))
    (funcall (pop hooks) content context hooks)))



102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
(defun page-content (page) (rest (assoc :content page)))


(defun add-content (&key headers-plist html-string)
  (setq *computed-page-content* (list :headers headers-plist :html-string html-string)))

;;
;; FLAG -- the following are from Gendl - remove if/when we start :depending
;; on :gendl or :gwl
;;
(defun plist-keys (plist)
  "List of keyword symbols. Returns the keys from a plist.

:arguments (plist \"Plist\")"
  (when plist
    (cons (first plist)
          (plist-keys (rest (rest plist))))))

(defun plist-values (plist)
  "List of Lisp objects. Returns the values from a plist.

:arguments (plist \"Plist\")"
  (when plist
    (cons (second plist)
          (plist-values (rest (rest plist))))))

Erik Huelsmann's avatar
Erik Huelsmann committed
128
129
130
131
132
(defun alist-from-hash (hash)
   (loop for k being each hash-key of hash
               using (hash-value v)
     collect (cons k v)))

133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
(defmacro with-cl-who-string ((&rest args) &body body)

    "Form. Sets up body to be evaluated with cl-who:with-html-output and  return the resulting string instead
of writing to a stream."

    (let ((ss (gensym)))
      `(with-output-to-string (,ss)
	 (cl-who:with-html-output (,ss nil ,@args) ,@body))))


(defmacro wmd (string)
  "Form suitable for inclusion in cl-who LHTML context. Returns an
  `str` form after passing it through cl-markdown's markdown processor.
"
  ;;
  ;; FLAG -- should we be checking for loaded markdown package at compile-time instead? 
  ;;
  `(cl-who:str (cond ((find-package :markdown.cl)
		      (funcall (read-from-string "markdown.cl:parse") ,string))
		     ((find-package :cl-markdown)
		      (with-output-to-string (ss)
			(funcall (read-from-string "cl-markdown:markdown") ,string :stream ss))))))

;;
;; End of Gendl utilities. 
;;