Welcome to the CHICKEN Scheme pasting service

;;;
;;; Define-solaronite-page
;;;

;;XXX: depended upon by include-page-javascript
(define (maybe-compress-javascript js no-javascript-compression)
  (if (and (enable-javascript-compression)
           (javascript-compressor)
           (not no-javascript-compression))
      (string-trim-both ((javascript-compressor) js))
      js))

;;XXX: copied from awful, because not exported
(define (include-page-javascript ajax? no-javascript-compression)
  (if ajax?
      (<script> type: "text/javascript"
                (maybe-compress-javascript
                 (++ "$(document).ready(function(){"
                     (page-javascript) "});")
                 no-javascript-compression))
      (if (string-null? (page-javascript))
          ""
          (<script> type: "text/javascript"
                    (maybe-compress-javascript
                     (page-javascript)
                     no-javascript-compression)))))


(define current-section (make-parameter #f))
(define current-section-entry (make-parameter #f))
(define current-top-section (make-parameter #f))
(define current-top-section-entry (make-parameter #f))
(define current-entry (make-parameter #f))

(define (define-solaronite-page path backend contents
          #!key css title doctype headers charset no-ajax
          no-session no-db vhost-root-path no-javascript-compression
          use-ajax (method 'GET) use-session)

  (define (content-proc #!optional given-path)
    (for-each backend-refresh! (backends))
    (let ((spath (split-path (or given-path path)))
          (ajax? (cond (no-ajax #f)
                       ((not (ajax-library)) #f)
                       ((and (ajax-library) use-ajax) #t)
                       ((enable-ajax) #t)
                       (else #f))))
      (current-section (content-entry-lookup-section (slot-value backend 'content) spath))
      (current-section-entry (content-entry-lookup (slot-value backend 'content) (current-section)))
      (current-top-section (content-entry-lookup-top-section (slot-value backend 'content) spath))
      (current-top-section-entry (and (current-top-section)
                                      (content-entry-lookup (slot-value backend 'content) (current-top-section))))
      (current-entry (let ((e (content-entry-lookup (slot-value backend 'content) spath)))
                       (if (and e
                                (content-entry-directory? e)
                                (content-entry-child-exists? e "index")
                                (not (content-entry-directory?
                                      (content-entry-child-ref e "index"))))
                           (content-entry-child-ref e "index")
                           e)))
      ;;XXX: when (javascript-position) is 'bottom, the js will be
      ;;     appended to the end of the whole document, rather than just
      ;;     at the end of the user-supplied content
      ((page-template)
       (if given-path
           (contents given-path)
           (contents))
       css: (or css (page-css))
       title: (if (procedure? title)
                  (title)
                  title)
       doctype: (or doctype (page-doctype))
       headers: (++ (if ajax?
                        (<script> type: "text/javascript" src: (ajax-library))
                        "")
                    (or headers "")
                    (if (eq? (javascript-position) 'top)
                        (include-page-javascript ajax? no-javascript-compression)
                        ""))
       charset: (or charset (page-charset)))))

  (define-page path content-proc
    no-template: #t
    no-ajax: no-ajax
    no-session: no-session
    no-db: no-db
    vhost-root-path: vhost-root-path
    no-javascript-compression: no-javascript-compression
    use-ajax: use-ajax
    method: method
    use-session: use-session))