Update of /project/closure/cvsroot/closure/src/gui In directory clnet:/tmp/cvs-serv3885/src/gui Modified Files: clim-gui.lisp Log Message: - new function RENDER-LHTML that renders LHTML - new command "Inspect Page" that runs Clouseau on the current document --- /project/closure/cvsroot/closure/src/gui/clim-gui.lisp 2007/01/03 11:34:45 1.28 +++ /project/closure/cvsroot/closure/src/gui/clim-gui.lisp 2007/01/03 16:14:57 1.29 @@ -4,7 +4,7 @@ ;;; Created: 2002-07-22 ;;; Author: Gilbert Baumann <gilbert@base-engineering.com> ;;; License: MIT style (see below) -;;; $Id: clim-gui.lisp,v 1.28 2007/01/03 11:34:45 emarsden Exp $ +;;; $Id: clim-gui.lisp,v 1.29 2007/01/03 16:14:57 emarsden Exp $ ;;; --------------------------------------------------------------------------- ;;; (c) copyright 2002 by Gilbert Baumann @@ -28,6 +28,10 @@ ;;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. ;; $Log: clim-gui.lisp,v $ +;; Revision 1.29 2007/01/03 16:14:57 emarsden +;; - new function RENDER-LHTML that renders LHTML +;; - new command "Inspect Page" that runs Clouseau on the current document +;; ;; Revision 1.28 2007/01/03 11:34:45 emarsden ;; GUI: implement beginning-of-page and end-of-page commands; add ;; keyboard shortcuts for back & forward. @@ -344,6 +348,31 @@ (define-presentation-type r2::pt ()) (define-presentation-type r2::hyper-link ()) +;; renders LHTML as per http://opensource.franz.com/xmlutils/xmlutils-dist/phtml.htm +(defun render-lhtml (location lhtml) + (with-simple-restart (forget "Just forget rendering this page.") + (let* ((*package* (find-package :r2)) + (*pane* (find-pane-named *frame* 'canvas)) + (*medium* (sheet-medium *pane*)) + (device (make-instance 'closure/clim-device::clim-device :medium *pane*)) + (doc (make-instance 'r2::document + :processes-hooks nil + :location location + :http-header nil + :pt (sgml::lhtml->pt lhtml))) + (*current-document* doc) + (closure-protocol:*user-agent* nil) + (closure-protocol:*document-language* (make-instance 'r2::html-4.0-document-language)) + (r2::*canvas-width* (bounding-rectangle-width (sheet-parent *pane*)))) + (window-clear *pane*) + (closure-protocol:render closure-protocol:*document-language* + doc + device + (setf *current-pt* (r2::document-pt doc)) + 600 t 0) + (clim-backend:port-force-output (find-port)) + (reflow)))) + ;;;; ---------------------------------------------------------------------------------------------------- ;;;; Commands ;;;; @@ -722,5 +751,12 @@ (setq renderer:*hyphenate-p* nil) (send-closure-command 'com-reflow)) +;; for Closure developers +(define-closure-command (com-inspect-page :name t) () + (write-status "Loading Clouseau") + (asdf:oos 'asdf:load-op :clouseau) + (write-status "Starting inspector") + (funcall (find-symbol "INSPECTOR" :clouseau) *current-document* :new-process t)) + ;; EOF