(module plugin-eval mzscheme
(require "hwikiplugin.scm")
(provide register-plugin-eval
)
(def-class
(this (plugin:eval))
(supers)
(private
(define _codes (make-hash-table 'equal))
(define _sizes (make-hash-table 'equal))
(define (eval-code context)
(let ((c-expr (hash-table-get _codes (-> context page-name))))
(xexpr->string
(with-handlers ((exn:fail? (lambda (exn)
(make-comment (format "Code evaluation failed:~%~%~a~%~%" (exn-message exn))))))
(let ((F (eval c-expr (current-namespace))))
(F context))))))
(define (get-and-eval-code context)
(let ((P (page context))
(part (-> context current-part)))
(let ((s-expr (if (-> P has-content? part)
(let ((CODE (-> P contents part)))
(hash-table-put! _sizes (-> context page-name) (string-length CODE))
(let ((fh (open-input-string CODE)))
(let ((R
(with-handlers ((exn:fail? (lambda (exn)
`(lambda (context) (make-comment (format "Cannot read code:~%~%~a~%" ,(exn-message exn)))))))
(read fh))))
(close-input-port fh)
R)))
(begin
'(begin (require (lib "xml.ss" "xml"))
(lambda (context)
(make-comment "plugin:eval, no code to evaluate"))))
)))
(hash-table-put! _codes (-> context page-name) s-expr)
(eval-code context))))
)
(public
(define (scheme->xexpr context)
(let ((size (hash-table-get _sizes (-> context page-name) (lambda () #f))))
(if (eq? size #f)
(get-and-eval-code context)
(if (= size (file-size (-> context file)))
(eval-code context)
(get-and-eval-code context)))))
)
(constructor)
)
(define EVAL #f)
(define (register-plugin-eval)
(if (eq? EVAL #f)
(set! EVAL (plugin:eval)))
(register-plugin 'plugin:eval (->> EVAL scheme->xexpr) 'editor 'code))
)