- closure-cvs@common-lisp.net - mailman3.common-lisp.net

[closure-cvs] CVS update: closure/src/imagelib/png.lisp
by emarsden＠common-lisp.net 17 Jul '05

17 Jul '05

Update of /project/closure/cvsroot/closure/src/imagelib In directory common-lisp.net:/tmp/cvs-serv16745/src/imagelib Modified Files: png.lisp Log Message: Reduce amount of debugging information printed to console. Date: Sun Jul 17 11:38:53 2005 Author: emarsden Index: closure/src/imagelib/png.lisp diff -u closure/src/imagelib/png.lisp:1.5 closure/src/imagelib/png.lisp:1.6 --- closure/src/imagelib/png.lisp:1.5 Sun Jul 10 12:36:03 2005 +++ closure/src/imagelib/png.lisp Sun Jul 17 11:38:52 2005 @@ -175,9 +175,7 @@ (defun decode-trns (palette data) (when palette (dotimes (i (length data)) - (setf (svref (aref palette i) 3) (aref data i)))) - (let ((*print-array* t)) - (print palette))) + (setf (svref (aref palette i) 3) (aref data i))))) (defun read-png-image (input) (unless (read-png-signature-p input)

1 0

[closure-cvs] CVS update: closure/src/html/html-style.lisp
by emarsden＠common-lisp.net 17 Jul '05

17 Jul '05

Update of /project/closure/cvsroot/closure/src/html In directory common-lisp.net:/tmp/cvs-serv16745/src/html Modified Files: html-style.lisp Log Message: Reduce amount of debugging information printed to console. Date: Sun Jul 17 11:38:52 2005 Author: emarsden Index: closure/src/html/html-style.lisp diff -u closure/src/html/html-style.lisp:1.6 closure/src/html/html-style.lisp:1.7 --- closure/src/html/html-style.lisp:1.6 Sun Jul 10 12:57:21 2005 +++ closure/src/html/html-style.lisp Sun Jul 17 11:38:52 2005 @@ -1160,7 +1160,6 @@ t)))) (defmethod x11-draw-robj (drawable gcontext (self ro/image) box x y) - drawable gcontext self box x y (setf x (floor x)) (setf y (floor y)) (with-slots (alt awidth aheight aimage url) self

1 0

[closure-cvs] CVS update: closure/src/css/css-parse.lisp
by emarsden＠common-lisp.net 17 Jul '05

17 Jul '05

Update of /project/closure/cvsroot/closure/src/css In directory common-lisp.net:/tmp/cvs-serv16745/src/css Modified Files: css-parse.lisp Log Message: Reduce amount of debugging information printed to console. Date: Sun Jul 17 11:38:51 2005 Author: emarsden Index: closure/src/css/css-parse.lisp diff -u closure/src/css/css-parse.lisp:1.4 closure/src/css/css-parse.lisp:1.5 --- closure/src/css/css-parse.lisp:1.4 Sun Mar 13 19:00:58 2005 +++ closure/src/css/css-parse.lisp Sun Jul 17 11:38:51 2005 @@ -709,7 +709,6 @@ (defun p/integer (tokens) (let ((r (p/measure tokens '(1)))) - (print r) (and r (integerp (car r)) r)))

1 0

[closure-cvs] CVS update: closure/src/renderer/renderer2.lisp
by emarsden＠common-lisp.net 17 Jul '05

17 Jul '05

Update of /project/closure/cvsroot/closure/src/renderer In directory common-lisp.net:/tmp/cvs-serv16691/src/renderer Modified Files: renderer2.lisp Log Message: Reference hyphenation table via a file:// URL. Date: Sun Jul 17 11:35:47 2005 Author: emarsden Index: closure/src/renderer/renderer2.lisp diff -u closure/src/renderer/renderer2.lisp:1.10 closure/src/renderer/renderer2.lisp:1.11 --- closure/src/renderer/renderer2.lisp:1.10 Wed Jul 13 15:44:55 2005 +++ closure/src/renderer/renderer2.lisp Sun Jul 17 11:35:47 2005 @@ -4,7 +4,7 @@ ;;; Created: somewhen late 2002 ;;; Author: Gilbert Baumann <gilbert(a)base-engineering.com> ;;; License: MIT style (see below) -;;; $Id: renderer2.lisp,v 1.10 2005/07/13 13:44:55 crhodes Exp $ +;;; $Id: renderer2.lisp,v 1.11 2005/07/17 09:35:47 emarsden Exp $ ;;; --------------------------------------------------------------------------- ;;; (c) copyright 1997-2003 by Gilbert Baumann @@ -4787,7 +4787,7 @@ (defun hyphenation-table () (or *hyphenation-table* (setf *hyphenation-table* - (read-hyphen-table-file "/home/closure/closure/resources/patterns/english.ptn")))) + (read-hyphen-table "file://closure/resources/patterns/english.ptn")))) (defun hyphenate-items (items w) "This takes a chunk list and applies hyphenation it it." @@ -4968,6 +4968,9 @@ ;; $Log: renderer2.lisp,v $ +;; Revision 1.11 2005/07/17 09:35:47 emarsden +;; Reference hyphenation table via a file:// URL. +;; ;; Revision 1.10 2005/07/13 13:44:55 crhodes ;; Make images work, more or less. ;;

1 0

[closure-cvs] CVS update: closure/src/gui/gui.lisp
by emarsden＠common-lisp.net 17 Jul '05

17 Jul '05

Update of /project/closure/cvsroot/closure/src/gui In directory common-lisp.net:/tmp/cvs-serv15903/gui Modified Files: gui.lisp Log Message: The hyphenation table can be referenced using an URL, rather than by an absolute filename. Date: Sun Jul 17 11:30:55 2005 Author: emarsden Index: closure/src/gui/gui.lisp diff -u closure/src/gui/gui.lisp:1.6 closure/src/gui/gui.lisp:1.7 --- closure/src/gui/gui.lisp:1.6 Sun Jul 10 12:57:20 2005 +++ closure/src/gui/gui.lisp Sun Jul 17 11:30:52 2005 @@ -54,10 +54,6 @@ (defparameter *debug-submit-p* nil "Whether to dump the values about to be submit by a <FORM> to the server on the listener.") -;; experimental code that is not activated by default -(defvar *tex-mode-p* nil) -(defvar *hyphenate-p* nil) - (defstruct display-list

1 0

[closure-cvs] CVS update: closure/src/renderer/hyphenation.lisp
by emarsden＠common-lisp.net 17 Jul '05

17 Jul '05

Update of /project/closure/cvsroot/closure/src/renderer In directory common-lisp.net:/tmp/cvs-serv15903/renderer Modified Files: hyphenation.lisp Log Message: The hyphenation table can be referenced using an URL, rather than by an absolute filename. Date: Sun Jul 17 11:30:51 2005 Author: emarsden Index: closure/src/renderer/hyphenation.lisp diff -u closure/src/renderer/hyphenation.lisp:1.3 closure/src/renderer/hyphenation.lisp:1.4 --- closure/src/renderer/hyphenation.lisp:1.3 Sun Mar 13 19:03:24 2005 +++ closure/src/renderer/hyphenation.lisp Sun Jul 17 11:30:51 2005 @@ -4,7 +4,7 @@ ;;; Created: 2003-03-07 ;;; Author: Gilbert Baumann <gilbert(a)base-engineering.com> ;;; License: MIT style (see below) -;;; $Id: hyphenation.lisp,v 1.3 2005/03/13 18:03:24 gbaumann Exp $ +;;; $Id: hyphenation.lisp,v 1.4 2005/07/17 09:30:51 emarsden Exp $ ;;; --------------------------------------------------------------------------- ;;; (c) copyright 1999-2003 by Gilbert Baumann @@ -174,18 +174,18 @@ ;;;; Reading Tables -(defun read-hyphen-table-file (filename &key (class 'tree-hyphenation-table)) - (with-open-file (input filename) - (let ((res (make-instance class - :filename filename))) - (read-line input nil nil) - (do ((line (read-line input nil nil) (read-line input nil nil))) - ((null line)) - (let* ((j (position #\space line)) - (pattern (map 'vector #'digit-char-p (subseq line (+ j 1))))) - (insert-hyphenation-pattern res (subseq line 0 j) pattern))) - res))) - +(defun read-hyphen-table (url &key (class 'tree-hyphenation-table)) + (let ((url (if (url:url-p url) url (url:parse-url url)))) + (netlib:with-open-document ((input mime-type) url) + (declare (ignore mime-type)) + (let ((res (make-instance class :filename url))) + (g/read-line input nil nil) + (do ((line (g/read-line input nil nil) (g/read-line input nil nil))) + ((null line)) + (let* ((j (position #\space line)) + (pattern (map 'vector #'digit-char-p (subseq line (+ j 1))))) + (insert-hyphenation-pattern res (subseq line 0 j) pattern))) + res)))) ;; 100,000x hyphenation of "argument": @@ -193,6 +193,10 @@ ;; new: .57s 2.400,000 bytes [technically zero] ;; $Log: hyphenation.lisp,v $ +;; Revision 1.4 2005/07/17 09:30:51 emarsden +;; The hyphenation table can be referenced using an URL, rather than by +;; an absolute filename. +;; ;; Revision 1.3 2005/03/13 18:03:24 gbaumann ;; Gross license change ;;

1 0

[closure-cvs] CVS update: closure/src/defpack.lisp
by emarsden＠common-lisp.net 17 Jul '05

17 Jul '05

Update of /project/closure/cvsroot/closure/src In directory common-lisp.net:/tmp/cvs-serv15903 Modified Files: defpack.lisp Log Message: The hyphenation table can be referenced using an URL, rather than by an absolute filename. Date: Sun Jul 17 11:30:50 2005 Author: emarsden Index: closure/src/defpack.lisp diff -u closure/src/defpack.lisp:1.4 closure/src/defpack.lisp:1.5 --- closure/src/defpack.lisp:1.4 Sun Jul 10 12:57:19 2005 +++ closure/src/defpack.lisp Sun Jul 17 11:30:48 2005 @@ -40,6 +40,8 @@ #:scale-aimage #:pnm-stream->aimage) (:export + #:*tex-mode-p* + #:*hyphenate-p* #:device-font-ascent #:device-dpi #:device-font-descent @@ -128,8 +130,6 @@ (:export #:*home-page* #:*user-wants-images-p* - #:*tex-mode-p* - #:*hyphenate-p* #:*closure-dpi* #:*zoom-factor* #:*debug-submit-p*

1 0

[closure-cvs] CVS update: closure/src/net/http.lisp
by crhodes＠common-lisp.net 13 Jul '05

13 Jul '05

Update of /project/closure/cvsroot/closure/src/net In directory common-lisp.net:/tmp/cvs-serv23472/src/net Modified Files: http.lisp Log Message: Make the broken-image work under sbcl. * fix REALLY-PROBE-FILE, though we should probably be using some posixish functions instead of opening the file. Date: Wed Jul 13 17:13:05 2005 Author: crhodes Index: closure/src/net/http.lisp diff -u closure/src/net/http.lisp:1.5 closure/src/net/http.lisp:1.6 --- closure/src/net/http.lisp:1.5 Sun Mar 13 19:02:19 2005 +++ closure/src/net/http.lisp Wed Jul 13 17:13:05 2005 @@ -713,9 +713,10 @@ (unwind-protect (progn (setf stream (ignore-errors (open filename :direction :input - :if-does-not-exist nil))) + :element-type '(unsigned-byte 8) + :if-does-not-exist nil))) (and stream - (ignore-errors (read-char stream nil :eof)))) + (ignore-errors (read-byte stream nil :eof)))) (when stream (close stream)) )) ))

1 0

[closure-cvs] CVS update: closure/src/renderer/clim-device.lisp closure/src/renderer/renderer2.lisp closure/src/renderer/x11.lisp
by crhodes＠common-lisp.net 13 Jul '05

13 Jul '05

Update of /project/closure/cvsroot/closure/src/renderer In directory common-lisp.net:/tmp/cvs-serv16629/src/renderer Modified Files: clim-device.lisp renderer2.lisp x11.lisp Log Message: Make images work, more or less. * restore horrible grecording hack for (medium-)draw-ro* * make direct drawing of images to x11 work with my X server (32bpp even for 24-depth images) Obviously this should turn into proper clim support for images, at which point this horribleness can go away. However, this now basically works for me, modulo compiler consistency strangeness at startup. Date: Wed Jul 13 15:44:56 2005 Author: crhodes Index: closure/src/renderer/clim-device.lisp diff -u closure/src/renderer/clim-device.lisp:1.11 closure/src/renderer/clim-device.lisp:1.12 --- closure/src/renderer/clim-device.lisp:1.11 Sun Jul 10 13:18:35 2005 +++ closure/src/renderer/clim-device.lisp Wed Jul 13 15:44:55 2005 @@ -446,12 +446,17 @@ :actual-width (or width (r2::aimage-width aim)) :actual-height (or height (r2::aimage-height aim))))) -#+NIL -(climi::def-grecording draw-ro (() ro x y) - (values x - (- y (nth-value 1 (r2::ro/size ro))) - (+ x (nth-value 0 (r2::ro/size ro))) - (+ y 0))) +(climi::def-grecording draw-ro (() ro x y) () + (values x + (- y (nth-value 1 (r2::ro/size ro))) + (+ x (nth-value 0 (r2::ro/size ro))) + (+ y 0))) +(climi::def-graphic-op draw-ro (ro x y)) + +(defun draw-ro* (sheet ro x y &rest args) + (climi::with-medium-options (sheet args) + (medium-draw-ro* medium ro x y))) + (defmethod medium-draw-ro* ((medium clim:medium) (self ro/img) x y) (progn ;; ignore-errors ;xxx Index: closure/src/renderer/renderer2.lisp diff -u closure/src/renderer/renderer2.lisp:1.9 closure/src/renderer/renderer2.lisp:1.10 --- closure/src/renderer/renderer2.lisp:1.9 Mon Jul 11 17:57:56 2005 +++ closure/src/renderer/renderer2.lisp Wed Jul 13 15:44:55 2005 @@ -4,7 +4,7 @@ ;;; Created: somewhen late 2002 ;;; Author: Gilbert Baumann <gilbert(a)base-engineering.com> ;;; License: MIT style (see below) -;;; $Id: renderer2.lisp,v 1.9 2005/07/11 15:57:56 crhodes Exp $ +;;; $Id: renderer2.lisp,v 1.10 2005/07/13 13:44:55 crhodes Exp $ ;;; --------------------------------------------------------------------------- ;;; (c) copyright 1997-2003 by Gilbert Baumann @@ -538,7 +538,7 @@ (replaced-object-chunk (let ((ro (replaced-object-chunk-object chunk))) (when (eql pass 1) - (closure/clim-device::medium-draw-ro* + (closure/clim-device::draw-ro* clim-user::*pane* ro x (+ dy y))) (incf x (chunk-width chunk))) ))))) @@ -4968,6 +4968,18 @@ ;; $Log: renderer2.lisp,v $ +;; Revision 1.10 2005/07/13 13:44:55 crhodes +;; Make images work, more or less. +;; +;; * restore horrible grecording hack for (medium-)draw-ro* +;; +;; * make direct drawing of images to x11 work with my X server (32bpp even +;; for 24-depth images) +;; +;; Obviously this should turn into proper clim support for images, at which +;; point this horribleness can go away. However, this now basically works +;; for me, modulo compiler consistency strangeness at startup. +;; ;; Revision 1.9 2005/07/11 15:57:56 crhodes ;; Complete the renaming *MEDIUM* -> *PANE*. ;; Index: closure/src/renderer/x11.lisp diff -u closure/src/renderer/x11.lisp:1.7 closure/src/renderer/x11.lisp:1.8 --- closure/src/renderer/x11.lisp:1.7 Sun Jul 10 12:57:23 2005 +++ closure/src/renderer/x11.lisp Wed Jul 13 15:44:56 2005 @@ -486,10 +486,16 @@ (let* ((width (imagelib:aimage-width aimage)) (height (imagelib:aimage-height aimage)) (idata (imagelib:aimage-data aimage)) - (xdata (make-array (list height width) :element-type `(unsigned-byte ,depth))) + ;; FIXME: this (and the :BITS-PER-PIXEL, below) is a hack on + ;; top of a hack. At some point in the past, XFree86 and/or + ;; X.org decided that they would no longer support pixmaps + ;; with 24 bpp, which seems to be what most AIMAGEs want to + ;; be. For now, force everything to a 32-bit pixmap. + (xdata (make-array (list height width) :element-type '(unsigned-byte 32))) (ximage (xlib:create-image :width width :height height :depth depth + :bits-per-pixel 32 :data xdata))) (declare (type (simple-array (unsigned-byte 32) (* *)) idata) #+NIL(type (simple-array (unsigned-byte 8) (* *)) xdata)

1 0

[closure-cvs] CVS update: closure/src/gui/clim-gui.lisp
by crhodes＠common-lisp.net 11 Jul '05

11 Jul '05

Update of /project/closure/cvsroot/closure/src/gui In directory common-lisp.net:/tmp/cvs-serv7926/src/gui Modified Files: clim-gui.lisp Log Message: Complete the renaming *MEDIUM* -> *PANE*. Panes are CLIM extended-streams, and remember output to them in output records. Mediums are much simpler, and don't have this kind of memory. So, though the same drawing functions (DRAW-TEXT, DRAW-LINE) can have the same initial effect applied to a pane and a medium, the output-record state is very different. Date: Mon Jul 11 17:58:04 2005 Author: crhodes Index: closure/src/gui/clim-gui.lisp diff -u closure/src/gui/clim-gui.lisp:1.19 closure/src/gui/clim-gui.lisp:1.20 --- closure/src/gui/clim-gui.lisp:1.19 Sun Jul 10 13:18:34 2005 +++ closure/src/gui/clim-gui.lisp Mon Jul 11 17:58:03 2005 @@ -4,7 +4,7 @@ ;;; Created: 2002-07-22 ;;; Author: Gilbert Baumann <gilbert(a)base-engineering.com> ;;; License: MIT style (see below) -;;; $Id: clim-gui.lisp,v 1.19 2005/07/10 11:18:34 emarsden Exp $ +;;; $Id: clim-gui.lisp,v 1.20 2005/07/11 15:58:03 crhodes Exp $ ;;; --------------------------------------------------------------------------- ;;; (c) copyright 2002 by Gilbert Baumann @@ -28,6 +28,15 @@ ;;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. ;; $Log: clim-gui.lisp,v $ +;; Revision 1.20 2005/07/11 15:58:03 crhodes +;; Complete the renaming *MEDIUM* -> *PANE*. +;; +;; Panes are CLIM extended-streams, and remember output to them in output +;; records. Mediums are much simpler, and don't have this kind of +;; memory. So, though the same drawing functions (DRAW-TEXT, DRAW-LINE) +;; can have the same initial effect applied to a pane and a medium, the +;; output-record state is very different. +;; ;; Revision 1.19 2005/07/10 11:18:34 emarsden ;; Distinguish between pane and medium in the CLIM GUI. This should ;; fix image display. @@ -128,7 +137,6 @@ (:menu-bar menubar-command-table) (:panes (canvas (make-pane 'closure-pane - :name 'canvas :height 2000 :width 800 :display-time nil)) @@ -620,17 +628,6 @@ ;;;; ---------------------------------------------------------------------------------------------------- -#+NIL -(define-closure-command com-reflow () - (window-clear (find-pane-named *frame* 'canvas)) - (let ((*medium* (find-pane-named *frame* 'canvas))) - (let ((device (make-instance 'closure/clim-device::clim-device :medium *medium*))) - (let ((closure-protocol:*document-language* - (make-instance 'r2::html-4.0-document-language)) - (closure-protocol:*user-agent* - nil)) - (r2::reflow))))) - (define-presentation-translator url-from-string (string url closure) (x) @@ -684,7 +681,7 @@ (min (gadget-max-value scrollbar) (+ current-y (* 0.9 window-height)))))) (define-closure-command (com-redraw :name t :keystroke (#\r :control)) () - (let* ((*medium* (find-pane-named *frame* 'canvas)) ) - (handle-repaint *medium* (sheet-region (pane-viewport *medium*)))) + (let* ((*pane* (find-pane-named *frame* 'canvas)) ) + (handle-repaint *pane* (sheet-region (pane-viewport *pane*)))) (xlib:display-finish-output (clim-clx::clx-port-display (find-port))))

1 0