Differences From Artifact [e1ef9f0955]:

To Artifact [8a3d5fca7a]:


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")))