helpers.lisp 5.17 KB
Newer Older
Cherie Yang's avatar
Cherie 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)))
Cherie Yang's avatar
Cherie 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"
Cherie Yang's avatar
Cherie Yang committed
25 26 27
  (with-open-file (stream filepath)
    (let ((data (make-string (file-length stream))))
      (read-sequence data stream)
28 29
      data)))

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
   (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))
92
         (pushnew ',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))))))

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. 
;;