Greg Slepak avatar Greg Slepak committed 75c4594

- implemented route for twitter-like RESTful resources
- got rid of 'with-wrapped-print'. 'print' and 'println' are now globally remapped.
- rearranged a bunch of code and updated code comments
- added demo for 'wings' resource (not linked to from example-site though)
- added artfulcode's json stuff and created an artful code folder under plugins-inactive
- added an 'activate-plugin' function to selectively load inactive plugins as needed.
- added 'include' function to provide method of including files without passing them through the template evaluator.
- added a 'die' function to combine error 500 + log-err into one step.

Comments (0)

Files changed (12)

example-site/dragonfly-framework/config.lsp

 ; RESTful Resources
 ;===============================================================================
 
-; TODO: implement this
-
 ; set to nil to disable REST handling
 (constant 'ENABLE_RESTFUL_HANDLER true)
-; location of RESTful resources (relative to DOCUMENT_ROOT)
-(constant 'RESTFUL_DIR "resources")
-
-; define any RESTful resources (just the root, i.e. the first slash)
-; note that to allow runtime modification this is not a constant
-(define restful-resources '(
-	"create"
-	"show"
-	"edit"
-	"update"
-	"remove"
-))
+; location of RESTful resources
+(constant 'RESOURCES_PATH (string DOCUMENT_ROOT "/resources"))
 
 (context MAIN)

example-site/dragonfly-framework/dragonfly.lsp

 ;; Its's features are a short learning curve, lightweight and fun in programming - 
 ;; just like newLISP itself.</p>
 
-; $SERVER is a synonym for env
-; this line at top because it must be executed in MAIN
-; for $GET, $POST, and $FILES see lib/request.lsp
+;===============================================================================
+; !Basic Setup, Global Vars, and Sanity Checks
+;===============================================================================
+
+; $SERVER is a synonym for env, for $GET, $POST, and $FILES see lib/request.lsp
 (constant (global '$SERVER) env)
 
-; DF is a shorthand to the Dragonfly context
-; so that things like log-err can be written DF:log-err
+; DF is a convenient shorthand to the Dragonfly context
 (constant (global 'DF) Dragonfly)
 
 ; make sure these two are defined
 	(env "QUERY_STRING" QUERY_STRING)
 )
 
+; seed the random number generator immediately.
+(seed (time-of-day))
+
 (context 'Dragonfly)
 
 ;===============================================================================
 ; load all our essential stuff
 (load-files-in-dir (string DRAGONFLY_ROOT "/lib") "\.lsp$")
 ; plugins are loaded when listener is called so that they
-; can modify the variables in this file is they want.
-
-;===============================================================================
-; !Setup Default Routes
-;===============================================================================
-
-; we want 3 basic routes:
-
-; 1) Basic files
-; 	- URL has an extension, assume it's a file and try to load it
-; 2) Resources
-; 	- URL begins with one of the reserved resource keywords
-; 		(i.e. create/show/update/remove)
-; 3) Views
-; 	- Anything else. Will attempt to show one of the views in /views
-; 	
-; To specify a route you'll need just two things:
-; 	- A filter function that returns true/nil
-; 	- A function that gets called if the filter returned true
-; 		it must also return true/nil which will indicate it was
-; 		to send a response or not. Note however that the function
-;		does not need to return actually, it can call (exit) if
-;		everything went fine.
-
-; switch to main prior to using define-subclass
-(context 'MAIN)
-
-; the static route is used to serve possibly templated files
-; for example, so that you can include newLISP code in .html files
-; will also handle .xml and .rss extensions
-(define-subclass (Route.Static Route)
-	((matches?)
-		; ex: .html or .html?a=4
-		(set 'file (if (empty? (set 'chunks (parse QUERY_STRING "?"))) QUERY_STRING (first chunks)))
-		(unless (set 'ext (exists (curry ends-with file) DF:STATIC_EXTENSIONS))
-			; alternatively 'file' could actually be a directory, in which case
-			; we need to check if there's an index file in it
-			(set 'ext DF:STATIC_INDEX_EXTENSION)
-			(set 'file (string DOCUMENT_ROOT "/" file "/index" ext))
-			(file? file)
-		)
-	)
-	((run)
-		; pass through template TODO: make sure this is secure! no ../ bullshit!
-		(DF:log-debug (context) ": " file)
-		(Response:content-type (Response:extension->type ext))
-		(unless (DF:eval-template (read-file file))
-			(DF:display-error 404)
-		)
-	)
-)
-
-(define-subclass (Route.Resource Route)
-	((matches?)
-		nil
-	)
-	((run)
-		; pass along to Resource
-	)
-)
-
-(define-subclass (Route.View Route)
-	((matches?)
-		(if (empty? QUERY_STRING)
-			(set 'DF:viewname DF:DEFAULTVIEW)
-			(set 'DF:viewname (first (parse QUERY_STRING "/")))
-		)
-		(file? (DF:view-path DF:viewname))
-	)
-	((run)
-		; pass through template
-		(DF:log-debug (context) ": " DF:viewname)
-		(DF:display-view DF:viewname)
-	)
-)
-
-(context 'Dragonfly)
-
-(if ENABLE_STATIC_TEMPLATES (push (Route.Static) dragonfly-routes -1))
-(if ENABLE_RESTFUL_HANDLER (push (Route.Resource) dragonfly-routes -1))
-(if ENABLE_VIEW_HANDLER (push (Route.View) dragonfly-routes -1))
+; can modify the variables in this file if they want.
+; you can also load the inactive plugins on a need-to-load basis
+; by using the 'activate-plugin' function.
 
 ;===============================================================================
 ; !Public Functions
 ;===============================================================================
 
-; web-root is used to make things work nicely if the site isn't
-; located at DOCUMENT_ROOT but in a subdirectory of it. Instead
-; of including a link to "/welcome", you'd use (web-root "welcome")
+;; @syntax (Dragonfly:activate-plugin <plugin-name-1> [<plugin-name-2> ...])
+;; @param <plugin-name-1> The name of the plugin to load, without the ".lsp" extension.
+;; <p>Loads (once only) an inactive plugin(s). Quite often you'll only want some plugins
+;; loaded when 'listener' is called, and only sometimes you'll need to load a
+;; specific plugin. This can speed things up, especially if the plugin is large.</p>
+(define (activate-plugin)
+	(doargs (plugin-name)
+		(load-once (string DRAGONFLY_ROOT "/plugins-inactive/" plugin-name ".lsp"))
+	)
+)
+
+;; @syntax (Dragonfly:web-root <path>)
+;; <p>web-root is used to make things work nicely if the site isn't
+;; located at DOCUMENT_ROOT but in a subdirectory of it. Instead
+;; of including a link to "/welcome", you'd use (web-root "welcome")</p>
 (define (web-root path)
 	; WEB_ROOT should have a "/" on the end
 	(if (starts-with path "/") (pop path))
 	(string WEB_ROOT path)
 )
 
-(define (view-path viewname)
-	(string VIEWS_PATH "/" viewname (if VIEW_EXTENSION VIEW_EXTENSION ""))
+(define (view-path view-name)
+	(string VIEWS_PATH "/" view-name (if VIEW_EXTENSION VIEW_EXTENSION ""))
 )
 
-(define (partial-path partialname)
-	(string PARTIALS_PATH "/" partialname (if VIEW_EXTENSION VIEW_EXTENSION ""))
+(define (partial-path partial-name)
+	(string PARTIALS_PATH "/" partial-name (if VIEW_EXTENSION VIEW_EXTENSION ""))
+)
+
+(define (resource-path resource-name)
+	(string RESOURCES_PATH "/" resource-name ".lsp")
 )
 
 ;; @syntax (Dragonfly:include)
 	)
 )
 
+(define (die)
+	(let (msg (apply string $args))
+		(log-err msg)
+		(throw-error msg)
+	)
+)
 
 ; our main entry-point. this calls exit.
 (define (listener)
 )
 
 ;===============================================================================
+; !Setup Default Routes
+;===============================================================================
+
+; switch to main prior to using define-subclass
+(context 'MAIN)
+
+; Route.Static handles "normal" URLs, i.e. the URL represents the actual
+; location of the file. Two scenarios are handled:
+; 1) URL refers to real file ending in one of the STATIC_EXTENSIONS
+; 2) URL refers to real directory and has an index file ending in STATIC_INDEX_EXTENSION
+(define-subclass (Route.Static Route)
+	((matches?)
+		(set 'chunks (parse QUERY_STRING "?"))
+		(when (not (empty? chunks))
+			; ex: .html or .html?a=4
+			(set 'file (first chunks))
+			; check if 'file' has one of the static extensions. If not, it could
+			; be a directory with an index file inside of it, so check that.
+			(unless (set 'ext (exists (curry ends-with file) DF:STATIC_EXTENSIONS))
+				(set 'ext DF:STATIC_INDEX_EXTENSION)
+				(set 'file (string DOCUMENT_ROOT "/" file "/index" ext))
+			)
+			; finally, we match only if the file actually exists
+			; this allows us to support without conflict twitter-like RESTful URLs with format specifiers
+			(file? file)
+		)
+	)
+	((run)
+		; pass through template TODO: make sure this is secure! no ../ bullshit!
+		(DF:log-debug (context) ": " file)
+		(Response:content-type (Response:extension->type ext))
+		(unless (DF:eval-template (read-file file))
+			(DF:display-error 404)
+		)
+	)
+)
+
+; Route.Resource handles URLs that refer to RESTful resources, represented
+; as newLISP contexts. These resources reside in the RESOURCES_PATH as .lsp files.
+; The URL works in a similar manner to twitter's RESTful API:
+; http://mysite.com/<resource_name>[/resource_action][.restponse_format][?get_paramters]
+; <resource_name> maps to a context name in a special way: first "Resource." is prepended
+; to the name, then the underscores are removed and the name is mapped to title case.
+; ex: resource_name => Resource.ResourceName
+; The name also maps to a real file located in RESOURCES_PATH by appending ".lsp" to the name:
+; ex: resource_name => load file: RESOURCES_PATH/resource_name.lsp
+; If <resource_name> implements <resource_action>, then that function is called
+; optionally passing in the <response_format> in as a paramter (if it was given).
+; If no <resource_action> is specified, then the resource's default function is called instead.
+; <resource_name>, <resource_action> and <response_format> may only contain alphanumeric
+; characters and the underscore.
+(define-subclass (Route.Resource Route)
+	((matches?)
+		(when (regex {^(\w+)(/(\w+))?(\.(\w+))?} QUERY_STRING)
+			(set 'resource_name $1 'resource_action $3 'response_format $5)
+			(file? (set 'path (DF:resource-path resource_name)))
+		)
+	)
+	((run)
+		(load path)
+		(set 'ctx-str (string "Resource." (join (map title-case (parse resource_name "_")))))
+		(set 'ctx-sym (sym ctx-str))
+		
+		; If no action is specified, use the default function
+		(if (null? resource_action) (set 'resource_action ctx-str))
+		(set 'action (eval (sym resource_action ctx-sym)))
+		
+		(if-not (lambda? action) (DF:die ctx-str ":" resource_action " not defined!"))
+		
+		; call the action on the resource with the optional response_format
+		(action (if-not (null? response_format) response_format))
+	)
+)
+
+(define-subclass (Route.View Route)
+	((matches?)
+		(if (empty? QUERY_STRING)
+			(set 'DF:viewname DF:DEFAULTVIEW)
+			(set 'DF:viewname (first (parse QUERY_STRING "/")))
+		)
+		(file? (DF:view-path DF:viewname))
+	)
+	((run)
+		; pass through template
+		(DF:log-debug (context) ": " DF:viewname)
+		(DF:display-view DF:viewname)
+	)
+)
+
+(context 'Dragonfly)
+
+(if ENABLE_STATIC_TEMPLATES (push (Route.Static) dragonfly-routes -1))
+(if ENABLE_RESTFUL_HANDLER (push (Route.Resource) dragonfly-routes -1))
+(if ENABLE_VIEW_HANDLER (push (Route.View) dragonfly-routes -1))
+
+;===============================================================================
 ; !Private Functions (i.e. you shouldn't ever call these)
 ;===============================================================================
 
 (define (send-and-exit)
 	(Response:send-headers)
-	(MAIN:println STDOUT)
+	(sys-print STDOUT)
 	(exit)
 )
 

example-site/dragonfly-framework/lib/response.lsp

 )
 
 (define (send-headers)
-	(print "Status: " status-code " " (lookup status-code status-codes) "\r\n")
-	(dolist (header headers) (print (first header) ": " (last header) "\r\n"))
-	(dolist (cookie cookies) (print "Set-Cookie: " (apply format-cookie cookie) "\r\n"))
-	(print "\r\n")
+	(sys-print "Status: " status-code " " (lookup status-code status-codes) "\r\n")
+	(dolist (header headers) (sys-print (first header) ": " (last header) "\r\n"))
+	(dolist (cookie cookies) (sys-print "Set-Cookie: " (apply format-cookie cookie) "\r\n"))
+	(sys-print "\r\n")
 )
 
 ;===============================================================================
 	'text-type "text/plain; charset=utf-8"  'xml-type "text/xml"
 	'html-type "text/html; charset=utf-8"   'js-type "application/javascript"
 	'atom-type "application/atom+xml"       'css-type "text/css"
+	'json-type "application/json"
 )
 
 (set 'extension-to-type-map

example-site/dragonfly-framework/lib/utils.lsp

 ;; @module Dragonfly
 ;; @author Greg Slepak <greg at taoeffect.com>
 
-;; @syntax (with-wrapped-print <body>)
-;; <p>If you're calling a function outside of the Dragonfly context
-;; that in turn calls 'print' or 'println', make sure to wrap the function
-;; call in this macro to prevent the web headers from being screwed up.</p>
-;; @example
-;; (with-wrapped-print (nldb:show))
-(define-macro (with-wrapped-print)
-	(let (saved-p print saved-pn println)
-		(constant 'print Dragonfly:print 'println Dragonfly:println)
-		(eval (cons 'begin $args))
-		(constant 'print saved-p 'println saved-pn)
-	)
-)
-(global 'with-wrapped-print)
-
 ;; @syntax (define-subclass (<sym-subclass> <ctx>) <method-1> ...])
 ;; @param <sym-subclass> Symbol representing name of the subclass
 ;; @param <ctx> The FOOP class you'll be subclassing
 			(doargs (file)
 				(unless (or (context? file) (find file _loaded))
 					(push file _loaded)
-					(saved-load file ctx)
+					(MAIN:sys-load file ctx)
 				)
 			)
 		)
 
 (context 'MAIN)
 
-; swap the MAIN functions for ours
-(unless Dragonfly:saved-load
-	(def-new 'load 'Dragonfly:saved-load)
+; swap the MAIN functions for ours and save the originals
+(unless sys-load
+	(constant (global 'sys-load) load)
 	(constant 'load Dragonfly:load-once)
+	(constant (global 'sys-print) print)
+	(constant 'print Dragonfly:print)
+	(constant (global 'sys-println) println)
+	(constant 'println Dragonfly:println)
 )

example-site/dragonfly-framework/plugins-inactive/artfulcode/json.lsp

+;; @module Json
+;; @author Jeff Ober <jeffober@gmail.com>
+;; @version 2.0
+;; @location http://static.artfulcode.net/newlisp/json.lsp
+;; @package http://static.artfulcode.net/newlisp/json.qwerty
+;; @description JSON parser and encoder; requires util.lsp (updated for newlisp 10)
+;; <p>Library for parsing JSON data and serializing lisp into JSON.</p>
+;; <h4>Version history</h4>
+;; <b>2.0</b>
+;; &bull; completely rewrite of decoder (thanks to Andrew Pennebaker for pointing out the bugs in the original)
+;; 
+;; <b>1.2</b>
+;; &bull; fixed incompatibilities with newlisp 10
+;; 
+;; <b>1.1</b>
+;; &bull; added simple escape routine to outputted string values
+;; 
+;; <b>1.0</b>
+;; &bull; initial release
+
+(DF:activate-plugin "artfulcode/util")
+
+(context 'Json)
+
+;; @syntax (Json:lisp->json <expr>)
+;; @param <expr> expression to be converted to JSON
+;; <p>Converts expression <expr> to JSON.  Association lists and
+;; contexts are converted into objects.  Other lists and arrays are
+;; converted into JSON arrays.</p>
+;; @example
+;; (Json:lisp->json '((a 1) (b 2)))
+;; => "{ 'A': 1, 'b': 2 }"
+;; (Json:lisp->json '(1 2 3 4 5))
+;; => "[1, 2, 3, 4, 5]"
+(define (lisp->json lisp)
+  (case (type-of lisp)
+    ("boolean" (if lisp "true" "false"))
+    ("quote" (lisp->json (eval lisp)))
+    ("symbol" (format "'%s'" (name lisp)))
+    ("string" (format "'%s'" (simple-escape lisp)))
+    ("integer" (string lisp))
+    ("float" (string lisp))
+    ("list" (if (assoc? lisp)
+                (format "{ %s }"
+                        (join (map (fn (pair)
+                                     (format "'%s': %s"
+                                             (if (symbol? (pair 0))
+                                                 (name (pair 0))
+                                                 (string (pair 0)))
+                                             (lisp->json (pair 1))))
+                                   lisp)
+                              ", "))
+                (string "[" (join (map lisp->json lisp) ", ") "]")))
+    ("array" (string "[" (join (map lisp->json lisp) ", ") "]"))
+    ("context" (let ((values '()))
+                 (dotree (s lisp)
+                   (push (format "'%s': %s"
+                                 (name s)
+                                 (lisp->json (eval s)))
+                         values -1))
+                 (format "{ %s }" (join values ", "))))
+    (true (throw-error (format "invalid lisp->json type: %s" lisp)))))
+
+(define (simple-escape str)
+  (replace {[\n\r]+} str {\n} 4)
+  (replace {'} str {\'} 4)
+  str)
+
+;; @syntax (Json:json->lisp <str-json>)
+;; @param <str-json> a valid JSON string
+;; <p>Parses a valid JSON string and returns a lisp structure.
+;; Arrays are converted to lists and objects are converted to 
+;; assocation lists.</p>
+;; @example
+;; (Json:json->lisp "[1, 2, 3, 4]")
+;; => (1 2 3 4)
+;; (Json:json->lisp "{ 'x': 3, 'y': 4, 'z': [1, 2, 3] }")
+;; => (("x" 3) ("y" 4) ("z" (1 2 3)))
+(define (json->lisp json)
+  (first (lex (tokenize json))))
+
+(define number-re (regex-comp {^([-+\deE.]+)} 1))
+(define identifier-re (regex-comp {([$_a-zA-Z][$_a-zA-Z0-9]*)(.*)} 4))
+
+(define (read-number text , matched n)
+  "Reads in a number in any Javascript-permissible format and attempts to
+  convert it to a newLISP float. If the number's absolute value is greater
+  than 1e308 (defined as +/-INF in newLISP), the number is returned as a
+  string."
+  (setf text (trim text))
+  (when (setf matched (regex number-re text 0x10000))
+    (setf n (pop text 0 (matched 5)))
+    (list (if (> (abs (float n)) 1e308) n (float n)) text)))
+
+(define (read-string text , quot c escaped split-index str)
+  (setf quot (pop text) str "")
+  (catch
+    (until (empty? (setf c (pop text)))
+      (if (and (= c quot) (not escaped))
+        (throw $idx)
+        (write-buffer str c))
+      (setf escaped (and (not $it) (= c {\})))))
+  (list str text))
+
+(define (read-identifier text , matched)
+  (setf text (trim text))
+  (setf matched (regex identifier-re text 0x10000))
+  (list (case (nth 3 matched)
+          ("true" true) ("TRUE" true)
+          ("false" nil) ("FALSE" nil)
+          ("null" nil) ("NULL" nil)
+          (true (nth 3 matched)))
+        (nth 6 matched)))
+
+(define (tokenize text (acc '()) , tok tail n)
+  (setf text (trim text))
+  (cond
+    ((empty? text) acc)
+    ((regex {^\s+} text 4)
+     (tokenize (replace {^\s+} text "" 0) acc))
+    ((regex number-re text 0x10000)
+     (map set '(tok tail) (read-number text))
+     (push tok acc -1)
+     (tokenize tail acc))
+    ((regex {^['"]} text)
+     (map set '(tok tail) (read-string text))
+     (push tok acc -1)
+     (tokenize tail acc))
+    ((regex [text]^[{}\[\]:,][/text] text)
+     (setf tok (pop text))
+     (case tok
+       ("{" (push 'OPEN_BRACE acc -1))
+       ("}" (push 'CLOSE_BRACE acc -1))
+       ("[" (push 'OPEN_BRACKET acc -1))
+       ("]" (push 'CLOSE_BRACKET acc -1))
+       (":" (push 'COLON acc -1))
+       ("," (push 'COMMA acc -1)))
+     (tokenize text acc))
+    (true
+     (map set '(tok tail) (read-identifier text))
+     (push tok acc -1)
+     (tokenize tail acc))))
+
+(define (lex tokens, (tree '()) (loc '(-1)) (depth 0) (mark 0))
+  ;; Note: mark is used to match colon-pairings' depth against the current
+  ;; depth to prevent commas in a paired value (e.g. foo: [...] or foo: {})
+  ;; from popping the stack.
+  (unless (find (first tokens) '(OPEN_BRACKET OPEN_BRACE))
+    (throw-error "A JSON object must be an object or array."))
+  (dolist (tok tokens)
+    (case tok
+      (OPEN_BRACKET
+        (inc depth)
+        (push (list) tree loc)
+        (push -1 loc))
+      (OPEN_BRACE
+        (inc depth)
+        (push (list) tree loc)
+        (push -1 loc))
+      (CLOSE_BRACKET
+        (dec depth)
+        (pop loc))
+      (CLOSE_BRACE
+        (dec depth)
+        (pop loc))
+      (COLON
+        (push (list (pop tree loc)) tree loc)
+        (push -1 loc)
+        (setf mark depth))
+      (COMMA
+        (when (= mark depth)
+          (setf mark nil)
+          (pop loc)))
+      (true
+        (push tok tree loc))))
+  tree)
+
+(context MAIN)

example-site/dragonfly-framework/plugins-inactive/artfulcode/util.lsp

+;; @module util
+;; @author Jeff Ober <jeffober@gmail.com>
+;; @version 2.0
+;; @location http://static.artfulcode.net/newlisp/util.lsp
+;; @package http://static.artfulcode.net/newlisp/util.qwerty
+;; @description Various functions that the other libraries depend on (updated for newlisp 10).
+;; Various helpful utilities for newLISP.  Requires newlisp 10+.
+;; 
+;; <h4>Version history</h4>
+;; <b>2.1</b>
+;; &bull; added with-open-device, partial
+;; &bull; added make-array, array-iter and array-map
+;; 
+;; <b>2.0</b>
+;; &bull; updated for newlisp 10 (backwards-incompatible)
+;; &bull; refactored assoc? (now permits any key that satisfies 'atom?')
+;; &bull; get-assoc is now a regular function whose arguments must be quoted
+;; &bull; slot functions removed as new association list features make them redundant
+;; &bull; dict-keys refactored and renamed to keys
+;; &bull; refactored dokeys for a slight speed improvement
+;; 
+;; <b>1.4</b>
+;; &bull; added <slot-value>
+;; &bull; <with-slots> now supports string keys
+;; &bull; fixed bug when calling <with-slots> from within a context
+;; &bull; <with-slots> now permits renaming of variables in binding to avoid clashes in nested calls
+;; &bull; added <get-assoc>
+;; &bull; added <dict-keys>
+;; &bull; added <dokeys>
+;; 
+;; <b>1.3</b>
+;; &bull; <with-slots> now supports assoc data in the format '(key val-1 val-2 ...)' and '(key val)
+;; 
+;; <b>1.2</b>
+;; &bull; fixed bug that caused <with-slots> to return only the first value of a list
+;; 
+;; <b>1.1</b>
+;; &bull; added <fmap>, <with-slots>, and <add-assoc>
+;; 
+;; <b>1.0</b>
+;; &bull; initial release
+
+;; @syntax (type-of <object>)
+;; @param <object> any object
+;; <p>'type-of' introspects the type of the passed argument, object, and returns a string
+;; representation of its type.  Correctly identifies FOOP types as well, returning the
+;; string value of the first argument (by calling 'name' on the context of the list).</p>
+;; @example
+;; (type-of 10) => "integer"
+;; (type-of "hello world") => "string"
+;; (type-of true) => "boolean"
+;; (type-of '(1 2 3)) => "list"
+;; (type-of (fn (x) (+ x x))) => "lambda"
+(setq type-of:types '("boolean" "boolean" "integer" "float" "string" "symbol" "context"
+					  "primitive" "primitive" "primitive" "quote" "list" "lambda" "macro"
+					  "array"))
+
+(define (type-of:type-of x)
+  (let ((type (type-of:types (& 0xf ((dump x) 1)))))
+	  (if (and (= "list" type) (context? (first x)))
+	      (name (first x))
+		    type)))
+
+;; @syntax (gensym [<ctx>])
+;; @param <ctx> optional; the context in which to create the symbol (default: MAIN)
+;; <p>Returns a symbol unique to the context passed.  If 'ctx' is nil, the symbol is
+;; created in MAIN.  There is a hard limit on the number of possible symbols generated based on
+;; the max integer value of the system.  Since newLISP wraps into negative numbers when passing
+;; the max value, the effective max value is twice the systems maximum integer value.</p>
+;; @example
+;; (gensym) => gensym-1
+;; (gensym) => gensym-2
+;; 
+;; (define foo:foo)
+;; (gensym foo) => foo:gensym-1
+;; (gensym foo) => foo:gensym-2
+(define _gensym:_gensym)
+
+(define (gensym:gensym (ctx MAIN) , ctx-name new-sym)
+  (setf ctx-name (name ctx))
+  (if (_gensym ctx-name)
+    (begin
+      (setf new-sym (string "gensym-" (_gensym ctx-name (+ 1 (_gensym ctx-name)))))
+      (or (sym new-sym ctx) (gensym ctx)))
+    (begin
+      (_gensym ctx-name 0)
+      (gensym ctx))))
+
+;; @syntax (assoc? <expr>)
+;; @param <expr> expression to be tested as an association list
+;; <p>Predicates that <expr> is an association list with a structure of
+;; '((key val) (key val) ...).  To evaluate true key may have only one
+;; value, and keys must be symbols or strings.  Only the first level
+;; is tested for associativity.</p>
+;; @example
+;; (assoc? '(1 2 3 4))
+;; => nil
+;; (assoc? '((a 1) (b 2) (c 3)))
+;; => true
+;; (assoc? '((a 1) (b 2) (c (1 2 3 4))))
+;; => true
+(define (assoc? lst)
+  (when (list? lst)
+    (for-all
+      (lambda (elt)
+        (and (= 2 (length elt))
+             (atom? (first elt))))
+      lst)))
+
+(global 'assoc?)
+
+;; @syntax (get-assoc <expr>)
+;; @param <expr> association indexing of (<assoc-list> <key-1> [<key-2> ...])
+;; <p>Extracts the value of the association expression.  Expressions are in the same
+;; format as with the 'assoc' function, but the result is the same as the 'lookup'
+;; function, except the multiple values are returned correctly.</p>
+;; @example
+;; (set 'data '((name "Joe") (friends "John" "Steve")))
+;; (get-assoc (data 'name))
+;; => "Joe"
+;; (get-assoc (data 'friends))
+;; => '("John" "Steve")
+(define (get-assoc expr , found)
+  (setf found (apply assoc expr))
+  (when found
+    (if (= 2 (length found))
+      (last found)
+      (rest found))))
+
+(global 'get-assoc)
+
+;; @syntax (fmap <sym-fun> <inst> <lst*>)
+;; @param <sym-fun> quoted symbol naming a context function
+;; @param <inst> a FOOP instance
+;; @param <lst*> one or more lists
+;; <p>FOOP methods cannot be easily mapped, since 'map' would require that the function
+;; be passed as 'context:function', curried for the intended FOOP instance.  However,
+;; currying truncates a function's lambda list to two parameters, the first being the
+;; second argument to curry.</p>
+;; <p>'fmap' solves this, although not extremely efficiently, with a lambda that wraps
+;; the context function.</p>
+;; @example
+;; (define (Foo:Foo) (list (context)))
+;; (define (Foo:make-list inst a b) (list a b)) ; pairs two elements
+;; 
+;; (let ((a '(1 2 3)) (b '(4 5 6)) (inst (Foo)))
+;;   (fmap 'Foo:make-list inst a b))
+;; 
+;; => ((1 4) (2 5) (3 6))
+(define (fmap fun inst)
+  (eval (append
+          (list 'map (fn () (apply fun (cons inst (args)))))
+          (map 'quote (args)))))
+
+(global 'fmap)
+
+;; @syntax (keys <context-dict>)
+;; @param <context-dict> context dictionary
+;; <p>Returns a list of keys in the dictionary <context-dict>.</p>
+;; @example
+;; (define dict:dict)
+;; (dict "x" 10)
+;; (dict "y" 20)
+;; (keys dict)
+;; => '("x" "y")
+(define (keys ctx)
+  (map (fn (key) (trim key "_" ""))
+       (filter (fn (key) (starts-with key "_"))
+               (map name (symbols ctx)))))
+
+(global 'keys)
+
+;; @syntax (dokeys (<var> <dict>) <body>)
+;; @param <var> variable to which the key name will be bound
+;; @param <dict> dictionary from which the keys will be extracted
+;; @param <body> the body forms to be executed with <var> bound to <dict>'s keys
+;; <p>Evaluates <body> in a local block in which <var> is sequentially bound to each
+;; of dict's keys.  Note that there is no special ordering of the keys.</p>
+;; @example
+;; (define dict:dict)
+;; (dict "x" 10)
+;; (dict "y" 20)
+;; (dokeys (key dict)
+;;   (println key ": " (dict key)))
+;; => x: 10
+;; => y: 20
+(define-macro (dokeys)
+  (letex ((var (args 0 0)) (ctx (args 0 1)) (body (cons 'begin (rest (args)))))
+    (dolist (key (keys ctx))
+      (setf var key)
+      body)))
+
+(global 'dokeys)
+
+;; @syntax (make-array <int-size> <fn-init>)
+;; @param <int-size> the size of the new array
+;; @param <pass-index> when true (nil by default), passes the position index to <fn-init>
+;; <p>Generates a new  one-dimensional array of size <int-size> and initializes
+;; each array index by repeatedly calling <fn-init>. The current index is
+;; available in $idx.</p>
+;; @example
+;; (setf arr (make-array 4 (gensym)))
+;; => '(gensym-1 gensym-2 gensym-3 gensym-4)
+(define (make-array size fun , arr i)
+  (setf arr (array size) i -1)
+  (until (= (inc i) size)
+    (setf (arr i) (fun)))
+  arr)
+
+(global 'make-array)
+
+;; @syntax (array-iter <fn-func> <array-arr>)
+;; @param <fn-func> a function to call on each index of the array
+;; @param <array-arr> an array
+;; <p>Calls <fn-func> on each index of <array-arry>. Returns the value of the
+;; last iteration. The current index is available in $idx.</p>
+;; @example
+;; (setf arr (array 4 (sequence 0 4))) ; => (0 1 2 3)
+;; (array-iter (fn (i) (println (+ i $idx))) arr)
+;; 0
+;; 2
+;; 4
+;; 6
+(define (array-iter fun arr , size i)
+  (setf i -1 size (length arr))
+  (until (= (inc i) size)
+    (fun (arr i))))
+
+(global 'array-iter)
+
+;; @syntax (array-map <fn-func> <array-arr>) !
+;; @param <fn-func> a function to call on each index of the array
+;; @param <array-arr> an array
+;; <p>Similar to the built-in function map, array-map applies <fn-func> to each
+;; index of <array-arr>. array-map modifies <array-arr> in place.</p>
+;; @example
+;; (setf arr (array 10 (sequence 0 10))) ; => (0 1 2 3 4 5 6 7 8 9)
+;; (array-map (fn (i) (+ i $idx)))
+;; (println arr) ; => '(0 2 4 6 8 10 12 14 16 18)
+
+(define-macro (array-map)
+  (letex ((i (gensym)) (size (gensym)) (fun (eval (args 0)) (arr (args 1))))
+    (setf i -1 size (length arr))
+    (until (= (inc i) size)
+      (setf (arr i) (fun $it)))))
+
+(global 'array-map)
+
+;; @syntax (with-open-device <descriptor> [<body-expressions>])
+;; @param <descriptor> an open file descriptor
+;; @param <body-expressions> any number of expressions
+;; <p>Evaluates <body-expressions> with <descriptor> as the default device.
+;; Catches errors during evaluation and closes <descriptor> once complete,
+;; restoring the previous default device.</p>
+;; @example
+;; ; read one line from file and close
+;; (with-open-device (open "somefile.txt")
+;;   (println (read-line)))
+(define-macro (with-open-device)
+  (let ((old-dev (device)) (dev (eval (args 0))) (return) (result))
+    (device dev)
+    (setf return (catch (eval (cons begin (rest (args)))) 'result))
+    (close (device))
+    (device old-dev)
+    (if return result (throw-error result))))
+
+(global 'with-open-device)
+
+;; @syntax (partial <func> <expr>)
+;; @param <func> a function to be partially applied
+;; @param <expr> an expression to replace the first argument of <func>
+;; <p>Returns a new function that has been partially applied to <expr>. Unlike
+;; curry, partial evaluates its arguments and does no damage to the parameter
+;; list of the resulting function, which continues to accept the rest of the
+;; parameters it would typically accept. This is particularly useful to fudge
+;; closures over FOOP methods by partially applying them to their instances.
+;; Note that macros and functions that do not evaluate their arguments may not
+;; be partially applied, due to the use of the apply function in this
+;; implementation.</p>
+;; @example
+;; (define (foo a b c)
+;;   (join (list "foo" a b c) "|"))
+;; (setf foobar (partial foo "bar"))
+;; (foobar "baz" "bat") ; => "foo|bar|baz|bat"
+(define (partial func arg)
+  (letex ((func func) (arg arg))
+    (lambda ()
+      (apply func (cons 'arg (args))))))
+
+(global 'partial)

example-site/dragonfly-framework/plugins-inactive/artfulcode/web.lsp

+#!/usr/bin/newlisp
+;; @module Web
+;; @author Jeff Ober <jeffober@gmail.com>
+;; @version 0.3.1 beta
+;;
+;; Modifictations (in C-style) by Greg Slepak <greg at taoeffect.com>
+;; Based on version 0.3.1 beta by Jeff, located here:
+;; http://static.artfulcode.net/newlisp/web.lsp.html
+(context 'Web)
+
+;===============================================================================
+; !Encoding and decoding
+;===============================================================================
+
+(define ENTITIES
+  (list
+    (list 34 {&quot;})       (list 38 {&amp;})        (list 39 {&apos;})       (list 60 {&lt;})
+    (list 62 {&gt;})         (list 160 {&nbsp;})      (list 161 {&iexcl;})     (list 162 {&cent;})
+    (list 163 {&pound;})     (list 164 {&curren;})    (list 165 {&yen;})       (list 166 {&brvbar;})
+    (list 167 {&sect;})      (list 168 {&uml;})       (list 169 {&copy;})      (list 170 {&ordf;})
+    (list 171 {&laquo;})     (list 172 {&not;})       (list 173 {&shy;})       (list 174 {&reg;})
+    (list 175 {&macr;})      (list 176 {&deg;})       (list 177 {&plusmn;})    (list 178 {&sup2;})
+    (list 179 {&sup3;})      (list 180 {&acute;})     (list 181 {&micro;})     (list 182 {&para;})
+    (list 183 {&middot;})    (list 184 {&cedil;})     (list 185 {&sup1;})      (list 186 {&ordm;})
+    (list 187 {&raquo;})     (list 188 {&frac14;})    (list 189 {&frac12;})    (list 190 {&frac34;})
+    (list 191 {&iquest;})    (list 192 {&Agrave;})    (list 193 {&Aacute;})    (list 194 {&Acirc;})
+    (list 195 {&Atilde;})    (list 196 {&Auml;})      (list 197 {&Aring;})     (list 198 {&AElig;}) 
+    (list 199 {&Ccedil;})    (list 200 {&Egrave;})    (list 201 {&Eacute;})    (list 202 {&Ecirc;})
+    (list 203 {&Euml;})      (list 204 {&Igrave;})    (list 205 {&Iacute;})    (list 206 {&Icirc;})
+    (list 207 {&Iuml;})      (list 208 {&ETH;})       (list 209 {&Ntilde;})    (list 210 {&Ograve;})
+    (list 211 {&Oacute;})    (list 212 {&Ocirc;})     (list 213 {&Otilde;})    (list 214 {&Ouml;})
+    (list 215 {&times;})     (list 216 {&Oslash;})    (list 217 {&Ugrave;})    (list 218 {&Uacute;})
+    (list 219 {&Ucirc;})     (list 220 {&Uuml;})      (list 221 {&Yacute;})    (list 222 {&THORN;})
+    (list 223 {&szlig;})     (list 224 {&agrave;})    (list 225 {&aacute;})    (list 226 {&acirc;})
+    (list 227 {&atilde;})    (list 228 {&auml;})      (list 229 {&aring;})     (list 230 {&aelig;})
+    (list 231 {&ccedil;})    (list 232 {&egrave;})    (list 233 {&eacute;})    (list 234 {&ecirc;})
+    (list 235 {&euml;})      (list 236 {&igrave;})    (list 237 {&iacute;})    (list 238 {&icirc;})
+    (list 239 {&iuml;})      (list 240 {&eth;})       (list 241 {&ntilde;})    (list 242 {&ograve;})
+    (list 243 {&oacute;})    (list 244 {&ocirc;})     (list 245 {&otilde;})    (list 246 {&ouml;})
+    (list 247 {&divide;})    (list 248 {&oslash;})    (list 249 {&ugrave;})    (list 250 {&uacute;})
+    (list 251 {&ucirc;})     (list 252 {&uuml;})      (list 253 {&yacute;})    (list 254 {&thorn;})
+    (list 255 {&yuml;})      (list 338 {&OElig;})     (list 339 {&oelig;})     (list 352 {&Scaron;})
+    (list 353 {&scaron;})    (list 376 {&Yuml;})      (list 402 {&fnof;})      (list 710 {&circ;})
+    (list 732 {&tilde;})     (list 913 {&Alpha;})     (list 914 {&Beta;})      (list 915 {&Gamma;})
+    (list 916 {&Delta;})     (list 917 {&Epsilon;})   (list 918 {&Zeta;})      (list 919 {&Eta;})
+    (list 920 {&Theta;})     (list 921 {&Iota;})      (list 922 {&Kappa;})     (list 923 {&Lambda;})
+    (list 924 {&Mu;})        (list 925 {&Nu;})        (list 926 {&Xi;})        (list 927 {&Omicron;})
+    (list 928 {&Pi;})        (list 929 {&Rho;})       (list 931 {&Sigma;})     (list 932 {&Tau;})
+    (list 933 {&Upsilon;})   (list 934 {&Phi;})       (list 935 {&Chi;})       (list 936 {&Psi;})
+    (list 937 {&Omega;})     (list 945 {&alpha;})     (list 946 {&beta;})      (list 947 {&gamma;})
+    (list 948 {&delta;})     (list 949 {&epsilon;})   (list 950 {&zeta;})      (list 951 {&eta;})
+    (list 952 {&theta;})     (list 953 {&iota;})      (list 954 {&kappa;})     (list 955 {&lambda;})
+    (list 956 {&mu;})        (list 957 {&nu;})        (list 958 {&xi;})        (list 959 {&omicron;})
+    (list 960 {&pi;})        (list 961 {&rho;})       (list 962 {&sigmaf;})    (list 963 {&sigma;})
+    (list 964 {&tau;})       (list 965 {&upsilon;})   (list 966 {&phi;})       (list 967 {&chi;})
+    (list 968 {&psi;})       (list 969 {&omega;})     (list 977 {&thetasym;})  (list 978 {&upsih;})
+    (list 982 {&piv;})       (list 8194 {&ensp;})     (list 8195 {&emsp;})     (list 8201 {&thinsp;})
+    (list 8204 {&zwnj;})     (list 8204 {&zwj;})      (list 8204 {&lrm;})      (list 8204 {&rlm;})
+    (list 8211 {&ndash;})    (list 8212 {&mdash;})    (list 8216 {&lsquo;})    (list 8217 {&rsquo;})
+    (list 8218 {&sbquo;})    (list 8220 {&ldquo;})    (list 8221 {&rdquo;})    (list 8222 {&bdquo;})
+    (list 8224 {&dagger;})   (list 8225 {&Dagger;})   (list 8226 {&bull;})     (list 8230 {&hellip;})
+    (list 8240 {&permil;})   (list 8242 {&prime;})    (list 8243 {&Prime;})    (list 8249 {&lsaquo;})
+    (list 8250 {&rsaquo;})   (list 8254 {&oline;})    (list 8260 {&frasl;})    (list 8364 {&euro;})
+    (list 8465 {&image;})    (list 8472 {&weierp;})   (list 8476 {&real;})     (list 8482 {&trade;})
+    (list 8501 {&alefsym;})  (list 8592 {&larr;})     (list 8593 {&uarr;})     (list 8594 {&rarr;})
+    (list 8595 {&darr;})     (list 8596 {&harr;})     (list 8629 {&crarr;})    (list 8656 {&lArr;})
+    (list 8657 {&uArr;})     (list 8658 {&rArr;})     (list 8659 {&dArr;})     (list 8660 {&hArr;})
+    (list 8704 {&forall;})   (list 8706 {&part;})     (list 8707 {&exist;})    (list 8709 {&empty;})
+    (list 8711 {&nabla;})    (list 8712 {&isin;})     (list 8713 {&notin;})    (list 8715 {&ni;})
+    (list 8719 {&prod;})     (list 8721 {&sum;})      (list 8722 {&minus;})    (list 8727 {&lowast;})
+    (list 8730 {&radic;})    (list 8733 {&prop;})     (list 8734 {&infin;})    (list 8736 {&ang;})
+    (list 8743 {&and;})      (list 8744 {&or;})       (list 8745 {&cap;})      (list 8746 {&cup;})
+    (list 8747 {&int;})      (list 8756 {&there4;})   (list 8764 {&sim;})      (list 8773 {&cong;})
+    (list 8776 {&asymp;})    (list 8800 {&ne;})       (list 8801 {&equiv;})    (list 8804 {&le;})
+    (list 8805 {&ge;})       (list 8834 {&sub;})      (list 8835 {&sup;})      (list 8836 {&nsub;})
+    (list 8838 {&sube;})     (list 8839 {&supe;})     (list 8853 {&oplus;})    (list 8855 {&otimes;})
+    (list 8869 {&perp;})     (list 8901 {&sdot;})     (list 8968 {&lceil;})    (list 8969 {&rceil;})
+    (list 8970 {&lfloor;})   (list 8971 {&rfloor;})   (list 9001 {&lang;})     (list 9002 {&rang;})
+    (list 9674 {&loz;})      (list 9824 {&spades;})   (list 9827 {&clubs;})    (list 9829 {&hearts;})
+    (list 9830 {&diams;})))
+
+(define UNENTITIES
+  (map reverse ENTITIES))
+
+(define JS_ESCAPE_CHARS
+  (list
+    (list {\} {\\})
+    (list {"} {\"})
+    (list {'} {\'})
+    (list "\n" {\n})
+    (list "\r" {\r})
+    (list "</" {<\/})))
+
+;; @syntax (Web:escape-js <str>)
+;; @param <str> a string to escape
+;; <p>Escapes a string for output in javascript. Does not encode entities;
+;; just prevents control characters from causing syntax errors in javascript.</p>
+(define (escape-js str)
+  (dolist (ch JS_ESCAPE_CHARS)
+    (replace (first ch) str (last ch)))
+  str)
+
+;; @syntax (Web:escape <str>)
+;; @param <str> a string to escape
+;; @return the escaped string
+;; <p>Escapes characters that are part of the (X)HTML and XML syntax to prevent
+;; characters from confusing browsers' parsing of markup. Escapes single and
+;; double quotes, ampersands, and left and right angle brackets
+;; ('&quot;', '&apos;', '&amp;', '&lt;', and '&gt;').</p>
+(define (escape str)
+  (replace {"} str {&quot;})
+  (replace {'} str {&apos;})
+  (replace {&} str {&amp;})
+  (replace {<} str {&lt;})
+  (replace {>} str {&gt;})
+  str)
+
+;; @syntax (Web:unescape <str>)
+;; @param <str> an entity-escaped string
+;; @return the unescaped string
+;; <p>Unescapes the basic (X)HTML and XML character entities in a string.</p>
+(define (unescape str)
+  (replace {&quot;} str {"})
+  (replace {&apos;} str {'})
+  (replace {&amp;} str {&})
+  (replace {&lt;} str {<})
+  (replace {&gt;} str {>})
+  str)
+
+;; @syntax (Web:encode-entities <str>)
+;; @param <str> a string to escape
+;; @return the escaped string
+;; <p>Escapes characters with a much larger set of character entities than
+;; 'escape' using a table derived from 
+;; @link http://en.wikipedia.org/wiki/List_of_XML_and_HTML_character_entity_references Wikipedia.
+(define (encode-entities str , ent (buf ""))
+  (dostring (c str)
+    (write-buffer buf
+      (if (setf ent (lookup c ENTITIES)) ent (char c))))
+  buf)
+
+;; @syntax (Web:decode-entities <str>)
+;; @param <str> an entity-encoded string
+;; @return the decoded string
+;; <p>Translates character entities to their character equivalents as well as
+;; numeric entities.</p>
+(define (decode-entities str)
+  (replace {&(\d+);} str (char (int $1)) 0)
+  (replace {(&\S+?;)} str (char (lookup $1 UNENTITIES)) 0))
+
+; Translates a single character into a hex-encoded string suitable for a URL.
+(define (hex-encode-char ch)
+  (if (= " " ch) "+" (format "%%%x" (char ch))))
+
+; Translates a URL-encoded hex into a string character.
+(define (hex-decode-char ch)
+  (when (starts-with ch "%")
+    (pop ch))
+  (char (int (string "0x" $1))))
+
+;; @syntax (Web:url-encode <str>)
+;; @param <str> a string token to encode for use in a URL
+;; @return the URL-encoded string
+;; <p>Encodes a string for use in a URL.</p>
+(constant 'REGEX_HTTP_SPECIAL_CHAR (regex-comp {([^-_.$+!*'()0-9a-z])} 1))
+
+(define (url-encode str)
+  (replace " " str "+")
+  (replace REGEX_HTTP_SPECIAL_CHAR str (hex-encode-char $1) 0x10000))
+
+;; @syntax (Web:url-decode <str>)
+;; @param <str> a URL-encoded string
+;; @return the decoded string
+;; <p>Decodes hexidecimals and spaces (represented as '+') in a URL-encoded string.</p>
+(constant 'REGEX_HEX_ENCODED_CHAR (regex-comp {%([0-9A-F][0-9A-F])} 1))
+
+(define (url-decode str)
+  (replace "+" str " ")
+  (replace REGEX_HEX_ENCODED_CHAR str (hex-decode-char $1) 0x10000))
+
+;; @syntax (Web:build-query <a-list>)
+;; @param <a-list> an association list
+;; @return a URL-encoded query string
+;; <p>Builds a URL-encoded query string using <a-list>. Does not include the leading
+;; question mark (so queries may be easily built of association list fragments.)</p>
+(define (build-query alist , query)
+  (join (map (fn (pair) (join (map url-encode pair) "=")) alist) "&"))
+
+;; @syntax (Web:parse-url <str-url>)
+;; @param <str-url> a URL
+;; @return an association list with the decomposed URL's parts
+;; <p>Parses a URL and returns an association list of its decomposed parts. The list's
+;; keys (as strings) are: scheme, user, pass, host, port, path, query, and fragment.
+;; Also handles IPV6 addresses. Modeled on the PHP function of the same name.</p>
+;; 
+;; Parsing based on code from @link http://us3.php.net/manual/en/function.parse-url.php#90365 this&nbsp;comment.
+(constant 'REGEX_URL
+  (regex-comp
+    [text]
+      (?:([a-z0-9+-._]+)://)?
+      (?:
+        (?:((?:[a-z0-9-._~!$&'()*+,;=:]|%[0-9a-f]{2})*)@)?
+        (?:\[((?:[a-z0-9:])*)\])?
+        ((?:[a-z0-9-._~!$&'()*+,;=]|%[0-9a-f]{2})*)
+        (?::(\d*))?
+        (/(?:[a-z0-9-._~!$&'()*+,;=:@/]|%[0-9a-f]{2})*)?
+        |
+        (/?
+          (?:[a-z0-9-._~!$&'()*+,;=:@]|%[0-9a-f]{2})+
+          (?:[a-z0-9-._~!$&'()*+,;=:@/]|%[0-9a-f]{2})*
+        )?
+      )
+      (?:\?((?:[a-z0-9-._~!$&'()*+,;=:/?@]|%[0-9a-f]{2})*))?
+      (?:\#((?:[a-z0-9-._~!$&'()*+,;=:/?@]|%[0-9a-f]{2})*))?
+    [/text]
+    (| 1 8)))
+
+(define (parse-url url)
+  ;; clear indices of previous matches
+  (dolist (idx '($0 $1 $2 $3 $4 $5 $6 $7 $8 $9))
+    (set idx nil))
+  (when (regex REGEX_URL url 0x10000)
+    (let ((user-pass (parse $2 ":")))
+      (list
+        (list "scheme" (if (null? $1) "http" $1))
+        (list "user" (when user-pass (first user-pass)))
+        (list "pass" (when (and user-pass (= (length user-pass) 2)) (last user-pass)))
+        (list "host" (if-not (null? $3) $3 $4))
+        (list "port" (if (null? $5) nil $5))
+        (list "path" (if (and (null? $6) (null? $7)) "/" (string $6 $7)))
+        (list "query" (if (null? $8) nil $8))
+        (list "fragment" (if (null? $9) nil $9))))))
+
+;; @syntax (Web:build-url <str-url> [<list-query-params> ...])
+;; @param <str-url> a string URL
+;; @param <list-query-params> one or more association lists of query parameters and their values
+;; 
+;; @syntax (Web:build-url <list-url> [<list-query-params> ...])
+;; @param <list-url> an association list of URL components using the structure of <parse-url>'s return value
+;; @param <list-query-params> one or more association lists of query parameters and their values
+;; @return a URL string composed of the initial URL data plus subsequently superseding query parameters
+;; <p>In the first syntax, builds a URL from an existing URL string.
+;; In the second syntax, builds a URL from an association list in the same
+;; format as the return value of <parse-url>, with both keys and values being
+;; strings. In both syntaxes, any number of additional association lists of
+;; key/value pairs may be passed, which are serialized as query parameters, with
+;; each list overriding the previous. If there are query parameters in the
+;; initial URL, they are used as the initial list with the lowest priority.</p>
+(define (build-url url)
+  (when (string? url)
+    (setf url (parse-url url)))
+
+  (local (params)
+    ;; Build parameter list
+    (setf params '())
+    (dolist (pairs (cons (lookup "query" url) (args)))
+      (when (string? pairs) (setf pairs (parse-query pairs)))
+      (dolist (pair pairs)
+        (if (assoc (first pair) params)
+          (setf (assoc (first pair) params) pair)
+          (push pair params))))
+    
+    (format "%s://%s%s%s%s%s%s"
+      (or (lookup "scheme" url) "http")
+      (cond
+        ((and (lookup "user" url) (lookup "pass" url))
+         (string (lookup "user" url) ":" (lookup "pass" url) "@"))
+        ((lookup "user" url)
+         (string (lookup "user" url) "@"))
+        (true ""))
+      (lookup "host" url)
+      (if (lookup "port" url) (string ":" (lookup "port" url)) "")
+      (lookup "path" url)
+      (if (null? params) "" (string "?" (build-query params)))
+      (if (lookup "fragment" url) (string "#" (lookup "fragment" url)) ""))))
+
+(context 'MAIN)

example-site/dragonfly-framework/plugins-inactive/path.lsp

-; TODO: implement string based and get rid of the class based
+; @author Greg Slepak
+; TODO: implement string based and get rid of the FOOP based
 
 ; (define (sanitize-path p)
 ; 	(replace {([^\\])?//} p "/" 0)

example-site/dragonfly-framework/plugins-inactive/web.lsp

-#!/usr/bin/newlisp
-;; @module Web
-;; @author Jeff Ober <jeffober@gmail.com>
-;; @version 0.3.1 beta
-;;
-;; Modifictations (in C-style) by Greg Slepak <greg at taoeffect.com>
-;; Based on version 0.3.1 beta by Jeff, located here:
-;; http://static.artfulcode.net/newlisp/web.lsp.html
-(context 'Web)
-
-;===============================================================================
-; !Encoding and decoding
-;===============================================================================
-
-(define ENTITIES
-  (list
-    (list 34 {&quot;})       (list 38 {&amp;})        (list 39 {&apos;})       (list 60 {&lt;})
-    (list 62 {&gt;})         (list 160 {&nbsp;})      (list 161 {&iexcl;})     (list 162 {&cent;})
-    (list 163 {&pound;})     (list 164 {&curren;})    (list 165 {&yen;})       (list 166 {&brvbar;})
-    (list 167 {&sect;})      (list 168 {&uml;})       (list 169 {&copy;})      (list 170 {&ordf;})
-    (list 171 {&laquo;})     (list 172 {&not;})       (list 173 {&shy;})       (list 174 {&reg;})
-    (list 175 {&macr;})      (list 176 {&deg;})       (list 177 {&plusmn;})    (list 178 {&sup2;})
-    (list 179 {&sup3;})      (list 180 {&acute;})     (list 181 {&micro;})     (list 182 {&para;})
-    (list 183 {&middot;})    (list 184 {&cedil;})     (list 185 {&sup1;})      (list 186 {&ordm;})
-    (list 187 {&raquo;})     (list 188 {&frac14;})    (list 189 {&frac12;})    (list 190 {&frac34;})
-    (list 191 {&iquest;})    (list 192 {&Agrave;})    (list 193 {&Aacute;})    (list 194 {&Acirc;})
-    (list 195 {&Atilde;})    (list 196 {&Auml;})      (list 197 {&Aring;})     (list 198 {&AElig;}) 
-    (list 199 {&Ccedil;})    (list 200 {&Egrave;})    (list 201 {&Eacute;})    (list 202 {&Ecirc;})
-    (list 203 {&Euml;})      (list 204 {&Igrave;})    (list 205 {&Iacute;})    (list 206 {&Icirc;})
-    (list 207 {&Iuml;})      (list 208 {&ETH;})       (list 209 {&Ntilde;})    (list 210 {&Ograve;})
-    (list 211 {&Oacute;})    (list 212 {&Ocirc;})     (list 213 {&Otilde;})    (list 214 {&Ouml;})
-    (list 215 {&times;})     (list 216 {&Oslash;})    (list 217 {&Ugrave;})    (list 218 {&Uacute;})
-    (list 219 {&Ucirc;})     (list 220 {&Uuml;})      (list 221 {&Yacute;})    (list 222 {&THORN;})
-    (list 223 {&szlig;})     (list 224 {&agrave;})    (list 225 {&aacute;})    (list 226 {&acirc;})
-    (list 227 {&atilde;})    (list 228 {&auml;})      (list 229 {&aring;})     (list 230 {&aelig;})
-    (list 231 {&ccedil;})    (list 232 {&egrave;})    (list 233 {&eacute;})    (list 234 {&ecirc;})
-    (list 235 {&euml;})      (list 236 {&igrave;})    (list 237 {&iacute;})    (list 238 {&icirc;})
-    (list 239 {&iuml;})      (list 240 {&eth;})       (list 241 {&ntilde;})    (list 242 {&ograve;})
-    (list 243 {&oacute;})    (list 244 {&ocirc;})     (list 245 {&otilde;})    (list 246 {&ouml;})
-    (list 247 {&divide;})    (list 248 {&oslash;})    (list 249 {&ugrave;})    (list 250 {&uacute;})
-    (list 251 {&ucirc;})     (list 252 {&uuml;})      (list 253 {&yacute;})    (list 254 {&thorn;})
-    (list 255 {&yuml;})      (list 338 {&OElig;})     (list 339 {&oelig;})     (list 352 {&Scaron;})
-    (list 353 {&scaron;})    (list 376 {&Yuml;})      (list 402 {&fnof;})      (list 710 {&circ;})
-    (list 732 {&tilde;})     (list 913 {&Alpha;})     (list 914 {&Beta;})      (list 915 {&Gamma;})
-    (list 916 {&Delta;})     (list 917 {&Epsilon;})   (list 918 {&Zeta;})      (list 919 {&Eta;})
-    (list 920 {&Theta;})     (list 921 {&Iota;})      (list 922 {&Kappa;})     (list 923 {&Lambda;})
-    (list 924 {&Mu;})        (list 925 {&Nu;})        (list 926 {&Xi;})        (list 927 {&Omicron;})
-    (list 928 {&Pi;})        (list 929 {&Rho;})       (list 931 {&Sigma;})     (list 932 {&Tau;})
-    (list 933 {&Upsilon;})   (list 934 {&Phi;})       (list 935 {&Chi;})       (list 936 {&Psi;})
-    (list 937 {&Omega;})     (list 945 {&alpha;})     (list 946 {&beta;})      (list 947 {&gamma;})
-    (list 948 {&delta;})     (list 949 {&epsilon;})   (list 950 {&zeta;})      (list 951 {&eta;})
-    (list 952 {&theta;})     (list 953 {&iota;})      (list 954 {&kappa;})     (list 955 {&lambda;})
-    (list 956 {&mu;})        (list 957 {&nu;})        (list 958 {&xi;})        (list 959 {&omicron;})
-    (list 960 {&pi;})        (list 961 {&rho;})       (list 962 {&sigmaf;})    (list 963 {&sigma;})
-    (list 964 {&tau;})       (list 965 {&upsilon;})   (list 966 {&phi;})       (list 967 {&chi;})
-    (list 968 {&psi;})       (list 969 {&omega;})     (list 977 {&thetasym;})  (list 978 {&upsih;})
-    (list 982 {&piv;})       (list 8194 {&ensp;})     (list 8195 {&emsp;})     (list 8201 {&thinsp;})
-    (list 8204 {&zwnj;})     (list 8204 {&zwj;})      (list 8204 {&lrm;})      (list 8204 {&rlm;})
-    (list 8211 {&ndash;})    (list 8212 {&mdash;})    (list 8216 {&lsquo;})    (list 8217 {&rsquo;})
-    (list 8218 {&sbquo;})    (list 8220 {&ldquo;})    (list 8221 {&rdquo;})    (list 8222 {&bdquo;})
-    (list 8224 {&dagger;})   (list 8225 {&Dagger;})   (list 8226 {&bull;})     (list 8230 {&hellip;})
-    (list 8240 {&permil;})   (list 8242 {&prime;})    (list 8243 {&Prime;})    (list 8249 {&lsaquo;})
-    (list 8250 {&rsaquo;})   (list 8254 {&oline;})    (list 8260 {&frasl;})    (list 8364 {&euro;})
-    (list 8465 {&image;})    (list 8472 {&weierp;})   (list 8476 {&real;})     (list 8482 {&trade;})
-    (list 8501 {&alefsym;})  (list 8592 {&larr;})     (list 8593 {&uarr;})     (list 8594 {&rarr;})
-    (list 8595 {&darr;})     (list 8596 {&harr;})     (list 8629 {&crarr;})    (list 8656 {&lArr;})
-    (list 8657 {&uArr;})     (list 8658 {&rArr;})     (list 8659 {&dArr;})     (list 8660 {&hArr;})
-    (list 8704 {&forall;})   (list 8706 {&part;})     (list 8707 {&exist;})    (list 8709 {&empty;})
-    (list 8711 {&nabla;})    (list 8712 {&isin;})     (list 8713 {&notin;})    (list 8715 {&ni;})
-    (list 8719 {&prod;})     (list 8721 {&sum;})      (list 8722 {&minus;})    (list 8727 {&lowast;})
-    (list 8730 {&radic;})    (list 8733 {&prop;})     (list 8734 {&infin;})    (list 8736 {&ang;})
-    (list 8743 {&and;})      (list 8744 {&or;})       (list 8745 {&cap;})      (list 8746 {&cup;})
-    (list 8747 {&int;})      (list 8756 {&there4;})   (list 8764 {&sim;})      (list 8773 {&cong;})
-    (list 8776 {&asymp;})    (list 8800 {&ne;})       (list 8801 {&equiv;})    (list 8804 {&le;})
-    (list 8805 {&ge;})       (list 8834 {&sub;})      (list 8835 {&sup;})      (list 8836 {&nsub;})
-    (list 8838 {&sube;})     (list 8839 {&supe;})     (list 8853 {&oplus;})    (list 8855 {&otimes;})
-    (list 8869 {&perp;})     (list 8901 {&sdot;})     (list 8968 {&lceil;})    (list 8969 {&rceil;})
-    (list 8970 {&lfloor;})   (list 8971 {&rfloor;})   (list 9001 {&lang;})     (list 9002 {&rang;})
-    (list 9674 {&loz;})      (list 9824 {&spades;})   (list 9827 {&clubs;})    (list 9829 {&hearts;})
-    (list 9830 {&diams;})))
-
-(define UNENTITIES
-  (map reverse ENTITIES))
-
-(define JS_ESCAPE_CHARS
-  (list
-    (list {\} {\\})
-    (list {"} {\"})
-    (list {'} {\'})
-    (list "\n" {\n})
-    (list "\r" {\r})
-    (list "</" {<\/})))
-
-;; @syntax (Web:escape-js <str>)
-;; @param <str> a string to escape
-;; <p>Escapes a string for output in javascript. Does not encode entities;
-;; just prevents control characters from causing syntax errors in javascript.</p>
-(define (escape-js str)
-  (dolist (ch JS_ESCAPE_CHARS)
-    (replace (first ch) str (last ch)))
-  str)
-
-;; @syntax (Web:escape <str>)
-;; @param <str> a string to escape
-;; @return the escaped string
-;; <p>Escapes characters that are part of the (X)HTML and XML syntax to prevent
-;; characters from confusing browsers' parsing of markup. Escapes single and
-;; double quotes, ampersands, and left and right angle brackets
-;; ('&quot;', '&apos;', '&amp;', '&lt;', and '&gt;').</p>
-(define (escape str)
-  (replace {"} str {&quot;})
-  (replace {'} str {&apos;})
-  (replace {&} str {&amp;})
-  (replace {<} str {&lt;})
-  (replace {>} str {&gt;})
-  str)
-
-;; @syntax (Web:unescape <str>)
-;; @param <str> an entity-escaped string
-;; @return the unescaped string
-;; <p>Unescapes the basic (X)HTML and XML character entities in a string.</p>
-(define (unescape str)
-  (replace {&quot;} str {"})
-  (replace {&apos;} str {'})
-  (replace {&amp;} str {&})
-  (replace {&lt;} str {<})
-  (replace {&gt;} str {>})
-  str)
-
-;; @syntax (Web:encode-entities <str>)
-;; @param <str> a string to escape
-;; @return the escaped string
-;; <p>Escapes characters with a much larger set of character entities than
-;; 'escape' using a table derived from 
-;; @link http://en.wikipedia.org/wiki/List_of_XML_and_HTML_character_entity_references Wikipedia.
-(define (encode-entities str , ent (buf ""))
-  (dostring (c str)
-    (write-buffer buf
-      (if (setf ent (lookup c ENTITIES)) ent (char c))))
-  buf)
-
-;; @syntax (Web:decode-entities <str>)
-;; @param <str> an entity-encoded string
-;; @return the decoded string
-;; <p>Translates character entities to their character equivalents as well as
-;; numeric entities.</p>
-(define (decode-entities str)
-  (replace {&(\d+);} str (char (int $1)) 0)
-  (replace {(&\S+?;)} str (char (lookup $1 UNENTITIES)) 0))
-
-; Translates a single character into a hex-encoded string suitable for a URL.
-(define (hex-encode-char ch)
-  (if (= " " ch) "+" (format "%%%x" (char ch))))
-
-; Translates a URL-encoded hex into a string character.
-(define (hex-decode-char ch)
-  (when (starts-with ch "%")
-    (pop ch))
-  (char (int (string "0x" $1))))
-
-;; @syntax (Web:url-encode <str>)
-;; @param <str> a string token to encode for use in a URL
-;; @return the URL-encoded string
-;; <p>Encodes a string for use in a URL.</p>
-(constant 'REGEX_HTTP_SPECIAL_CHAR (regex-comp {([^-_.$+!*'()0-9a-z])} 1))
-
-(define (url-encode str)
-  (replace " " str "+")
-  (replace REGEX_HTTP_SPECIAL_CHAR str (hex-encode-char $1) 0x10000))
-
-;; @syntax (Web:url-decode <str>)
-;; @param <str> a URL-encoded string
-;; @return the decoded string
-;; <p>Decodes hexidecimals and spaces (represented as '+') in a URL-encoded string.</p>
-(constant 'REGEX_HEX_ENCODED_CHAR (regex-comp {%([0-9A-F][0-9A-F])} 1))
-
-(define (url-decode str)
-  (replace "+" str " ")
-  (replace REGEX_HEX_ENCODED_CHAR str (hex-decode-char $1) 0x10000))
-
-;; @syntax (Web:build-query <a-list>)
-;; @param <a-list> an association list
-;; @return a URL-encoded query string
-;; <p>Builds a URL-encoded query string using <a-list>. Does not include the leading
-;; question mark (so queries may be easily built of association list fragments.)</p>
-(define (build-query alist , query)
-  (join (map (fn (pair) (join (map url-encode pair) "=")) alist) "&"))
-
-;; @syntax (Web:parse-url <str-url>)
-;; @param <str-url> a URL
-;; @return an association list with the decomposed URL's parts
-;; <p>Parses a URL and returns an association list of its decomposed parts. The list's
-;; keys (as strings) are: scheme, user, pass, host, port, path, query, and fragment.
-;; Also handles IPV6 addresses. Modeled on the PHP function of the same name.</p>
-;; 
-;; Parsing based on code from @link http://us3.php.net/manual/en/function.parse-url.php#90365 this&nbsp;comment.
-(constant 'REGEX_URL
-  (regex-comp
-    [text]
-      (?:([a-z0-9+-._]+)://)?
-      (?:
-        (?:((?:[a-z0-9-._~!$&'()*+,;=:]|%[0-9a-f]{2})*)@)?
-        (?:\[((?:[a-z0-9:])*)\])?
-        ((?:[a-z0-9-._~!$&'()*+,;=]|%[0-9a-f]{2})*)
-        (?::(\d*))?
-        (/(?:[a-z0-9-._~!$&'()*+,;=:@/]|%[0-9a-f]{2})*)?
-        |
-        (/?
-          (?:[a-z0-9-._~!$&'()*+,;=:@]|%[0-9a-f]{2})+
-          (?:[a-z0-9-._~!$&'()*+,;=:@/]|%[0-9a-f]{2})*
-        )?
-      )
-      (?:\?((?:[a-z0-9-._~!$&'()*+,;=:/?@]|%[0-9a-f]{2})*))?
-      (?:\#((?:[a-z0-9-._~!$&'()*+,;=:/?@]|%[0-9a-f]{2})*))?
-    [/text]
-    (| 1 8)))
-
-(define (parse-url url)
-  ;; clear indices of previous matches
-  (dolist (idx '($0 $1 $2 $3 $4 $5 $6 $7 $8 $9))
-    (set idx nil))
-  (when (regex REGEX_URL url 0x10000)
-    (let ((user-pass (parse $2 ":")))
-      (list
-        (list "scheme" (if (null? $1) "http" $1))
-        (list "user" (when user-pass (first user-pass)))
-        (list "pass" (when (and user-pass (= (length user-pass) 2)) (last user-pass)))
-        (list "host" (if-not (null? $3) $3 $4))
-        (list "port" (if (null? $5) nil $5))
-        (list "path" (if (and (null? $6) (null? $7)) "/" (string $6 $7)))
-        (list "query" (if (null? $8) nil $8))
-        (list "fragment" (if (null? $9) nil $9))))))
-
-;; @syntax (Web:build-url <str-url> [<list-query-params> ...])
-;; @param <str-url> a string URL
-;; @param <list-query-params> one or more association lists of query parameters and their values
-;; 
-;; @syntax (Web:build-url <list-url> [<list-query-params> ...])
-;; @param <list-url> an association list of URL components using the structure of <parse-url>'s return value
-;; @param <list-query-params> one or more association lists of query parameters and their values
-;; @return a URL string composed of the initial URL data plus subsequently superseding query parameters
-;; <p>In the first syntax, builds a URL from an existing URL string.
-;; In the second syntax, builds a URL from an association list in the same
-;; format as the return value of <parse-url>, with both keys and values being
-;; strings. In both syntaxes, any number of additional association lists of
-;; key/value pairs may be passed, which are serialized as query parameters, with
-;; each list overriding the previous. If there are query parameters in the
-;; initial URL, they are used as the initial list with the lowest priority.</p>
-(define (build-url url)
-  (when (string? url)
-    (setf url (parse-url url)))
-
-  (local (params)
-    ;; Build parameter list
-    (setf params '())
-    (dolist (pairs (cons (lookup "query" url) (args)))
-      (when (string? pairs) (setf pairs (parse-query pairs)))
-      (dolist (pair pairs)
-        (if (assoc (first pair) params)
-          (setf (assoc (first pair) params) pair)
-          (push pair params))))
-    
-    (format "%s://%s%s%s%s%s%s"
-      (or (lookup "scheme" url) "http")
-      (cond
-        ((and (lookup "user" url) (lookup "pass" url))
-         (string (lookup "user" url) ":" (lookup "pass" url) "@"))
-        ((lookup "user" url)
-         (string (lookup "user" url) "@"))
-        (true ""))
-      (lookup "host" url)
-      (if (lookup "port" url) (string ":" (lookup "port" url)) "")
-      (lookup "path" url)
-      (if (null? params) "" (string "?" (build-query params)))
-      (if (lookup "fragment" url) (string "#" (lookup "fragment" url)) ""))))
-
-(context 'MAIN)

example-site/foo/index.html

 			to a URL like <b>http://mysite.com/foo</b>, where "foo" is
 			a real directory (as opposed to a view or resource).
 		</p>
+		<p>
+			Value of cookie "foo" (reload page if nil): <%=($COOKIES "foo")%>
+			
+			<% (Response:cookie "foo" (amb "foo" "bar" "baz")) %>
+		</p>
 		<div class="line-dotted"></div>
 
 		<% (benchmark-result) %>

example-site/resources/wings.lsp

+;; @author Greg Slepak
+
+(DF:activate-plugin "artfulcode/json")
+
+(context 'Resource.Wings)
+
+(set 'my-data
+  '((wings (left right))
+	(wings-condition ("good" "excellent"))
+	(wings-opacity 0.5))
+)
+
+(define (Resource.Wings:Resource.Wings response-format)
+	; defaults to calling show
+	(show response-format)
+)
+
+(define (show response-format)
+	(if (= response-format "json")
+		(begin
+			(Response:content-type Response:json-type)
+			(print (Json:lisp->json my-data))
+		)
+		(begin
+			(Response:content-type Response:text-type)
+			(print my-data)
+		)
+	)
+)
+
+(context MAIN)

example-site/views/partials/navigation

 <ul>
 	<li><% (link_to "Welcome" "welcome" "index") %></li>
 	<li>
-	<a href="index.html" onclick="toggleMenu(); return false;" id="guidesMenu">User Guide</a>
+	<a href="#" onclick="toggleMenu(); return false;" id="guidesMenu">User Guide</a>
 	
 	          <div id="menu" class="clearfix" style="display:none;">
 	            <dl class="L">
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.