A hacky piece from my static site generator

new-posts.lisp

(defun read-new-post (filename)
  (flet ((parse-date (date-string)
           (local-time:parse-timestring (match-substring "Date: (.*)" date-string) :date-time-separator #\Space))
         (basename (path)
           (match-substring "([^/]*)$" path)))

    (let* ((post-data (plump:parse (read-file-into-string filename))))
      (make-instance 'blog-post
                     :filename (namestring filename)
                     :title (plump:text (clss/select-1 "title" post-data))
                     :publication-date (parse-date (plump:text (clss/select-1 "#postamble .date" post-data)))
                     :name (strip-extension (basename (namestring filename)))
                     :tags (explode-and-clean-up #\, (plump:attribute (clss/select-1 "meta[name='keywords']" post-data)
                                                                      "content"))
                     :categories '()
                     :original-url nil
                     :excerpt (plump:attribute (clss/select-1 "meta[name='description']" post-data)
                                               "content")
                     :contents (clss/select-1 "#content" post-data)
                     :content-formatting :org-export))))



(defun blog-internal-url-p (url)
  "Determines if the `URL' points to an internal resource of this site."
  ;; NOTE might be more cases?
  (not (cl-ppcre:scan "(http.?|ftp)://" url)))

(defun rewrite-blog-internal-url (url)
  "Ensure the internal `URL' is in a proper, relative format."
  ;; Update relative path - <base ...> of the site points to site's top level, while
  ;; internal links in blog post sources will be relative to blog/ directory.
  (if (starts-with-subseq "../" url)
      (subseq url 3)
      (concatenate 'string "blog/" url)))



(defun post-process-new-posts (posts)
  (loop for post in posts
     do (progn
          (log:trace "Post-processing new post." (post-filename post))
          (setf (post-contents post)
                (new-post/post-process-post-contents post)))))

(defun new-post/post-process-post-contents (post)
  (let* ((tree (post-contents post)))

    (parse-tree/delete-spurious-headline tree)
    (parse-tree/fix-examples tree)
    (parse-tree/colorize-inline-source-blocks tree)
    (parse-tree/colorize-source-blocks tree)
    (parse-tree/rewrite-internal-urls tree)

    (with-output-to-string (str)
      (plump:serialize tree str))))

(defun parse-tree/delete-spurious-headline (tree)
  (plump:remove-child (clss/select-1 "h1.title" tree)))

(defun parse-tree/colorize-source-blocks (tree)
  (flet ((fix-up-code-block (code-block)
           ;; in: <pre class="src src-[lang]" id="stuff">...</pre>
           ;; out: <pre id="stuff"><code lang="[Lang]">...</code></pre>
           (let* ((org-language (match-substring "src-([a-zA-Z-]+)" (plump:attribute code-block "class")))
                  (language (org-code-lang->colorize-lang org-language))
                  (code (plump:text code-block))
                  (colorized (if language
                                 (colorize-code language code)
                                 code)))
             (plump:clear code-block)
             (let ((new-child (plump:make-element code-block
                                                  "code"
                                                  :children (plump:children (plump:parse colorized)))))
               (setf (plump:attribute new-child "lang") (string-capitalize org-language)))
             (plump:remove-attribute code-block "class") ;FIXME don't remove ALL classes - we might need some for e.g. full-sized blocks!
             code-block)))
    (let ((source-blocks (clss:select "pre.src" tree)))
      (loop for src-block across source-blocks
         do (fix-up-code-block src-block)))))
         
;; (... lots more of this ... )