120 lines
3.2 KiB
Plaintext
120 lines
3.2 KiB
Plaintext
; 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)))))
|
|
|