; 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)))))