From dfc0b924c1cd9ef028f2acf948daaae1107bb573 Mon Sep 17 00:00:00 2001
From: John Fremlin <john@fremlin.org>
Date: Tue, 14 Jan 2014 07:52:24 -0800
Subject: [PATCH] Add ability to execute code in blog entries

---
 src/blog/entry.lisp | 27 ++++++++++++++++++++-------
 src/packages.lisp   |  4 ++++
 2 files changed, 24 insertions(+), 7 deletions(-)

diff --git a/src/blog/entry.lisp b/src/blog/entry.lisp
index 2af0855..c15b0a3 100644
--- a/src/blog/entry.lisp
+++ b/src/blog/entry.lisp
@@ -44,7 +44,7 @@
   (title "Untitled")
   time
   expiry-time
-  paragraphs
+  body-function
   score
   score-update-time)
 
@@ -111,8 +111,7 @@
 
 (my-defun entry story-ml ()
   (<div :class "blog-entry-story"
-        (loop for p in (my paragraphs)
-              do (<p (output-raw-ml p)))))
+        (funcall (my body-function))))
 
 (my-defun entry comments ()
   (datastore-retrieve-indexed 'comment 'entry-index-name (my index-name)))
@@ -193,10 +192,24 @@
      (setf (entry-channel-entry channel) me))))
 
 (my-defun entry read-paragraphs-from-buffer (buffer)
-  (setf (my paragraphs)
-        (split-into-paragraphs
-         (match-replace-all buffer
-                            ("${static-base}"  (byte-vector-cat (blog-static-base-url (my blog)) (my name)))))))
+  (cond ((if-match-bind ((* (space)) "(progn") buffer)
+	 (setf (my body-function) 
+	       (compile (gensym (my name))
+			`(lambda ()
+			   (with-ml-output
+			     ,(let ((*package* (find-package '#:tpd2.blog-user))) (read-from-string (force-string buffer)))
+			     )))
+	       ))
+	 (t
+	  (let ((paragraphs
+		 (split-into-paragraphs
+		  (match-replace-all buffer
+		    ("${static-base}"  (byte-vector-cat (blog-static-base-url (my blog)) (my name)))))))
+	    (setf (my body-function)
+		  (lambda ()
+		    (with-ml-output 
+		      (loop for p in paragraphs
+			    do (<p (output-raw-ml p))))))))))
 
 (defun parse-time (str)
   (match-bind
diff --git a/src/packages.lisp b/src/packages.lisp
index 63ab128..75df8b1 100644
--- a/src/packages.lisp
+++ b/src/packages.lisp
@@ -430,6 +430,10 @@
   (:nicknames #:tpd2.blog)
   (:use #:cl #:tpd2.webapp #:tpd2.ml #:tpd2.ml.html #:tpd2.lib #:tpd2.datastore))
 
+(defpackage #:teepeedee2.blog-user
+  (:nicknames #:tpd2.blog-user)
+  (:use #:cl #:tpd2.webapp #:tpd2.ml #:tpd2.ml.html #:tpd2.lib))
+
 (defpackage #:teepeedee2.survey
   (:nicknames #:tpd2.survey)
   (:use #:cl #:tpd2.webapp #:tpd2.ml #:tpd2.ml.html #:tpd2.lib #:tpd2.datastore))