Overview
Comment: | Minor porting and debugging tweaks |
---|---|
Downloads: | Tarball | ZIP archive | SQL archive |
Timelines: | family | ancestors | descendants | both | move-to-ck4.7.x |
Files: | files | file ages | folders |
SHA1: |
471f3f93257eb5cde33076049d2ea578 |
User & Date: | matt on 2011-10-04 02:56:40 |
Other Links: | branch diff | manifest | tags |
Context
2011-10-04
| ||
02:58 | couple files to help recreate the eval problem check-in: 2be28d85ad user: matt tags: move-to-ck4.7.x | |
02:56 | Minor porting and debugging tweaks check-in: 471f3f9325 user: matt tags: move-to-ck4.7.x | |
2011-10-03
| ||
00:52 | 99% ported to chicken-scheme v4.7 check-in: 1086107010 user: matt tags: move-to-ck4.7.x | |
Changes
Modified session.scm from [e1ef9f0955] to [8a3d5fca7a].
︙ | ︙ | |||
157 158 159 160 161 162 163 | (sdat-set-domain! self "locahost") ;; end of defaults (let* ((rawconfigdat (session:read-config self)) (configdat (if rawconfigdat (eval rawconfigdat) '())) (sroot (s:find-param 'sroot configdat)) (logfile (s:find-param 'logfile configdat)) (dbtype (s:find-param 'dbtype configdat)) (dbinit (s:find-param 'dbinit configdat)) | | | < | > > > > > > | 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 | (sdat-set-domain! self "locahost") ;; end of defaults (let* ((rawconfigdat (session:read-config self)) (configdat (if rawconfigdat (eval rawconfigdat) '())) (sroot (s:find-param 'sroot configdat)) (logfile (s:find-param 'logfile configdat)) (dbtype (s:find-param 'dbtype configdat)) (dbinit (s:find-param 'dbinit configdat)) (domain (s:find-param 'domain configdat)) (page-dir (s:find-param 'page-dir-style configdat))) (if sroot (sdat-set-sroot! self sroot)) (if logfile (sdat-set-logfile! self logfile)) (if dbtype (sdat-set-dbtype! self dbtype)) (if dbinit (sdat-set-dbinit! self dbinit)) (if domain (sdat-set-domain! self domain)) (sdat-set-page-dir-style! self page-dir) ;; (print "configdat: ")(pp configdat) ;;(session:log self "sroot: " sroot " logfile: " logfile " dbtype: " dbtype ;; " dbinit: " dbinit " domain: " domain " page-dir-style: " page-dir) ) ) ;; (let ((dbtype (sdat-get-dbtype self))) ;; (print "dbtype: " dbtype) ;; (sdat-set-dbtype! self (eval dbtype)))) (define (session:setup self) (let ((dbtype (sdat-get-dbtype self)) (dbinit (eval (sdat-get-dbinit self))) |
︙ | ︙ | |||
544 545 546 547 548 549 550 551 552 553 554 555 556 557 | (let ((p (open-input-file f))) (let loop ((hed (read-line p)) (res '())) (if (eof-object? hed) res (loop (read-line p)(append res (list hed))))))) ;; May 2011, putting all pages into one directory for the following reasons: ;; 1. want filename to reflect page name (emacs limitation) ;; 2. that's it! no other reason. could make it configurable ... (define (session:call-parts self page parts) (sdat-set-curr-page! self page) ;; (session:log self "page-dir-style: " (sdat-get-page-dir-style self)) (let* ((dir-style ;; (equal? (sdat-get-page-dir-style self) "onedir")) ;; flag #t for onedir, #f for old style | > > > > > > > > > > > > | 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 | (let ((p (open-input-file f))) (let loop ((hed (read-line p)) (res '())) (if (eof-object? hed) res (loop (read-line p)(append res (list hed))))))) (define (process-port p) (let ((e (interaction-environment))) (map (lambda (x) (cond ((list? x) x) ((string? x) x) (else '()))) (port-map (lambda (s) (eval s e)) (lambda ()(read p)))))) ;; May 2011, putting all pages into one directory for the following reasons: ;; 1. want filename to reflect page name (emacs limitation) ;; 2. that's it! no other reason. could make it configurable ... (define (session:call-parts self page parts) (sdat-set-curr-page! self page) ;; (session:log self "page-dir-style: " (sdat-get-page-dir-style self)) (let* ((dir-style ;; (equal? (sdat-get-page-dir-style self) "onedir")) ;; flag #t for onedir, #f for old style |
︙ | ︙ | |||
576 577 578 579 580 581 582 583 | ;; (print "dir=" dir " control=" control " view=" view " load-view=" load-view " load=control=" load-control) (if load-control (begin (load control) (session:set-called! self page))) ;; move this to where it gets exectuted only once ;; (if load-view | > | | > | | | | | | | | | 593 594 595 596 597 598 599 600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 | ;; (print "dir=" dir " control=" control " view=" view " load-view=" load-view " load=control=" load-control) (if load-control (begin (load control) (session:set-called! self page))) ;; move this to where it gets exectuted only once ;; ;;(s:log "s:b yields " (s:b "blah")) (if load-view ;; option one: ;; ;; (let ((inp (open-input-string ;; (files-read->string "/home/matt/kiatoa/stml/sugar.scm" ;; view)))) ;; (map ;; (lambda (x) ;; (cond ;; ((list? x) x) ;; ((string? x) x) ;; (else '()))) ;; (port-map eval (lambda () ;; (read inp))))) ;; ;; option two: ;; (let* (;; (inps (map open-input-file (list view))) ;; sugar view))) (p (open-input-file view)) ;; (apply make-concatenated-port inps)) (dat (process-port p))) ;;(map ;; (lambda (x) ;; (cond ;; ((list? x) x) ;; ((string? x) x) ;; (else '()))) ;; (port-map eval (lambda ()(read p)))))) ;; (map close-input-port inps) (close-input-port p) dat) (list "<p>Page not found " page " </p>")))) ;;(define (session:call self page) ;; (session:call-parts self page 'both)) (define (session:call self page parts) (session:call-parts self page 'both)) (define (session:load-model self model) (let ((model.scm (string-append (sdat-get-sroot self) "/models/" model ".scm")) (model.so (string-append (sdat-get-sroot self) "/models/" model ".so"))) |
︙ | ︙ |
Modified setup.scm from [0bb860ef3f] to [b19d687f24].
︙ | ︙ | |||
42 43 44 45 46 47 48 | (sdat-get-page s:session)) (define (s:delete-session) (session:delete-session s:session (sdat-get-session-key s:session))) (define (s:call page . partsl) (if (null? partsl) | | | 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 | (sdat-get-page s:session)) (define (s:delete-session) (session:delete-session s:session (sdat-get-session-key s:session))) (define (s:call page . partsl) (if (null? partsl) (session:call s:session page #f) (session:call s:session page (car partsl)))) (define (s:link-to page . params) (session:link-to s:session page params)) (define (s:get-param key) (session:get-param s:session key)) |
︙ | ︙ |