/examples/ajax-browse-freebase.lisp

 1(in-package :wu)
 2
 3(publish :path "/fb-browse" 
 4	 :content-type "text/html"
 5	 :function 'fb-browse-page)
 6
 7(setq *default-no-session?* t)
 8
 9(defun render-frame (f)
10  (html
11   ((:div :id (mt:fast-string f) :style "border:1px solid gray")
12    ((:span :style "background:gray;")
13     (:b (:princ-safe (frame-human-name f))))
14    :br
15    ((:div )
16     (:table
17      (dolist (slot (list-limit (frame-slots f))) 100))
18     (html
19      (:tr
20       (:td
21	(:princ-safe (frame-human-name (car slot))))
22       (:td
23	(dolist (val (list-limit
24		      (cdr slot)
25		      6))
26	  (html (render-value val)
27		:br)))))))))
28
29(def-cached-function frame-slots (f)
30  (mql-all-properties f :get-frames? t))
31
32(defun frame-slot-value (f slot)
33  (assocdr slot (frame-slots f)))
34
35(defun frame-human-name (f)
36  (frame-slot-value f :name))
37
38(defun framep (thing)
39  (or (keywordp thing)
40      (and (stringp thing)
41	   (char= (char thing 0) #\/))))
42
43(defmethod render-value  ((thing t))
44  (if (framep thing)
45      (render-value thing)
46      (html (:princ-safe thing))))
47
48(defmethod render-value ((f ocelot-gfp::frame))
49  (let ((id (string (gensym "id"))))
50    (html
51     ((:span :id id)
52      (link-to-remote (frame-human-name f)
53		      (ajax-continuation ()
54			(render-update
55			  (:replace id
56				    (render-frame f)))))))))
57
58(defun list-limit (l n)
59  (subseq l 0 (min n (length l))))
60
61(defun dbrowse-page (req ent)
62  (with-http-response-and-body (req ent)
63    (html (:head
64	   (javascript-includes "prototype.js" "effects.js" "dragdrop.js")
65	   )
66	  (:body
67	   (:h1 "Dbrowse")
68	   (render-frame "/en/marvin_minsky")))))