Overview
Comment:Merged in some minor fixes from porting
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: bd24408c027868b35b2d1473dae68385c6d8b725
User & Date: matt on 2011-10-05 03:36:55
Other Links: manifest | tags
Context
2012-03-17
06:50
Updated template, lots of change due to move to chicken4.7 check-in: 73e724b31f user: matt tags: trunk
2011-10-05
03:36
Merged in some minor fixes from porting check-in: bd24408c02 user: matt tags: trunk
03:35
few more fixes from porting Leaf check-in: 562f01e7e5 user: matt tags: move-to-ck4.7.x
2011-10-04
14:42
Merged changes for chicken4.7 to trunk check-in: fda7f57df0 user: mrwellan tags: trunk
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Modified formdat.scm from [05ad5e414c] to [24de706a4e].

︙
157
158
159
160
161
162
163

164
165
166
167
168
169
170

157
158
159
160
161
162
163
164
165
166
167
168
169
170
171








+








	(formdat:load-all-port (current-input-port)))))

;; (s:process-cgi-input (caaar dat))
(define (formdat:load-all-port inp)
  (let* ((formdat        (make-formdat:formdat)))
;;	 (debugp         (open-output-file (conc (slot-ref s:session 'sroot) "/delme-" (current-user-id) ".log"))))
    ;; (write-string (read-string #f inp) #f debugp)
    (formdat:initialize formdat)
    (let ((alldats (formdat:dat->list inp 10e6)))
      
      ;; (format debugp "formdat : alldats: ~A\n" alldats)
      (let ((firstitem   (car alldats))
	    (multipass #f)) 
	(if (not (null? firstitem))
	    (if (string-match formdat:delim-patt-rex (caar firstitem))
︙

Modified setup.scm from [5a10d6d9bf] to [daa8cad43d].

︙
30
31
32
33
34
35
36
37

38
39
40
41
42
43
44

30
31
32
33
34
35
36

37
38
39
40
41
42
43
44








-
+









(define (s:log . msg)
  (apply session:log s:session msg))

(session:get-vars s:session)

(define (s:set-err . args)
  (sdat-set-curr-err s:session args))
  (sdat-set-curr-err! s:session args))

;; Usage: (s:get-err s:big)
(define (s:get-err wrapperfunc)
  (let ((errmsg (sdat-get-curr-err s:session)))
    (if errmsg ((if wrapperfunc
                    wrapperfunc
                    s:strong) errmsg) '())))
︙

Modified sqltbl.scm from [39c7ffe769] to [29093c83c7].

︙
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40


















41
42
43
44
45
46
47

16
17
18
19
20
21
22


















23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47








-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+








;;    curr-row-ptr ;; number of the current row
;;    curr-row     ;; the current row vector (?? do we really want this ??)
;;    ))

(declare (unit sqltbl))

(define (make-sqltbl:tbl)(make-vector 9))
(define-inline (sqltbl:tbl-get-rows           vec)    (vector-ref  vec 0))
(define-inline (sqltbl:tbl-get-fields         vec)    (vector-ref  vec 1))
(define-inline (sqltbl:tbl-get-fields-hash    vec)    (vector-ref  vec 2))
(define-inline (sqltbl:tbl-get-query          vec)    (vector-ref  vec 3))
(define-inline (sqltbl:tbl-get-query-params   vec)    (vector-ref  vec 4))
(define-inline (sqltbl:tbl-get-conn           vec)    (vector-ref  vec 5))
(define-inline (sqltbl:tbl-get-num-rows       vec)    (vector-ref  vec 6))
(define-inline (sqltbl:tbl-get-curr-row-ptr   vec)    (vector-ref  vec 7))
(define-inline (sqltbl:tbl-get-curr-row       vec)    (vector-ref  vec 8))
(define-inline (sqltbl:tbl-set-rows!          vec val)(vector-set! vec 0 val))
(define-inline (sqltbl:tbl-set-fields!        vec val)(vector-set! vec 1 val))
(define-inline (sqltbl:tbl-set-fields-hash!   vec val)(vector-set! vec 2 val))
(define-inline (sqltbl:tbl-set-query!         vec val)(vector-set! vec 3 val))
(define-inline (sqltbl:tbl-set-query-params!  vec val)(vector-set! vec 4 val))
(define-inline (sqltbl:tbl-set-conn!          vec val)(vector-set! vec 5 val))
(define-inline (sqltbl:tbl-set-num-rows!      vec val)(vector-set! vec 6 val))
(define-inline (sqltbl:tbl-set-curr-row-ptr!  vec val)(vector-set! vec 7 val))
(define-inline (sqltbl:tbl-set-curr-row!      vec val)(vector-set! vec 8 val))
(define (sqltbl:tbl-get-rows           vec)    (vector-ref  vec 0))
(define (sqltbl:tbl-get-fields         vec)    (vector-ref  vec 1))
(define (sqltbl:tbl-get-fields-hash    vec)    (vector-ref  vec 2))
(define (sqltbl:tbl-get-query          vec)    (vector-ref  vec 3))
(define (sqltbl:tbl-get-query-params   vec)    (vector-ref  vec 4))
(define (sqltbl:tbl-get-conn           vec)    (vector-ref  vec 5))
(define (sqltbl:tbl-get-num-rows       vec)    (vector-ref  vec 6))
(define (sqltbl:tbl-get-curr-row-ptr   vec)    (vector-ref  vec 7))
(define (sqltbl:tbl-get-curr-row       vec)    (vector-ref  vec 8))
(define (sqltbl:tbl-set-rows!          vec val)(vector-set! vec 0 val))
(define (sqltbl:tbl-set-fields!        vec val)(vector-set! vec 1 val))
(define (sqltbl:tbl-set-fields-hash!   vec val)(vector-set! vec 2 val))
(define (sqltbl:tbl-set-query!         vec val)(vector-set! vec 3 val))
(define (sqltbl:tbl-set-query-params!  vec val)(vector-set! vec 4 val))
(define (sqltbl:tbl-set-conn!          vec val)(vector-set! vec 5 val))
(define (sqltbl:tbl-set-num-rows!      vec val)(vector-set! vec 6 val))
(define (sqltbl:tbl-set-curr-row-ptr!  vec val)(vector-set! vec 7 val))
(define (sqltbl:tbl-set-curr-row!      vec val)(vector-set! vec 8 val))

(define  (sqltbl:initialize self);; initargs)
  (sqltbl:tbl-set-num-rows! self 0)
  (sqltbl:tbl-set-curr-row-ptr! self 0)
  (sqltbl:tbl-set-fields! self '())
  (sqltbl:tbl-set-fields-hash! self (make-hash-table)))
  ;; (initialize-slots self initargs))
︙

Modified stml.scm from [73cbc6a3f2] to [e67e34e067]. 

1
2
3
4
5
6
7
8
9
10
11
12
13

14
15
16
17
18
19
20

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21














+








;; Copyright 2007-2011, Matthew Welland.
;; 
;;  This program is made available under the GNU GPL version 2.0 or
;;  greater. See the accompanying file COPYING for details.
;; 
;;  This program is distributed WITHOUT ANY WARRANTY; without even the
;;  implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
;;  PURPOSE.

;; stml is a list of html strings

(declare (unit stml))
(declare (uses misc-stml))
(require-extension regex)

;; extract various tokens from the parameter list
;;   'key val => put in the params list
;;   strings  => maintain order and add to the datalist <<== IMPORTANT
(define (s:extract inlst)
  (if (null? inlst) inlst
      (let loop ((data '())
︙