[closure-cvs] CVS closure/src/gui
emarsden
emarsden at common-lisp.net
Sun Dec 31 13:26:23 UTC 2006
Update of /project/closure/cvsroot/closure/src/gui
In directory clnet:/tmp/cvs-serv18515/src/gui
Modified Files:
clim-gui.lisp
Log Message:
- add basic wholine support (currently title & last-modified information)
- add "TeX mode On" and "TeX mode Off" commands (experimental)
--- /project/closure/cvsroot/closure/src/gui/clim-gui.lisp 2006/12/30 15:13:54 1.25
+++ /project/closure/cvsroot/closure/src/gui/clim-gui.lisp 2006/12/31 13:26:23 1.26
@@ -4,7 +4,7 @@
;;; Created: 2002-07-22
;;; Author: Gilbert Baumann <gilbert at base-engineering.com>
;;; License: MIT style (see below)
-;;; $Id: clim-gui.lisp,v 1.25 2006/12/30 15:13:54 emarsden Exp $
+;;; $Id: clim-gui.lisp,v 1.26 2006/12/31 13:26:23 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.26 2006/12/31 13:26:23 emarsden
+;; - add basic wholine support (currently title & last-modified information)
+;; - add "TeX mode On" and "TeX mode Off" commands (experimental)
+;;
;; Revision 1.25 2006/12/30 15:13:54 emarsden
;; - use CL from Closure packages
;; - minor rod fixes
@@ -183,7 +187,7 @@
:height 20
:min-height 20
:max-height 20
- :width 200
+ :width 300
:background +black+
:foreground +white+)
(interactor
@@ -536,6 +540,13 @@
(write-string string (find-pane-named *frame* 'status))
(clim-backend:port-force-output (find-port)))
+(defun write-wholine (string)
+ (let ((wholine (find-pane-named *frame* 'wholine)))
+ (window-clear wholine)
+ (write-string string wholine)
+ (clim-backend:port-force-output (find-port))))
+
+
(defun foo (url)
(let ((*standard-output* *trace-output*))
(clim-sys:make-process
@@ -553,8 +564,7 @@
(write-status "Fetching Document ...")
(let* ((doc (make-instance 'r2::document
:processes-hooks nil
- :location
- (r2::parse-url* url)
+ :location (r2::parse-url* url)
:http-header header
:pt (clue-gui2::make-pt-from-input
io
@@ -576,6 +586,10 @@
600 ;xxx width
t ;?
0)
+ (write-wholine (format nil "Title: ~A~%~@[Modified: ~A~]"
+ (renderer::document-title *current-document*)
+ (or (netlib::get-header-field header :last-modified)
+ (netlib::get-header-field header :date))))
(let ((x2 (bounding-rectangle-max-x (stream-output-history *pane*)))
(y2 (bounding-rectangle-max-y (stream-output-history *pane*))))
(setf y2 (max y2 r2::*document-height*))
@@ -600,7 +614,7 @@
(let ((closure-protocol:*document-language*
(if (sgml::pt-p (r2::document-pt *current-document*))
(make-instance 'r2::html-4.0-document-language)
- (make-instance 'r2::xml-style-document-language) ))
+ (make-instance 'r2::xml-style-document-language)))
(closure-protocol:*user-agent* nil)
(r2::*canvas-width*
(bounding-rectangle-width (sheet-parent *pane*))))
@@ -675,3 +689,15 @@
(handle-repaint *pane* (sheet-region (pane-viewport *pane*))))
(clim-backend:port-force-output (find-port)))
+(define-closure-command (com-tex-mode-on :name t) ()
+ (setq renderer:*tex-mode-p* t)
+ (setq renderer:*hyphenate-p* t)
+ (send-closure-command 'com-reflow))
+
+(define-closure-command (com-tex-mode-off :name t) ()
+ (setq renderer:*tex-mode-p* nil)
+ (setq renderer:*hyphenate-p* nil)
+ (send-closure-command 'com-reflow))
+
+
+;; EOF
More information about the Closure-cvs
mailing list