diff --git a/_web_server/server/index.html b/_web_server/server/index.html index 9848d7e..0b7781d 100644 --- a/_web_server/server/index.html +++ b/_web_server/server/index.html @@ -94,7 +94,8 @@
- + + Sim: @@ -136,8 +137,8 @@ .then((text) => { log_area.innerHTML = text; }); }; - function save_code() { - fetch('%SAVECODEURI%', + function save_code(uri) { + fetch(uri, { method: 'POST', headers: { diff --git a/_web_server/server/playground-server.scm b/_web_server/server/playground-server.scm index 8d8da6d..36bf7ec 100755 --- a/_web_server/server/playground-server.scm +++ b/_web_server/server/playground-server.scm @@ -41,6 +41,7 @@ (define URI-IVERILOG "iverilog") (define URI-SAVE-CODE "save") +(define URI-SAVEAS-CODE "saveas") (define LOG-DBG 3) (define LOG-VERBOSE 2) @@ -393,10 +394,13 @@ (root (encode-and-join-uri-path root-path)) (iverilog-path (append root-path `(,URI-IVERILOG))) (savecode-path (append root-path `(,URI-SAVE-CODE))) + (saveas-path (append root-path `(,URI-SAVEAS-CODE))) (iverilog-post-uri (encode-and-join-uri-path iverilog-path)) (savecode-post-uri (encode-and-join-uri-path savecode-path)) + (saveas-post-uri (encode-and-join-uri-path saveas-path)) (index-html (read-template-text index-file `(("IVERILOGPOSTURI" ,iverilog-post-uri) - ("SAVECODEURI" ,savecode-post-uri))))) + ("SAVECODEURI" ,savecode-post-uri) + ("SAVEASURI" ,saveas-post-uri))))) (lambda (request request-body) (let (;; Requested resource path @@ -484,21 +488,26 @@ #:type 'text/plain)) ;; Save snippet - ((equal? path savecode-path) - (logger LOG-DBG "Request code saving") - (let ((stor-dir - (or ref-stor-dir - (basename - (mkdtemp - (path+ - stor-base - (format "~a-XXXXXX" - (current-time)))))))) - (save-to-storage (path+ stor-base stor-dir) code) - (make-response - (encode-and-join-uri-path - (append root-path `(,stor-dir))) - #:type 'text/plain))) + ((or (equal? path savecode-path) + (equal? path saveas-path)) + (let ((saveas (equal? path saveas-path))) + (logger LOG-DBG "Request code saving~a" + (if saveas " as new snippet" "")) + (let ((stor-dir + (if (or saveas + (not ref-stor-dir)) + (basename + (mkdtemp + (path+ + stor-base + (format "~a-XXXXXX" + (current-time))))) + ref-stor-dir))) + (save-to-storage (path+ stor-base stor-dir) code) + (make-response + (encode-and-join-uri-path + (append root-path `(,stor-dir))) + #:type 'text/plain)))) ;; Wrong POST request (else