Add arc3.1 and arcfn docs.

Author: dram

_ref/README

@@ -0,0 +1,29 @@
+This directory generates the Arc documentation published at
+http://arcdoc.eval.to/
+
+To generate the documentation after making changes to the .tem
+template files, run:
+
+$ ./generate.sh
+
+The resulting output will appear in the output/ directory.  You can
+open the output/index.html file directly in your web browser; you
+don't need to be running a web server.
+
+When you're happy with your changes commit them to Anarki.  We'll put
+together some system to automatically publish commits to Anarki to
+arcdoc.eval.to; in the meantime, ping <andrew.wilcox@gmail.com> to
+push the button.
+
+NOTE: I (Andrew) couldn't figure out how to run Anarki from the
+arcfn-docs directory, so I used the hackinator instead.  *You don't
+have to do this*.  Just fix generate.sh to use Anarki instead if you
+want.
+
+How the automatic process will work:  It will
+ - pull the latest code from Anarki
+ - run generate.sh
+ - copy the contents of output/ to arcdoc.eval.to
+
+This Arc documentation was originally written by Ken Shirriff
+<kens@arcfn.com>, and is now community supported in Anarki.

_ref/anaphoric.tem

@@ -0,0 +1,15 @@
+(page "Anaphoric operations"
+(text "Anaphoric operations provide a mechanism to refer back to themselves.
+This can be useful when an expression needs to be used later, as in <code>aif</code>, <code>awhen</code>, or <code>aand</code>.  Anaphoric functions allow a function to refer back to itself recursively, without creating a named function.
+
+<p>See <a href='http://www.bookshelf.jp/texi/onlisp/onlisp_15.html'>On Lisp Chapter 14</a> for a detailed explanation of anaphoric operations.")
+(newtable "Anaphoric operations"
+(mac aif "expr body [expr body] ..." "Anaphoric <code>if</code>: each <code>expr</code> is evaluated until one is true, and then the corresponding <code>body</code> is executed.  Within the body, the anaphoric variable <code>it</code> refers back to the value of <code>expr</code>." (tests (aif (> 1 2) (+ it 1) 42 (+ it 2))(aif nil (+ it 1))))
+(mac awhen "expr [body ...]" "Anaphoric <code>when</code>: if the <code>expr</code> is true, the <code>body</code> is executed.  Within the body, the variable <code>it</code> refers back to the value of <code>expr</code>." (tests (awhen (* 2 3) (+ it 1))))
+(mac aand "[arg ...]" "Anaphoric <code>and</code>.  Returns the last argument if all arguments are true, otherwise returns <code>nil</code>.  Inside each argument the anaphoric variable <code>it</code> refers to the value of the previous argument.  Like <code>and</code>, lazy evaluation is used, so evaluation stops after encountering a false argument."
+(tests (aand 1 (+ it 2) (* it 10))))
+(mac afn "parms [body ...]" "Creates an anaphoric function, which can be called recursively with the name <code>self</code>.  This allows a recursive function to be created without assigning it a name." (tests ((afn (x) (if (is x 0) 1 (* 2 (self (- x 1))))) 5)))
+(mac rfn "name parms [body ...]" "Creates a function with the given <code>name</code>.  The name is only inside the scope of the <code>rfn</code> macro.  This allows recursive functions to be created without polluting the wider scope." (tests ((rfn pow2 (x) (if (is x 0) 1 (* 2 (pow2 (- x 1))))) 5)))
+(def trav "obj [function ...]" "Recursive traversal.  Applies each <code>function</code> in sequence to <code>obj</code>, if <code>obj</code> is not <code>nil</code>.  The function can recursively call itself with a new <code>obj</code> with <code>(self obj)</code>." (tests  (trav '(1 2 3 4) [prn _] [self (cdr _)])))
+)
+)

_ref/app.tem

@@ -0,0 +1,164 @@
+(page "App server"
+(import "docs/app0.html")
+(newtable "App server"
+(def asv "[port]" "Starts the application server." (faketest "(asv 8080)" ""))
+)
+
+(newtable "User management"
+
+
+(def get-user "req" "Gets the user id string associated with <code>req</code>.  Returns <code>nil</code> if no associated user." (faketest "(get-user req)" "foo" ""))
+
+(def predicate admin "user" "Tests if <code>user</code> is an administrator; i.e. is in <code>admins*</code>." (tests (admin "foo")))
+
+(def predicate goodname "str [min [max]]" "Tests that <code>str</code> is of the appropriate length and contains no bad characters." (tests (goodname "abc") (goodname "ab!")))
+
+(def logout-user "user" "Logs out <code>user</code>.  The user's entry is removed from <code>logins*</code>, <code>cookie->user*</code>, <code>user->cookie*</code>, and the updated <code>cookie->user*</code> is written to <code>cookfile*</code>." (tests (logout-user "foo")))
+
+(def set-pw "user pw" "Creates (or updates) account with the name <code>user</code> and password <code>pw</code>.  Saves <code>hpasswords*</code> in <code>hpwfile*</code>." (faketest "(set-pw \"foo\" \"bar\")" ""))
+
+(mac defopl "name parm [body]" "Version of <code>defop</code> to create handler that will redirect to login page if the user is not logged in." (faketest "(defopl foo req (prn \"Welcome!\"))" ""))
+
+(mac uform "user req after [body ...]" "Generates form that ensures it was submitted by <code>user</code> (by using <code>when-umatch</code>).  <code>body</code> outputs the form body to stdout.  After submission, the continuation code <code>after</code> is executed; <code>req</code> specifies the varible name in <code>after</code> to receive the request."
+(faketest "(uform user req (prn \"Result\") (prn \"The form\") (submit))" ""))
+
+(mac urform "user req after [body ...]" "Generates form with redirection target with guard that <code>user</code> submitted it.  After submission, the continuation expression <code>after</code> is executed and must return the redirect string; <code>req</code> specifies the varible name in <code>after</code> to receive the request." (faketest "(urform user req \"newpage\" (prn \"Form\") (submit))" ""))
+
+(mac when-umatch "user req [body...]" "If <code>user</code> matches the user associated with <code>req</code>, executes <code>body</code>.  Otherwise executes <code>mismatch-message</code>."
+(faketest "(defopl ul req (let user (get-user req)
+  (when-umatch user req (prn \"You are \" user))))" ""))
+
+(mac when-umatch/r "user req [body ...]" "Test <code>user</code> for use with redirect.  If <code>user</code> is the user associated with <code>req</code>, executes body.  Otherwise returns \"mismatch\", to redirect to the mismatch page."
+    (faketest "(when-umatch/r user req (logout-user user) \"example\")" ""))
+
+(mac ulink "user text [body ...]" "Outputs a HTML link with <code>text</code>.  When clicked, the link will execute <code>body</code> if the user matches <code>user</code>.  Similar to <code>onlink</code>, but with the user guard.  Renamed from userlink in arc3."
+  (faketest "(userlink user \"click here\" (prn \"Thanks for clicking\"))" "")
+)
+
+
+
+
+(def admin-page "user [msg]" "Generates the administrator page. This page allows new accounts to be created.  The current admin login (<code>user</code>) is displayed at the top of the page, along with <code>msg</code>, if present." (faketest "(admin-page user \"Please administer...\")" ""))
+
+
+(def login-page "switch [msg [afterward]]" "Generates a login page.  <code>switch</code> is <code>'register</code>, <code>'login</code>, or <code>'both</code>, allowing account creation, account login, or both operations respectively.  The top of the page displays <code>msg</code>.  After the page completes, the <code>afterward</code> continuation is executed (by default <code>hello-page</code>).  <code>afterward</code> is either a function or a (function, redirect-string) pair.  The function takes the user name and IP as arguments."
+(faketest "(defop mylogin req (login-page 'login \"Hello\"
+    (fn (user ip) (prn \"Welcome \" user ip))))" ""))
+
+
+
+)
+
+(newtable "Typed and marked-up forms"
+(def vars-form "user fields f done [button [lasts]]" "Generates a form for <code>user</code>.  <code>fields</code> is a list of <code>(type label value view modify question)</code> lists specifying the form.  When submitted, <code>f</code> is executed on each field, with the arguments <code>label newval</code>.  Then continuation function <code>done</code> is executed. If there is a modifiable field, a submit button is generated with label specified by <code>button</code>.  The lifetime of the associated fnid can be specified with <code>lasts</code>.")
+
+(def md-from-form "str [nolinks]" "Converts <code>str</code> to markdown after escaping it.  URLs will be converted to links unless <code>nolinks</code> is set.  Used to generate markdown from form input." (tests (md-from-form "Hello *world* &")))
+
+(def markdown "s [maxurl [nolinks]]" "Applies the markdown rules to <code>s</code> to generate HTML." (htmltests (show prn (markdown "Text\n\n  Code\nhttp://arcfn.com, and *stuff*"))))
+
+(def unmarkdown "s" "Inverse of <code>markdown</code> to convert HTML to a marked-down string." (tests (unmarkdown  "Text<p><pre><code>  Code</code></pre>")))
+(def paras "s" "Returns list of paragraph indices.  New in arc3." (tests (paras "ab\n\ncde\n\nfgh")))
+
+)
+
+
+(newtable "Variables"
+(var good-logins* "" "A queue of successful logins, holding lists of the timestamp, IP, and user id.")
+
+(var bad-logins* "" "A queue of unsuccessful logins, holding lists of the timestamp, IP, and user id.")
+(var hpasswords* "" "Table of passwords mapping from user to hash.")
+(var admins* "" "Admin stuff.")
+(var cookie->user* "" "Table mapping cookies to users.")
+(var user->cookie* "" "Table mapping users to cookies.")
+(var logins* "" "Table of logins mapping from user name to IP address.")
+(var hpwfile*  "" "Password file, backs <code>hpasswords*</code>." (tests hpwfile*))
+(var adminfile*  "" "Admin file, backs <code>admins*</code>." (tests adminfile*))
+(var cookfile*  "" "Cookie file, backs <code>cookie->user*</code>." (tests cookfile*))
+(var formwid* "" "Specifies width of form field." (tests formwid*))
+(var bigformwid* "" "" (tests bigformwid*))
+(var numwid* "" "" (tests numwid*))
+(var formatdoc-url* "" "" (tests formatdoc-url*))
+(var oidfile* "" "Openids file; apparently unused.  New in arc3." (tests oidfile*))
+(var dc-usernames* "" "Downcased usernames.  New in arc3." (tests dc-usernames*))
+(var months* "" "Month names.  New in arc3." (tests months*))
+(var month-names* "" "Table from month name to month number.  New in arc3." (tests (month-names* "jan") (month-names* "February")))
+)
+
+(newtable "Internals"
+
+(def load-userinfo "" "Initializes <code>hpasswords*</code>, <code>admins*</code>, and <code>cookie->user</code>." (faketest "(load-userinfo)" ""))
+
+
+(def mismatch-message "" "Prints an error message if the user doesn't match the cookie." (tests (mismatch-message)))
+
+(def admin-gate "user" "Gates access to admin-page.  If <code>user</code> is an admin, displays <code>admin-page</code>, otherwise redirects to <code>login-page</code>." (faketest "(admin-gate \"myuserid\")" "t"))
+
+(def predicate user-exists "user" "Tests if <code>user</code> is not <code>nil</code> and present in <code>hpasswords*</code>." (faketest "(user-exists \"myuserid\")" "t"))
+
+(def cook-user "user" "Generates and saves a cookie for <code>user</code>.  Returns the cookie id." (tests (cook-user "testuser")))
+
+(def new-user-cookie "" "Generates a unique cookie id." (tests (new-user-cookie)))
+
+
+(def create-acct "user pw" "Creates a user account.  Just a wrapper around <code>set-pw</code>." (tests (create-acct "foo" "secret")))
+
+(def disable-acct "user" "Disables user account by logging user out and changing the password to a random string." (tests (disable-acct "badperson")))
+  
+(def hello-page "user ip" "Displays a simple page saying 'hello <i>user</i> at <i>ip</i>'.")
+  
+(def prcookie "cook" "Prints a header field to update cookie <code>user</code> to the value <code>cook</code>." (htmltests (prcookie "myvalue")))
+
+(def pwfields "[label]" "Generates HTML for username and password fields, and a submit button, labelled \"login\" by default." (htmltests (show pwfields)))
+
+(def good-login "user pw ip" "Tests if the user and password are valid according to <code>hpasswords*</code>.  Returns <code>user</code> on success, and <code>nil</code> on failure.  Updates <code>good-logins*</code> or <code>bad-logins</code> as appropriate." (tests (good-login "foo" "bar" "127.0.0.1")))
+
+(def shash "str" "Hashes <code>str</code> to a sha1 digest using <code>openssl</code>." (tests (shash "foo")))
+
+(def bad-newacct "user pw" "Tests if the new userid and password are bad (bad length, bad characters, or already in use).  Returns an error message if the new account specification is bad, and <code>nil</code> if the information is okay." (tests (bad-newacct "foo" "x")))
+
+
+
+(def varfield "typ id val" "Prints HTML for an input field of type <code>typ</code>, name <code>id</code>, and value <code>val</code>.  <code>typ</code> is one of
+<code>bigtoks</code>, <code>date</code>, <code>doc</code>, <code>int</code>, <code>lines</code>, <code>mdtext</code>, <code>mdtext2</code>, <code>num</code>, <code>posint</code>, <code>string</code>, <code>string1</code>, <code>sym</code>, <code>syms</code>, <code>text</code>, <code>time</code>, <code>toks</code>, <code>url</code>, <code>users</code>.  The type of field and the processing of val depend on <code>typ</code>." (htmltests (show varfield 'syms 'foo '(a b c))))
+
+(def text-rows "text width [pad]" "Detemines how many rows to hold <code>text</code> based on <code>width</code> and padding." (tests (text-rows "abcde" 2)))
+
+(def needrows "text cols [pad]" "Determines how many rows are needed to hold <code>text</code>, based on the length of the text and the number of newlines." (tests (needrows "abcde" 2)))
+
+(def varline "type id val [liveurls]" "Prints <code>val</code> according to <code>type</code>.  <code>id</code> is ignored.  If <code>liveurls</code> is true, links will be made to URLs." (htmltests (varline 'yesno 'junk 1)))
+
+(def predicate text-type "type" "Tests if <code>type</code> is one of <code>string</code>, <code>string1</code>, <code>url</code>, <code>text</code>, <code>mdtext</code>, <code>mdtext2</code>." (tests (text-type 'string1)))
+
+(def readvar "type str [fail]" "Reads variable of <code>type</code> from <code>str</code>.  Returns <code>fail</code> (default <code>nil</code> on failure)." (tests (readvar 'string "a<b>c")))
+
+(def showvars "fields [liveurls]" "Generates table rows for a <code>varfield</code> list of fields.  If liveurls is true, will make links to URLs.")
+
+
+(def indented-code "s i [newlines [spaces]]" "Tests if <code>s</code> is indented code under the markup rules.  Returns a pair of the index of the start of the code, and the number of spaces of indentation.  Returns <code>nil</code> if not indented code.  The first <code>i</code> characters are skipped." (tests (indented-code "\n\n  abc" 0)))
+
+(def parabreak "s i [newlines]" "If <code>s</code> starts with a paragraph break (at least one blank line), returns the index of the start of the paragraph.  Otherwise returns <code>nil</code>.  Skips the first <code>i</code> characters." (tests (parabreak "\n\nabc\ndef" 0)))
+
+(def urlend "s i" "Finds the logical end of a URL embedded in a string, and returns the index of the first character not in the URL.  The first <code>i</code> characters are skipped." (tests (let url "http://arcfn.com; stuff" (cut url 0 (urlend url 0)))))
+
+(def predicate delimc "c" "Tests if <code>c</code> is a delimiter: a parenthesis, square bracket, curly bracket, or double quote." (tests (delimc #\})))
+
+(def code-block "s i" "Markdown formatting: Returns a 'code block', which is terminated by a line that is not indented with whitespace.  The first <code>i+1</code> characters are skipped." (tests (code-block "abc\n def\n ghi\njkl" 0)))
+
+(def login-form "label switch handler afterward" "Creates login form for login-page.  New in arc3." )
+(def login-handler "req switch afterward" "Handler called from login-page.  New in arc3." )
+(def create-handler "req switch afterward" "Handler called from login-page to create account.  New in arc3." )
+(def login "user ip cookie afterward" "Handles successful login.  New in arc3." )
+(def failed-login "user ip cookie afterward" "Handles login failure.  New in arc3." )
+(def predicate username-taken "user" "Tests if username is in dc-usernames* and updates that table.  New in arc3."  (tests (username-taken "joe")))
+(def next-parabreak "s i" "Returns index of next paragraph break after i, if any.  New in arc3." (tests (next-parabreak "ab\n\ncd" 0)))
+(def predicate opendelim "c" "Tests is character is an opening delimiter.  New in arc3." (tests (opendelim #\<)))
+(def predicate closedelim "c" "Tests is character is an closing delimiter.  New in arc3." (tests (closedelim #\])))
+(def english-time "min" "Converts time in minutes to string.  New in arc3." (tests (english-time 720)) (tests (english-time 800)))
+(def parse-time "s" "Parses a time string to minutes.  New in arc3." (tests (parse-time "12:30pm")) )
+(def english-date "(y m d)" "Converts date to string.  New in arc3." (tests (english-date (2009 6 8))))
+(def monthnum "s" "Converts month name to number.  New in arc3." (tests (monthnum "Mar")))
+(def date-nums "s" "Used by date-nums to parses a date string to (y m d).  New in arc3." (tests (date-nums "2009-12-31") (date-nums "December 31, 2009") (date-nums "June 5")))
+(def predicate valid-date "(y m d)" "Minimal validation on date.  New in arc3." (tests (valid-date '(2009 1 31)) (valid-date '(2009 2 31)) (valid-date '(2009 2 32))))
+(def parse-date "s" "Parses a date string to (y m d) with some validation.  New in arc3." (tests (parse-date "2009-12-31") (parse-date "December 32, 2009")))
+
+))