157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
|
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)))
;; (print "configdat: ")(pp configdat)
(domain (s:find-param 'domain configdat))
(page-dir (s:find-param 'page-dir-style configdat)))
;; (print "sroot: " sroot " logfile: " logfile " dbtype: " dbtype " dbinit: " dbinit " domain: " domain)
(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))))
(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
|
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
584
585
586
587
588
589
590
591
592
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
|
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.:
;; 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 (map
(lambda (x)
(cond
((list? x) x)
((string? x) x)
(else '())))
(port-map eval (lambda ()(read p))))))
(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)
;; (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")))
|