570
571
572
573
574
575
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
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
|
(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
(sdat-get-page-dir-style self))
(dir (string-append (sdat-get-sroot self)
(if dir-style
(conc "/pages/")
(conc "/pages/" page))))
(control (string-append dir (if dir-style
(conc page "_ctrl.scm")
"/control.scm")))
(view (string-append dir (if dir-style
(conc page "_view.scm")
"/view.scm")))
(load-view (and (file-exists? view)
(or (eq? parts 'both)(eq? parts 'view))))
(load-control (and (file-exists? control)
(or (eq? parts 'both)(eq? parts 'control))))
(view-dat '()))
;; (session:log self "dir-style: " dir-style)
;; (sugar "/home/matt/kiatoa/stml/sugar.scm" ))
;; (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")))
(if (file-exists? model.so)
(load model.so)
(if (file-exists? model.scm)
(load model.scm)
(s:log "ERROR: model " model.scm " not found")))))
(define (session:model-path self model)
(string-append (sdat-get-sroot self) "/models/" model ".scm"))
(define (session:pp-formdat self)
(let ((dat (formdat:all->strings (sdat-get-formdat self))))
(string-intersperse dat "<br> ")))
(define (session:param->string params)
;; (err:log "params=" params)
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
|
|
<
|
|
|
|
|
<
|
|
<
<
<
<
<
<
<
<
<
<
<
|
|
<
<
<
<
<
<
<
|
>
|
|
|
<
|
|
|
|
<
<
<
<
<
<
<
|
<
<
<
<
<
<
<
<
<
<
|
|
|
<
>
|
|
|
|
|
|
|
|
|
|
|
570
571
572
573
574
575
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
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
|
(cond
((list? x) x)
((string? x) x)
(else '())))
(port-map (lambda (s)
(eval s e))
(lambda ()(read p))))))
(define (session:process-file f)
(let* ((p (open-input-file f))
(dat (process-port p)))
(close-input-port p)
dat))
;; 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 ...
;; page-dir-style is:
;; 'stored => stored in executable
;; 'flat => pages flat directory
;; 'dir => directory tree pages/<pagename>/{view,control}.scm
;; parts:
;; 'both => load control and view (anything other than view or control
;; 'view => load view only
;; 'control => load control only
(define (session:call-parts self page #!key (parts 'both))
(sdat-set-curr-page! self page)
(session:log self "page-dir-style: " (sdat-get-page-dir-style self))
(let* ((dir-style (sdat-get-page-dir-style self));; (equal? (sdat-get-page-dir-style self) "onedir")) ;; flag #t for onedir, #f for old style
(dir (string-append (sdat-get-sroot self)
(if dir-style
(conc "/pages/")
(conc "/pages/" page)))))
(case dir-style
;; NB// Stored always loads both control and view
((stored)((eval (string->symbol (conc "pages:" page)))))
((dir)
;; first the control
(let ((control-file (conc "pages/" page "_ctrl.scm"))
(view-file (conc "pages/" page "_view.scm")))
(if (and (file-exists? control-file)
(not (eq? parts 'view)))
(begin
(session:set-called! self page)
(load control-file)))
(if (file-exists? view-file)
(if (not (eq? parts 'control))
(session:process-file view-file))
(list "<p>Page not found " page " </p>"))))
((flat))
(else
(list "ERROR: page-dir-style must be stored, dir or flat, got " dir-style)))))
(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")))
;; (if (file-exists? model.so)
;; (load model.so)
;; (if (file-exists? model.scm)
;; (load model.scm)
;; (s:log "ERROR: model " model.scm " not found")))))
;; (define (session:model-path self model)
;; (string-append (sdat-get-sroot self) "/models/" model ".scm"))
(define (session:pp-formdat self)
(let ((dat (formdat:all->strings (sdat-get-formdat self))))
(string-intersperse dat "<br> ")))
(define (session:param->string params)
;; (err:log "params=" params)
|