Permalink
Browse files

Add ability to execute code in blog entries

  • Loading branch information...
1 parent e4f47d8 commit dfc0b924c1cd9ef028f2acf948daaae1107bb573 @vii committed Jan 14, 2014
Showing with 24 additions and 7 deletions.
  1. +20 −7 src/blog/entry.lisp
  2. +4 −0 src/packages.lisp
View
27 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
View
4 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))

0 comments on commit dfc0b92

Please sign in to comment.