lib: remove cruft

lib/blog.arc

@@ -1,95 +0,0 @@
-; Blog tool example.  20 Jan 08, rev 21 May 09.
-
-; To run:
-; arc> (load "blog.arc")
-; arc> (bsv)
-; go to http://localhost:8080/blog
-
-(= postdir* "arc/posts/"  maxid* 0  posts* (table))
-
-(= blogtitle* "A Blog")
-
-(deftem post  id nil  title nil  text nil)
-
-(def load-posts ()
-  (each id (map int (dir postdir*))
-    (= maxid*      (max maxid* id)
-       (posts* id) (temload 'post (string postdir* id)))))
-
-(def save-post (p) (save-table p (string postdir* p!id)))
-
-(def post (id) (posts* (errsafe:int id)))
-
-(mac blogpage body
-  `(whitepage 
-     (center
-       (widtable 600 
-         (tag b (link blogtitle* "blog"))
-         (br 3)
-         ,@body
-         (br 3)
-         (w/bars (link "archive")
-                 (link "new post" "newpost"))))))
-
-(defop viewpost req (blogop post-page req))
-
-(def blogop (f req)
-  (aif (post (arg req "id")) 
-       (f (get-user req) it) 
-       (blogpage (pr "No such post."))))
-
-(def permalink (p) (string "viewpost?id=" p!id))
-
-(def post-page (user p) (blogpage (display-post user p)))
-
-(def display-post (user p)
-  (tag b (link p!title (permalink p)))
-  (when user
-    (sp)
-    (link "[edit]" (string "editpost?id=" p!id)))
-  (br2)
-  (pr p!text))
-
-(defopl newpost req
-  (whitepage
-    (aform [let u (get-user _)
-             (post-page u (addpost u (arg _ "t") (arg _ "b")))]
-      (tab (row "title" (input "t" "" 60))
-           (row "text"  (textarea "b" 10 80))
-           (row ""      (submit))))))
-
-(def addpost (user title text)
-  (let p (inst 'post 'id (++ maxid*) 'title title 'text text)
-    (save-post p)
-    (= (posts* p!id) p)))
-
-(defopl editpost req (blogop edit-page req))
-
-(def edit-page (user p)
-  (whitepage
-    (vars-form user
-               `((string title ,p!title t t) (text text ,p!text t t))
-               (fn (name val) (= (p name) val))
-               (fn () (save-post p)
-                      (post-page user p)))))
-
-(defop archive req
-  (blogpage
-    (tag ul
-      (each p (map post (rev (range 1 maxid*)))
-        (tag li (link p!title (permalink p)))))))
-
-(defop blog req
-  (let user (get-user req)
-    (blogpage
-      (for i 0 4
-        (awhen (posts* (- maxid* i)) 
-          (display-post user it)
-          (br 3))))))
-
-(def bsv ()
-  (ensure-dir postdir*)
-  (load-posts)
-  (asv))
-
-

lib/prompt.arc

@@ -1,119 +0,0 @@
-; Prompt: Web-based programming application.  4 Aug 06.
-
-(= appdir* "arc/apps/")
-
-(defop prompt req 
-  (let user (get-user req)
-    (if (admin user)
-        (prompt-page user)
-        (pr "Sorry."))))
-
-(def prompt-page (user . msg)
-  (ensure-dir appdir*)
-  (ensure-dir (string appdir* user))
-  (whitepage
-    (prbold "Prompt")
-    (hspace 20)
-    (pr user " | ")
-    (link "logout")
-    (when msg (hspace 10) (apply pr msg))
-    (br2)
-    (tag (table border 0 cellspacing 10)
-      (each app (dir (+ appdir* user))
-        (tr (td app)
-            (td (ulink user 'edit   (edit-app user app)))
-            (td (ulink user 'run    (run-app  user app)))
-            (td (hspace 40)
-                (ulink user 'delete (rem-app  user app))))))
-    (br2)
-    (aform (fn (req)
-             (when-umatch user req
-               (aif (goodname (arg req "app"))
-                    (edit-app user it)
-                    (prompt-page user "Bad name."))))
-       (tab (row "name:" (input "app") (submit "create app"))))))
-
-(def app-path (user app) 
-  (and user app (+ appdir* user "/" app)))
-
-(def read-app (user app)
-  (aand (app-path user app) 
-        (file-exists it)
-        (readfile it)))
-
-(def write-app (user app exprs)
-  (awhen (app-path user app)
-    (w/outfile o it 
-      (each e exprs (write e o)))))
-
-(def rem-app (user app)
-  (let file (app-path user app)
-    (if (file-exists file)
-        (do (rmfile (app-path user app))
-            (prompt-page user "Program " app " deleted."))
-        (prompt-page user "No such app."))))
-
-(def edit-app (user app)
-  (whitepage
-    (pr "user: " user " app: " app)
-    (br2)
-    (aform (fn (req)
-             (let u2 (get-user req)
-               (if (is u2 user)
-                   (do (when (is (arg req "cmd") "save")
-                         (write-app user app (readall (arg req "exprs"))))
-                       (prompt-page user))
-                   (login-page 'both nil
-                               (fn (u ip) (prompt-page u))))))
-      (textarea "exprs" 10 82
-        (pprcode (read-app user app)))
-      (br2)
-      (buts 'cmd "save" "cancel"))))
-
-(def pprcode (exprs) 
-  (each e exprs
-    (ppr e) 
-    (pr "\n\n")))
-
-(def view-app (user app)
-  (whitepage
-    (pr "user: " user " app: " app)
-    (br2)
-    (tag xmp (pprcode (read-app user app)))))
-
-(def run-app (user app)
-  (let exprs (read-app user app)
-    (if exprs 
-        (on-err (fn (c) (pr "Error: " (details c)))
-          (fn () (map eval exprs)))
-        (prompt-page user "Error: No application " app " for user " user))))
-
-(wipe repl-history*)
-
-(defop repl req
-  (if (admin (get-user req))
-      (replpage req)
-      (pr "Sorry.")))
-
-(def replpage (req)
-  (whitepage
-    (repl (readall (or (arg req "expr") "")) "repl")))
-
-(def repl (exprs url)
-    (each expr exprs 
-      (on-err (fn (c) (push (list expr c t) repl-history*))
-              (fn () 
-                (= that (eval expr) thatexpr expr)
-                (push (list expr that) repl-history*))))
-    (form url
-      (textarea "expr" 8 60)
-      (sp) 
-      (submit))
-    (tag xmp
-      (each (expr val err) (firstn 20 repl-history*)
-        (pr "> ")
-        (ppr expr)
-        (prn)
-        (prn (if err "Error: " "")
-             (ellipsize (tostring (write val)) 800)))))
-