Commits

Greg Slepak committed abe9f78

on the road to 0.7, updated to work with changes in newlisp 10.1.10 and 10.1.11

  • Participants
  • Parent commits 401666e

Comments (0)

Files changed (15)

-Version 0.6.1
+Version 0.7
 
+  * all code uses new ++,--,extend,write,read functions (still compatible with older newlisps)
   * now $BINARY can handle large data (compensated for a newLISP bug in 'read-buffer').
   * added documentation for MAX_POST_LENGTH in request.lsp
   * fix to Jeff's JSON.lsp plugin (switched to " instead of ' for strings)

example-site/dragonfly-framework/dragonfly.lsp

 ;; @module dragonfly.lsp
 ;; @description The heart of Dragonfly - A newLISP web framework for rapid web development.
-;; @version 0.50
+;; @version 0.70
 ;; @author Team Dragonfly 2009
 ;; @location http://code.google.com/p/dragonfly-newlisp/
 ;; <br>This file is the main entry-point of the Dragonfly framework and
 
 
 ;===============================================================================
+; !Compatibility with older versions of newLISP
+;===============================================================================
+
+(when (< (sys-info -2) 10110)
+	(constant (global '++) inc)
+	(constant (global '--) dec)
+	(constant (global 'extend) write-buffer)
+)
+(when (< (sys-info -2) 10111)
+	(constant (global 'term) name)
+	(constant (global 'read) read-buffer)
+	(constant (global 'write) write-buffer)
+) 
+
+;===============================================================================
 ; !Basic Setup, Global Vars, and Sanity Checks
 ;===============================================================================
 
 ;; evaluated, and the result, along with the text outside of the "code islands" will be sent if no errors occur.
 (define (eval-template str (ctx Dragonfly) , start end block (buf ""))
 	(while (and (setf start (find OPEN_TAG str)) (setf end (find CLOSE_TAG str)))
-		(write-buffer buf (string "(print [text]" (slice str 0 start) "[/text])"))
+		(extend buf (string "(print [text]" (slice str 0 start) "[/text])"))
 		(setf block (slice str (+ start 2) (- end start 2)))
 		(if (starts-with block "=")
-			(write-buffer buf (string "(print " (rest block) ")"))
-			(write-buffer buf block)
+			(extend buf (string "(print " (rest block) ")"))
+			(extend buf block)
 		)
 		(setf str (slice str (+ end 2)))
 	)
 	(when str
-		(write-buffer buf (string "(print [text]" str "[/text])"))
+		(extend buf (string "(print [text]" str "[/text])"))
 		(eval-string buf ctx)
 	)
 )

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

 ;; <p>The returned object <b>must</b> be deallocated using the 'deallocate'
 ;; function.</p>
 (define (instantiate class)
-	(letn (	obj-sym	(sym (string class "#" (inc class:@instance-counter)))
+	(letn (	obj-sym	(sym (string class "#" (++ class:@instance-counter)))
 			obj		(new class obj-sym)
 		)
 		; set these prior to calling the constructor
 ;; @syntax (retain <ctx-obj>)
 ;; <p>Increment's <ctx-obj>&apos;s retain count and returns the object.</p>
 (define (retain obj)
-	(inc obj:@rc)
+	(++ obj:@rc)
 	obj
 )
 
 ;; @syntax (release <ctx-obj>)
 ;; <p>Decrement's <ctx-obj>&apos;s retain count. Deallocates the object if the retain count hits zero.</p>
 (define (release obj)
-	(when (zero? (dec obj:@rc))
+	(when (zero? (-- obj:@rc))
 		(deallocate obj)
 	)
 )

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

 	)
 )
 
-; we can't simply do: (read-buffer (device) $BINARY MAX_POST_LENGTH)
+; we can't simply do: (read (device) $BINARY MAX_POST_LENGTH)
 ; because versions of newlisp (upto and including 10.1.9) have a fairly
 ; broken 'read-buffer' function that can't handle large amounts of data.
 ; this may be fixed in a future version of newLISP, but for now we're doing
 ; it the C-way.
 (define (handle-binary-data , (chunk "") (chunk-size 8192) (max-bytes MAX_POST_LENGTH) read)
-	(while (and (setf read (read-buffer (device) chunk chunk-size)) chunk (not (zero? max-bytes)))
-		(write-buffer $BINARY chunk)
-		(dec max-bytes read)
+	(while (and (setf read (read (device) chunk chunk-size)) chunk (not (zero? max-bytes)))
+		(extend $BINARY chunk)
+		(-- max-bytes read)
 		(when (< max-bytes chunk-size) (setf chunk-size max-bytes))
 	)
 )
 
 (define (handle-multipart-data , buff boundary)
 	(set 'boundary (regex-captcha {boundary=(.+)} CONTENT_TYPE))	
-	(while (read-buffer (device) buff MAX_POST_LENGTH boundary)
+	(while (read (device) buff MAX_POST_LENGTH boundary)
 		(parse-multipart-chunk buff)
 	)
 )
 		(handle-binary-data)
 		(and (setf temp CONTENT_TYPE) (starts-with temp "multipart/form-data"))
 		(handle-multipart-data)
-		(and (read-buffer (device) temp MAX_POST_LENGTH) temp)
+		(and (read (device) temp MAX_POST_LENGTH) temp)
 		(dolist (pair (parse-query temp))
 			(add-keyvalue-to-ctx (first pair) (last pair) $POST)
 		)

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

 ; these parameters must match the order in the 'cookie' function.
 (define (format-cookie key value expires path domain http-only)
 	(let (cookie (string key "=" value))
-		(if expires (write-buffer cookie (string "; expires=" (date expires 0 "%a, %d %b %Y %H:%M:%S %Z"))))
-		(if path (write-buffer cookie (string "; path=" path)))
-		(if domain (write-buffer cookie (string "; domain=" domain)))
+		(if expires (extend cookie (string "; expires=" (date expires 0 "%a, %d %b %Y %H:%M:%S %Z"))))
+		(if path (extend cookie (string "; path=" path)))
+		(if domain (extend cookie (string "; domain=" domain)))
 		cookie
 	)
 )

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

 	)
 	
 	(define (Dragonfly:print)
-		(write-buffer Dragonfly:STDOUT (apply string $args))
+		(extend Dragonfly:STDOUT (apply string $args))
 		(last $args) ; to behave the same way as print
 	)
 	
 ;;     (fn () (unless (apply wrapped-func $args)
 ;;         (throw-error (string "execute-update failed: " $args)))))</pre>
 	(define-macro (wrap-func func-sym wrapper , wrapped-func)
-		(setf wrapped-func (sym (string func-sym "|wrapped#" (inc wrap-func.counter))))
+		(setf wrapped-func (sym (string func-sym "|wrapped#" (++ wrap-func.counter))))
 		(set wrapped-func (eval func-sym))
 		(set func-sym (eval (expand wrapper 'wrapped-func)))
 	)

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

   (if-not (and (string? method) (find (upper-case method) '("GET" "POST" "HEAD" "PUT")))
 	  (throw-error "Invalid or unimplemented HTTP method"))
   (setf method (upper-case method))
-  (write-buffer buf (format "%s %s HTTP/1.0\r\n" method (string path)))
+  (extend buf (format "%s %s HTTP/1.0\r\n" method (string path)))
   (dolist (header headers)
-    (write-buffer buf (format "%s\r\n" (format-header header))))
+    (extend buf (format "%s\r\n" (format-header header))))
   (when content
-		(write-buffer buf (format "Content-Length: %d\r\n\r\n" (length content)))
-		(write-buffer buf content))
-  (write-buffer buf "\r\n\r\n")
+		(extend buf (format "Content-Length: %d\r\n\r\n" (length content)))
+		(extend buf content))
+  (extend buf "\r\n\r\n")
   buf)
 
 (context MAIN)

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

     (until (empty? (setf c (pop text)))
       (if (and (= c quot) (not escaped))
         (throw $idx)
-        (write-buffer str c))
+        (extend str c))
       (setf escaped (and (not $it) (= c {\})))))
   (list str text))
 
   (dolist (tok tokens)
     (case tok
       (OPEN_BRACKET
-        (inc depth)
+        (++ depth)
         (push (list) tree loc)
         (push -1 loc))
       (OPEN_BRACE
-        (inc depth)
+        (++ depth)
         (push (list) tree loc)
         (push -1 loc))
       (CLOSE_BRACKET
-        (dec depth)
+        (-- depth)
         (pop loc))
       (CLOSE_BRACE
-        (dec depth)
+        (-- depth)
         (pop loc))
       (COLON
         (push (list (pop tree loc)) tree loc)

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

 ;; => '(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)
+  (until (= (++ i) size)
     (setf (arr i) (fun)))
   arr)
 
 ;; 6
 (define (array-iter fun arr , size i)
   (setf i -1 size (length arr))
-  (until (= (inc i) size)
+  (until (= (++ i) size)
     (fun (arr i))))
 
 (global 'array-iter)
 (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)
+    (until (= (++ i) size)
       (setf (arr i) (fun $it)))))
 
 (global 'array-map)

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

 ;; @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
+    (extend buf
       (if (setf ent (lookup c ENTITIES)) ent (char c))))
   buf)
 

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

 
 
 
-(define (html:html str) (write-buffer cv:body-html str))
+(define (html:html str) (extend cv:body-html str))
 
 (context 'cv)
 
 	(let ( (buff "") (rec nil))
 		(while (set 'rec (pop lst))
 			(if (= (length rec) 6)
-				(write-buffer buff (string ",'B'," (join (map string rec) ","))))
+				(extend buff (string ",'B'," (join (map string rec) ","))))
 			(if (= (length rec) 2)
-				(write-buffer buff (string ",'L'," (rec 0) "," (rec 1)))))
+				(extend buff (string ",'L'," (rec 0) "," (rec 1)))))
 		(1 buff)
 ) )
 	

example-site/dragonfly-framework/plugins-inactive/db/database_sqlite3.lsp

 
 (define (binding-strategy-incremental stmt param)
 	(if stmt
-		(bind-param-at-index stmt param (inc .bsi-idx))
+		(bind-param-at-index stmt param (++ .bsi-idx))
 		(set '.bsi-idx 0) ; reset it
 	)
 )

example-site/dragonfly-framework/plugins-inactive/db/database_utils.lsp

 
 ; define-smacro defined in utils.lsp (part of Dragonfly's core functions)
 (define-smacro (for-query-with-db db query)
-	(letn (db (eval db) sql (db:prepare-sql (eval query)) keys '())
+	(letn (db (eval db) sql (db:prepare-sql (eval query)) keys '() ctx (prefix (caller)))
+		;(println ctx " vs " (prefix (caller)))
 		(dotimes (i (sql:col-count))
-			(push (sym (upper-case (sql:col-name i)) (prefix (caller))) keys -1)
+			;(push (sym (upper-case (sql:col-name i)) (prefix (caller))) keys -1)
+			;(push (sym (upper-case (sql:col-name i)) ctx) keys -1)
+			(push (sym (upper-case (sql:col-name i)) Dragonfly) keys -1)
 		)
 		(push-autorelease-pool) ; in case we have blobs
 		(while (list? (setf values (sql:next-row)))
 		(pop-autorelease-pool)
 	)
 )
-; backwards compatibility with newLISP < 10.1.11
-(unless (global? 'prefix)
-	(setf for-query-with-db:prefix (fn-macro () 'DF))
-)

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

 ;;
 ;; @module Dragonfly
 ;; @author Marc Hildmann <marc.hildmann at gmail.com>, Greg Slepak <greg at taoeffect.com>
-;; @version 0.50
+;; @version 0.70
 ;; 
 ;; @location http://code.google.com/p/dragonfly-newlisp/
 ;; @description A newLISP web framework for rapid web development

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

 ;;
 ;; @module Dragonfly Twitter search plugin
 ;; @author Marc Hildmann <marc.hildmann at gmail.com>
-;; @version 0.50
+;; @version 0.70
 ;; 
 ;; @location http://code.google.com/p/dragonfly-newlisp/
 ;; @description A newLISP web framework for rapid web development