picolisp

Unnamed repository; edit this file to name it for gitweb.
git clone https://logand.com/git/picolisp.git/
Log | Files | Refs | README | LICENSE

commit aeaec52fcc4b64c247d36f8aa2b2078a4cd7def9
parent bfc7eb1fda15c275f1bdc4be208b110497fca651
Author: Alexander Burger <abu@software-lab.de>
Date:   Fri,  6 May 2011 08:54:46 +0200

Changed '@' to '!' for functions in URLs
Diffstat:
MCHANGES | 1+
MReleaseNotes | 6+++++-
Mapp/gui.l | 8++++----
Mapp/main.l | 8++++----
Mbin/psh | 4++--
Mbin/replica | 6+++---
Mdoc/app.html | 12++++++------
Mdoc/family.l | 10+++++-----
Mdoc/refA.html | 18+++++++++---------
Mdoc/tut.html | 4++--
Mlib/form.js | 6+++---
Mlib/form.l | 4++--
Mlib/http.l | 4++--
Mmisc/calc.l | 6+++---
Mmisc/dirTree.l | 8++++----
15 files changed, 55 insertions(+), 50 deletions(-)

diff --git a/CHANGES b/CHANGES @@ -1,4 +1,5 @@ * XXjun11 picoLisp-3.0.7 + Changed '@' to '!' for functions in URLs 64-bit version for PowerPC (ppc64) Local 'pil' startup script Bug in 'replace' (64-bit) diff --git a/ReleaseNotes b/ReleaseNotes @@ -1,4 +1,4 @@ -27apr11abu +06may11abu (c) Software Lab. Alexander Burger @@ -23,3 +23,7 @@ 3. An implementation of the 64-bit version for PowerPC (ppc64). Code generation could probably be further optimized, and there may be bugs. But self-assembly works, and the unit tests pass. + +4. Changed the meta-character for function calls in URLs from '@' to '!' This + was necessary, because '@' may conflict with home directory specifiers in + path names. diff --git a/app/gui.l b/app/gui.l @@ -1,4 +1,4 @@ -# 28feb11abu +# 06may11abu # (c) Software Lab. Alexander Burger ### GUI ### @@ -8,8 +8,8 @@ (<div> '(id . menu) (expires) (<menu> - (,"Home" "@start") - (,"logout" (and *Login "@stop")) + (,"Home" "!start") + (,"logout" (and *Login "!stop")) (NIL (<hr>)) (T ,"Data" (,"Orders" (and (may Order) "app/ord.l")) @@ -25,7 +25,7 @@ (<div> '(id . main) (run Prg 1)) ) ) ) (de start () - (setq *Url "@start") + (setq *Url "!start") (and (app) (setq *Menu 3)) (menu "PicoLisp App" (<h2> NIL "PicoLisp App") diff --git a/app/main.l b/app/main.l @@ -1,14 +1,14 @@ -# 25apr11abu +# 06may11abu # (c) Software Lab. Alexander Burger (allowed ("app/" "@img/") - "@start" "@stop" "favicon.ico" "lib.css" "@psh" ) + "!start" "!stop" "favicon.ico" "@lib.css" "!psh" ) (load "@lib/http.l" "@lib/xhtml.l" "@lib/form.l" "@lib/ps.l" "@lib/adm.l") (setq *Scl 2 - *Css "lib.css" + *Css "@lib.css" *Blob "blob/app/" ) (load "app/er.l" "app/lib.l" "app/gui.l") @@ -57,6 +57,6 @@ (close Sock) ) ) (forked) (rollback) - (server 8080 "@start") ) + (server 8080 "!start") ) # vi:et:ts=3:sw=3 diff --git a/bin/psh b/bin/psh @@ -1,5 +1,5 @@ #!bin/picolisp lib.l -# 28sep07abu +# 06may11abu # (c) Software Lab. Alexander Burger (load "@lib/misc.l" "@lib/http.l") @@ -7,7 +7,7 @@ (raw T) (let *Dbg NIL (client "localhost" (format (opt)) - (pack "@psh?" (pw) "&" (in '("tty") (line T))) + (pack "!psh?" (pw) "&" (in '("tty") (line T))) (ctty (read)) (line) (line) ) ) diff --git a/bin/replica b/bin/replica @@ -1,11 +1,11 @@ #!bin/picolisp lib.l -# 21aug07abu +# 06may11abu # Use: bin/replica <port> <keyFile> <journal> <dbFile> <blob/app/> [dbs1 ..] -# : bin/ssl <host> 443 <port>/@replica <keyFile> <journal> <blob/app/> 60 +# : bin/ssl <host> 443 '<port>/!replica' <keyFile> <journal> <blob/app/> 60 (load "@lib/misc.l" "@lib/http.l") -(allowed NIL "@replica") +(allowed NIL "!replica") (argv *Port *KeyFile *Journal *Pool *Blob . *Dbs) diff --git a/doc/app.html b/doc/app.html @@ -204,9 +204,9 @@ are stripped off - is interpreted according so some rules. The most prominent ones are: <p><ul> -<li>If a path starts with an at-mark ('@'), the rest (without the '@') is taken -as the name of a Lisp function to be called. All arguments following the -question mark are passed to that function. +<li>If a path starts with an exclamation-mark ('!'), the rest (without the '!') +is taken as the name of a Lisp function to be called. All arguments following +the question mark are passed to that function. <li>If a path ends with ".l" (a dot and a lower case 'L'), it is taken as a Lisp source file name to be <code><a href="refL.html#load">(load)</a></code>ed. This @@ -264,7 +264,7 @@ href="refA.html#allow">allow</a></code> functions <pre><code> (allowed ("img/") "favicon.ico" "lib.css" - "@start" "customer.l" "article.l") + "!start" "customer.l" "article.l") </code></pre> <p>This is usually called in the beginning of an application, and allows access @@ -275,7 +275,7 @@ to the directory "img/", to the function 'start', and to the files <code>allow</code> <pre><code> -(allow "@foo") +(allow "!foo") (allow "newdir/" T) </code></pre> @@ -1122,7 +1122,7 @@ needed once the calculator is running. recommended by the <a href="#security">Security</a> chapter) <pre><code> -(allowed NIL "@calculator" "favicon.ico" "lib.css") +(allowed NIL "!calculator" "favicon.ico" "lib.css") </code></pre> <p>at the beginning of "misc/calc.l". This will restrict external access to that diff --git a/doc/family.l b/doc/family.l @@ -1,4 +1,4 @@ -# 25apr11abu +# 06may11abu # (c) Software Lab. Alexander Burger (load "@lib/http.l" "@lib/xhtml.l" "@lib/form.l" "@lib/ps.l") @@ -15,7 +15,7 @@ (rel txt (+String)) # Info (dm url> (Tab) - (list "@person" '*ID This) ) + (list "!person" '*ID This) ) (class +Man +Person) @@ -128,9 +128,9 @@ (----) (gui '(+E/R +TextField) '(txt : home obj) 40 4) (gui '(+Rid +Button) "Contemporaries" - '(url "@contemporaries" (: home obj)) ) + '(url "!contemporaries" (: home obj)) ) (gui '(+Rid +Button) "Tree View" - '(url "@treeReport" (: home obj)) ) + '(url "!treeReport" (: home obj)) ) (editButton T) ) ) ) ) @@ -237,6 +237,6 @@ (de go () (rollback) - (server 8080 "@person") ) + (server 8080 "!person") ) # vi:et:ts=3:sw=3 diff --git a/doc/refA.html b/doc/refA.html @@ -49,18 +49,18 @@ href="refP.html#pre?">pre?</a></code>. <pre><code> : (allowed ("app/" "img/") # Initialize - "@start" "@stop" "favicon.ico" "lib.css" "@psh" ) + "!start" "!stop" "favicon.ico" "lib.css" "!psh" ) -> NIL -: (allow "@myFoo") # additional item --> "@myFoo" +: (allow "!myFoo") # additional item +-> "!myFoo" : (allow "myDir/" T) # additional prefix -> "myDir/" : *Allow --> (("@stop" ("@psh" ("@myFoo") "@start") "favicon.ico" NIL "lib.css") "app/" "img/" "myDir/") +-> (("!stop" ("!psh" ("!myFoo") "!start") "favicon.ico" NIL "lib.css") "app/" "img/" "myDir/") : (idx *Allow) # items --> ("@myFoo" "@psh" "@start" "@stop" "favicon.ico" "lib.css") +-> ("!myFoo" "!psh" "!start" "!stop" "favicon.ico" "lib.css") : (cdr *Allow) # prefixes -> ("app/" "img/" "myDir/") </code></pre> @@ -241,9 +241,9 @@ href="refA.html#allowed">allowed</a></code>. <pre><code> : *Allow --> (("@stop" ("@psh" NIL "@start") "favicon.ico" NIL "lib.css") "app/" "img/") -: (allow "@myFoo") # additionally allowed item --> "@myFoo" +-> (("!stop" ("!psh" NIL "!start") "favicon.ico" NIL "lib.css") "app/" "img/") +: (allow "!myFoo") # additionally allowed item +-> "!myFoo" : (allow "myDir/" T) # additionally allowed prefix -> "myDir/" </code></pre> @@ -258,7 +258,7 @@ href="refA.html#allow">allow</a></code>. <pre><code> : (allowed ("app/" "img/") # allowed prefixes - "@start" "@stop" "favicon.ico" "lib.css" "@psh" ) # allowed items + "!start" "!stop" "favicon.ico" "lib.css" "!psh" ) # allowed items -> NIL </code></pre> diff --git a/doc/tut.html b/doc/tut.html @@ -1906,7 +1906,7 @@ first of March in the year zero. <pre><code> (dm url> () - (list "@person" '*ID This) ) + (list "!person" '*ID This) ) </code></pre> <p>It is needed later in the GUI, to cause a click on a link to switch to that @@ -2069,7 +2069,7 @@ $ pil @doc/family.l -main -go + <pre><code> (de go () - (server 8080 "@person") ) + (server 8080 "!person") ) </code></pre> <p>It starts the HTTP server listening on TCP port 8080 (we did a similar thing diff --git a/lib/form.js b/lib/form.js @@ -1,4 +1,4 @@ -/* 09dec10abu +/* 06may11abu * (c) Software Lab. Alexander Burger */ @@ -81,7 +81,7 @@ function post(form, file) { } form.style.cursor = "wait"; url = form.action.split("~"); - try {FormReq.open("POST", url[0] + "~@jsForm?" + url[1]);} + try {FormReq.open("POST", url[0] + "~!jsForm?" + url[1]);} catch (e) {return true;} FormReq.onreadystatechange = function() { @@ -285,7 +285,7 @@ function doHint(field) { if ((i = field.id.lastIndexOf("-")) < 0) return true; url = field.form.action.split("~"); - try {HintReq.open("POST", url[0] + "~@jsHint?" + field.id.substr(i+1));} + try {HintReq.open("POST", url[0] + "~!jsHint?" + field.id.substr(i+1));} catch (e) {return true;} HintReq.onreadystatechange = function() { if (HintReq.readyState == 4 && HintReq.status == 200) { diff --git a/lib/form.l b/lib/form.l @@ -1,4 +1,4 @@ -# 01may11abu +# 06may11abu # (c) Software Lab. Alexander Burger # *PRG *Top *Gui *Btn *Get *Got *Form *Evt *Lock *Spans @@ -6,7 +6,7 @@ (allow (path "@img/") T) (push1 '*JS (allow (path "@lib/form.js"))) -(mapc allow '(*Gui *Get *Got *Form *Evt *Drop "@jsForm" "@jsHint")) +(mapc allow '(*Gui *Get *Got *Form *Evt *Drop "!jsForm" "!jsHint")) (one "*Cnt") (off "*Lst" "*Post2" "*Cho") diff --git a/lib/http.l b/lib/http.l @@ -1,4 +1,4 @@ -# 28jan11abu +# 06may11abu # (c) Software Lab. Alexander Burger # *Home *Gate *Host *Port *Port1 *Port% *Http1 *Chunked @@ -209,7 +209,7 @@ ((match '("-" @X "." "h" "t" "m" "l") @U) (and *SesId (timeout *Timeout)) (try 'html> (extern (ht:Pack @X))) ) - ((= '@ (car @U)) + ((= '! (car @U)) (if (disallowed) (prog (notAllowed *Url) (http404)) (and *SesId (timeout *Timeout)) diff --git a/misc/calc.l b/misc/calc.l @@ -1,9 +1,9 @@ -# 17apr08abu +# 06may11abu # (c) Software Lab. Alexander Burger # *Init *Accu *Stack -(allowed NIL "@calculator" "favicon.ico" "lib.css") +(allowed NIL "!calculator" "favicon.ico" "lib.css") (load "lib/http.l" "lib/xhtml.l" "lib/form.l") # Calculator logic @@ -70,4 +70,4 @@ # Start server (de go () - (server 8080 "@calculator") ) + (server 8080 "!calculator") ) diff --git a/misc/dirTree.l b/misc/dirTree.l @@ -1,7 +1,7 @@ -# 10jul08abu +# 06may11abu # (c) Software Lab. Alexander Burger -(load "lib/http.l" "lib/xhtml.l") +(load "@lib/http.l" "@lib/xhtml.l") (de subDirs (Dir) (cache '*DirCache (or (pack (flip (chop Dir))) ".") @@ -14,6 +14,6 @@ (de dir.html (Path) (and (app) (setq *DirTree (subDirs))) (html NIL "Test" NIL NIL - (<tree> "@dir.html" Path *DirTree subDirs nil subDirs) ) ) + (<tree> "!dir.html" Path *DirTree subDirs nil subDirs) ) ) -(server 8080 "@dir.html") +(server 8080 "!dir.html")