Changeset 18797 in project


Ignore:
Timestamp:
07/12/10 13:19:46 (11 years ago)
Author:
Moritz Heidkamp
Message:
  • make source-file' and current-path' variable bindings available in `page-eval-env' (thanks to Christian Kellermann for the suggestion)
  • `serve' tries to not recompile when the requested page is probably not an HTML page (i.e. reloading a HTML page will only recompile the site once and not again for each referenced stylesheet etc.)
  • `serve' always uses a mutex lock even when not recompiling to prevent interferences of recompiling in concurrent requests
  • pages' binding in page-eval-env' is no longer a procedure but a variable
File:
1 edited

Legend:

Unmodified
Added
Removed
  • release/4/hyde/trunk/hyde.scm

    r18678 r18797  
    3434     spiffy
    3535     srfi-18
    36      colorize)
     36     colorize
     37     intarweb
     38     uri-common)
    3739
    3840
     
    5456                                       (alist-ref name (page-vars))))
    5557
    56 (environment-set! (page-eval-env) 'pages (cut pages))
    5758
    5859(define default-layout-template #<<END
     
    122123    (print path)))
    123124
     125(define (requested-page-fresh-enough?)
     126  (let* ((file (fold (flip make-pathname)
     127                     (root-path)
     128                     (cdr (uri-path (request-uri (current-request))))))
     129         (referer (uri-path (header-value 'referer
     130                                          (request-headers (current-request))
     131                                          (uri-reference ""))))
     132         (referer (and (pair? referer) (last referer))))
     133
     134    (and (file-exists? file)
     135         referer
     136         (or (string=? "" referer)
     137             (string=? "html" (pathname-extension referer))))))
     138
    124139(define (serve)
    125140  (root-path (output-dir))
    126141 
    127142  (let ((m (make-mutex)))
    128     (vhost-map `((".*" . ,(lambda (continue)
    129                             (mutex-lock! m)
    130                             (compile-pages)
    131                             (newline)
    132                             (continue)
    133                             (mutex-unlock! m))))))
     143    (vhost-map `((".*" .
     144                  ,(lambda (continue)
     145                     (condition-case (mutex-lock! m)
     146                                     ((abandoned-mutex-exception) #t))
     147                     (if (requested-page-fresh-enough?)
     148                         (continue)
     149                         (begin
     150                           (compile-pages)
     151                           (newline)
     152                           (continue)))
     153
     154                     (mutex-unlock! m))))))
    134155
    135156  (print (format "spiffy serving hyde on port ~A" (server-port)))
     
    176197
    177198(define (write-to-target-file-for source-file contents)
    178   (let* ((target-file (make-output-path source-file (page-vars))))
     199  (let* ((target-file (make-output-path source-file (page-vars)))
     200         (relative-source-file (pathname-relative-from (source-dir) source-file))
     201         (current-path (car (alist-ref relative-source-file (pages) string=?))))
     202
     203    (environment-set! (page-eval-env) 'source-file relative-source-file)
     204    (environment-set! (page-eval-env) 'current-path current-path)
     205    (environment-set! (page-eval-env) 'pages (pages))
    179206
    180207    (with-output-to-file target-file
Note: See TracChangeset for help on using the changeset viewer.