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

[closure-cvs] CVS update: closure/closure.asd
by crhodes＠common-lisp.net 25 Aug '05

25 Aug '05

Update of /project/closure/cvsroot/closure In directory common-lisp.net:/tmp/cvs-serv3854 Modified Files: closure.asd Log Message: OpenMCL support (from Dave Murray aka JQS) Date: Thu Aug 25 17:14:12 2005 Author: crhodes Index: closure/closure.asd diff -u closure/closure.asd:1.5 closure/closure.asd:1.6 --- closure/closure.asd:1.5 Mon Jun 13 12:14:22 2005 +++ closure/closure.asd Thu Aug 25 17:14:11 2005 @@ -70,7 +70,8 @@ #+(AND ALLEGRO ALLEGRO-V5.0) "dep-acl5" #+(AND ALLEGRO (NOT ALLEGRO-V5.0)) "dep-acl" #+GCL "dep-gcl" - #-(OR sbcl CLISP CMU ALLEGRO GCL) #.(error "Configure!")) + #+OPENMCL "dep-openmcl" + #-(OR sbcl CLISP CMU ALLEGRO GCL OPENMCL) #.(error "Configure!")) (:file "package" :depends-on (dependent)) (:file "runes"

1 0

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

25 Aug '05

Update of /project/closure/cvsroot/closure/src/gui In directory common-lisp.net:/tmp/cvs-serv3807/src/gui Modified Files: clim-gui.lisp Log Message: Work around problems related to *closure-inited-p* (see #lisp logs for 2005-08-25 for more discussion). Not clear where the fault lies: sbcl, clx, mcclim[-freetype] or closure itself. Date: Thu Aug 25 17:05:48 2005 Author: crhodes Index: closure/src/gui/clim-gui.lisp diff -u closure/src/gui/clim-gui.lisp:1.20 closure/src/gui/clim-gui.lisp:1.21 --- closure/src/gui/clim-gui.lisp:1.20 Mon Jul 11 17:58:03 2005 +++ closure/src/gui/clim-gui.lisp Thu Aug 25 17:05:48 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.20 2005/07/11 15:58:03 crhodes Exp $ +;;; $Id: clim-gui.lisp,v 1.21 2005/08/25 15:05:48 crhodes Exp $ ;;; --------------------------------------------------------------------------- ;;; (c) copyright 2002 by Gilbert Baumann @@ -28,6 +28,11 @@ ;;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. ;; $Log: clim-gui.lisp,v $ +;; Revision 1.21 2005/08/25 15:05:48 crhodes +;; Work around problems related to *closure-inited-p* (see #lisp logs for +;; 2005-08-25 for more discussion). Not clear where the fault lies: sbcl, +;; clx, mcclim[-freetype] or closure itself. +;; ;; Revision 1.20 2005/07/11 15:58:03 crhodes ;; Complete the renaming *MEDIUM* -> *PANE*. ;; @@ -453,19 +458,18 @@ (send-closure-command 'com-quit)))) (defvar *closure-inited-p* nil) -(defmethod clim:run-frame-top-level :before ((frame closure) - &key &allow-other-keys) - (setf *closure-inited-p* t)) +(defmethod clim:read-frame-command :before ((frame closure) + &key &allow-other-keys) + (unless *closure-inited-p* + (setf *closure-inited-p* t))) (defun ensure-closure () (with-closure () (unless *closure-process* (setf *closure-inited-p* nil) (run-closure) - (clim-sys:process-wait "Waiting for closure init" - (lambda () - *closure-inited-p*))))) - + (clim-sys:process-wait "Waiting for closure init" + (lambda () *closure-inited-p*))))) (defun run-closure () ;; Care for proxy

1 0

[closure-cvs] CVS update: closure/src/imagelib/deflate.lisp
by crhodes＠common-lisp.net 25 Aug '05

25 Aug '05

Update of /project/closure/cvsroot/closure/src/imagelib In directory common-lisp.net:/tmp/cvs-serv3784/src/imagelib Modified Files: deflate.lisp Log Message: delete unused deflate package. (Was conflicting with salza's package of the same [nick]name) Date: Thu Aug 25 17:04:29 2005 Author: crhodes Index: closure/src/imagelib/deflate.lisp diff -u closure/src/imagelib/deflate.lisp:1.4 closure/src/imagelib/deflate.lisp:1.5 --- closure/src/imagelib/deflate.lisp:1.4 Sun Mar 13 19:02:00 2005 +++ closure/src/imagelib/deflate.lisp Thu Aug 25 17:04:29 2005 @@ -28,16 +28,6 @@ (in-package :PNG) -(defpackage :deflate - (:use :glisp) - (:export - #:make-deflator - #:stuff-deflator - #:end-deflator - #:make-inflator - #:stuff-inflator - #:end-inflator)) - ;; This code should really move into another package ;; Note: This implementation is inherently sloooow.

1 0

[closure-cvs] CVS update: closure/src/renderer/renderer2.lisp
by crhodes＠common-lisp.net 25 Aug '05

25 Aug '05

Update of /project/closure/cvsroot/closure/src/renderer In directory common-lisp.net:/tmp/cvs-serv3754/src/renderer Modified Files: renderer2.lisp Log Message: turn off table debugging Date: Thu Aug 25 17:03:55 2005 Author: crhodes Index: closure/src/renderer/renderer2.lisp diff -u closure/src/renderer/renderer2.lisp:1.13 closure/src/renderer/renderer2.lisp:1.14 --- closure/src/renderer/renderer2.lisp:1.13 Mon Aug 8 21:28:20 2005 +++ closure/src/renderer/renderer2.lisp Thu Aug 25 17:03:54 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.13 2005/08/08 19:28:20 crhodes Exp $ +;;; $Id: renderer2.lisp,v 1.14 2005/08/25 15:03:54 crhodes Exp $ ;;; --------------------------------------------------------------------------- ;;; (c) copyright 1997-2003 by Gilbert Baumann @@ -368,7 +368,7 @@ chunks) ;their chunks (defparameter *debug-tags* nil) -(defparameter *debug-tables* t) +(defparameter *debug-tables* nil) (defun chunk-debug-name (chunk) (format nil (if (bounding-chunk-halfp chunk) @@ -4969,6 +4969,9 @@ ;; $Log: renderer2.lisp,v $ +;; Revision 1.14 2005/08/25 15:03:54 crhodes +;; turn off table debugging +;; ;; Revision 1.13 2005/08/08 19:28:20 crhodes ;; tables.lisp isn't loaded by the .asd file. Move *debug-tables* to ;; renderer2.lisp instead.

1 0

[closure-cvs] CVS update: closure/src/renderer/renderer2.lisp closure/src/renderer/tables.lisp
by crhodes＠common-lisp.net 08 Aug '05

08 Aug '05

Update of /project/closure/cvsroot/closure/src/renderer In directory common-lisp.net:/tmp/cvs-serv22515/src/renderer Modified Files: renderer2.lisp tables.lisp Log Message: tables.lisp isn't loaded by the .asd file. Move *debug-tables* to renderer2.lisp instead. Date: Mon Aug 8 21:28:21 2005 Author: crhodes Index: closure/src/renderer/renderer2.lisp diff -u closure/src/renderer/renderer2.lisp:1.12 closure/src/renderer/renderer2.lisp:1.13 --- closure/src/renderer/renderer2.lisp:1.12 Tue Jul 19 22:42:09 2005 +++ closure/src/renderer/renderer2.lisp Mon Aug 8 21:28:20 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.12 2005/07/19 20:42:09 emarsden Exp $ +;;; $Id: renderer2.lisp,v 1.13 2005/08/08 19:28:20 crhodes Exp $ ;;; --------------------------------------------------------------------------- ;;; (c) copyright 1997-2003 by Gilbert Baumann @@ -368,6 +368,7 @@ chunks) ;their chunks (defparameter *debug-tags* nil) +(defparameter *debug-tables* t) (defun chunk-debug-name (chunk) (format nil (if (bounding-chunk-halfp chunk) @@ -4968,6 +4969,10 @@ ;; $Log: renderer2.lisp,v $ +;; Revision 1.13 2005/08/08 19:28:20 crhodes +;; tables.lisp isn't loaded by the .asd file. Move *debug-tables* to +;; renderer2.lisp instead. +;; ;; Revision 1.12 2005/07/19 20:42:09 emarsden ;; More removal of spurious debugging output, and conditionalization of ;; some output on *debug-tables* Index: closure/src/renderer/tables.lisp diff -u closure/src/renderer/tables.lisp:1.4 closure/src/renderer/tables.lisp:1.5 --- closure/src/renderer/tables.lisp:1.4 Mon Jul 11 17:57:56 2005 +++ closure/src/renderer/tables.lisp Mon Aug 8 21:28:20 2005 @@ -49,8 +49,6 @@ ;;fixme: doc nil) -(defparameter *debug-tables* t) - ;; We need to distinguish two models: ;; a. tables with fixed width ;; b. tables with dynamic width (width = :auto)

1 0

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

19 Jul '05

Update of /project/closure/cvsroot/closure/src/renderer In directory common-lisp.net:/tmp/cvs-serv17830/renderer Modified Files: document.lisp renderer2.lisp Log Message: More removal of spurious debugging output, and conditionalization of some output on *debug-tables* Date: Tue Jul 19 22:42:09 2005 Author: emarsden Index: closure/src/renderer/document.lisp diff -u closure/src/renderer/document.lisp:1.4 closure/src/renderer/document.lisp:1.5 --- closure/src/renderer/document.lisp:1.4 Sun Mar 13 19:03:24 2005 +++ closure/src/renderer/document.lisp Tue Jul 19 22:42:09 2005 @@ -152,7 +152,6 @@ (when (and (style-sheet-link-p link) (style-link-does-apply-p link selected-style) (link-href link)) - (describe link) (let* ((media-type (or (ignore-errors (css::parse-media-type (link-media link))) Index: closure/src/renderer/renderer2.lisp diff -u closure/src/renderer/renderer2.lisp:1.11 closure/src/renderer/renderer2.lisp:1.12 --- closure/src/renderer/renderer2.lisp:1.11 Sun Jul 17 11:35:47 2005 +++ closure/src/renderer/renderer2.lisp Tue Jul 19 22:42:09 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.11 2005/07/17 09:35:47 emarsden Exp $ +;;; $Id: renderer2.lisp,v 1.12 2005/07/19 20:42:09 emarsden Exp $ ;;; --------------------------------------------------------------------------- ;;; (c) copyright 1997-2003 by Gilbert Baumann @@ -982,7 +982,8 @@ (when (> cww (- x2 x1)) ;; situation persists: give a warning. - (warn "*** Overfull line box.")) + (when *debug-tables* + (warn "*** Overfull line box."))) ;; (dolist (k (reverse cur-word)) (push k cur-line)) (setf cur-word nil) @@ -1880,8 +1881,6 @@ (defparameter *table-depth-color* (list clim:+red+ clim:+blue+ clim:+green+ clim:+cyan+)) -(defparameter *debug-table* nil) - ;;; Vertical align in a table ;; When a cell needs to be made larger than otherwise this is thought @@ -1992,7 +1991,7 @@ (let ((column-widths (allocate-table-columns table style x1 x2)) (row-heights (loop repeat (table-number-of-rows table) collect 0))) ;; - (when *debug-table* + (when *debug-tables* (format *trace-output* "~&=== we have a table at depth ~D.~%" *table-depth*) (format *trace-output* "~&=== column minima: ~S.~%" (loop for i below (table-number-of-columns table) @@ -2065,7 +2064,7 @@ (t (push (list (table-cell-rowspan cell) (table-cell-rowspan cell) cell) dangling-cells))) - (when *debug-table* + (when *debug-tables* (unless (or (= x1 (+ x1 w)) (= yyy yy)) #-NIL @@ -2275,7 +2274,8 @@ ;; compute the dimensions for us, so they should compute ;; in this case too. ((eql table.width :auto) - (format *trace-output* "~&Using auto layout (table.width = ~d) ~%" table.width) + (when *debug-tables* + (format *trace-output* "~&Using auto layout (table.width = ~d) ~%" table.width)) (if (< (+ max gutter) (- x2 x1)) (+ max gutter) (max (- x2 x1) @@ -2288,7 +2288,8 @@ ;; | columns plus cell spacing or borders (MIN). If W is greater than ;; | MIN, the extra width should be distributed over the columns. ((realp table.width) - ;;(format *trace-output* "~&Using fixed layout~%") + (when *debug-tables* + (format *trace-output* "~&Using fixed layout~%")) (max table.width min) ) (t @@ -2509,7 +2510,7 @@ (cond ((eql :table-cell (cooked-style-display block-style)) (setf bl 0 br 0))) ;; - (when *debug-table* + (when *debug-tables* (format *trace-output* "~&~S (~S): ml=~s, bl=~s, pl=~s, wd=~s, pr=~s, br=~s, mr=~s~%" 'minmax-block-content block-style ml bl pl wd pr br mr)) (dolist (item items) @@ -2624,7 +2625,7 @@ (show (disc-chunk-after x)))) (replaced-object-chunk (let ((w (chunk-width x))) - (when *debug-table* + (when *debug-tables* (format *trace-output* "~&~S: ~S = ~S~%" 'minmax-para `(chunk-width ,x) (chunk-width x))) (setf w (ro/size (replaced-object-chunk-object x))) @@ -2685,7 +2686,6 @@ (error "FLOATING-CHUNK has no width?"))) (defun compute-floating-chunk-width (chunk containing-block-width) - (describe (floating-chunk-content chunk)) ;;; Kludge! #+NIL (cond ((and (block-box-p (floating-chunk-content chunk)) @@ -2703,14 +2703,14 @@ ;; kludge (cond ((eq :auto (slot-value style 'css::width)) (setf wd (minmax-block (floating-chunk-content chunk))))) - (print (list 'compute-floating-chunk-width - (cooked-style-display (block-box-style (floating-chunk-content chunk))) - (cooked-style-display style) - ml pl bl wd br pr mr) - *trace-output*) - (finish-output *trace-output*) - (+ - ml pl bl wd br pr mr)))) + (when *debug-tables* + (print (list 'compute-floating-chunk-width + (cooked-style-display (block-box-style (floating-chunk-content chunk))) + (cooked-style-display style) + ml pl bl wd br pr mr) + *trace-output*) + (finish-output *trace-output*)) + (+ ml pl bl wd br pr mr)))) ;;;; @@ -4968,6 +4968,10 @@ ;; $Log: renderer2.lisp,v $ +;; Revision 1.12 2005/07/19 20:42:09 emarsden +;; More removal of spurious debugging output, and conditionalization of +;; some output on *debug-tables* +;; ;; Revision 1.11 2005/07/17 09:35:47 emarsden ;; Reference hyphenation table via a file:// URL. ;;

1 0

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

19 Jul '05

Update of /project/closure/cvsroot/closure/src/net In directory common-lisp.net:/tmp/cvs-serv17830/net Modified Files: http.lisp Log Message: More removal of spurious debugging output, and conditionalization of some output on *debug-tables* Date: Tue Jul 19 22:42:09 2005 Author: emarsden Index: closure/src/net/http.lisp diff -u closure/src/net/http.lisp:1.7 closure/src/net/http.lisp:1.8 --- closure/src/net/http.lisp:1.7 Sun Jul 17 11:44:40 2005 +++ closure/src/net/http.lisp Tue Jul 19 22:42:08 2005 @@ -529,6 +529,9 @@ ;; xxx when exactly to cache? (and her-date her-expires (> her-expires her-date)))))) + ;; the logic below is incomplete; it should also be looking at Cache-control: headers + ;; emarsden2005-07-19 + #+(and) (when cache-p (unless really-cache-p (warn "~A will not be cached; cache-p = ~S; header: ~S"

1 0

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

17 Jul '05

Update of /project/closure/cvsroot/closure/src/net In directory common-lisp.net:/tmp/cvs-serv16846/src/net Modified Files: http.lisp Log Message: Partial fix for following HTTP redirects (code 301 or 302 or 303). Certain servers (such as www.lisp.org) only include a path in the Location header, instead of a complete URL. We now accept either a path (in which case the rest of the URL is derived from the current URL), or a complete URL. This fix is only partial, since the GUI code in gui/clim-gui.lisp is not prepared to handle redirects correctly. Date: Sun Jul 17 11:44:40 2005 Author: emarsden Index: closure/src/net/http.lisp diff -u closure/src/net/http.lisp:1.6 closure/src/net/http.lisp:1.7 --- closure/src/net/http.lisp:1.6 Wed Jul 13 17:13:05 2005 +++ closure/src/net/http.lisp Sun Jul 17 11:44:40 2005 @@ -99,7 +99,7 @@ (defparameter *user-agent* "Lynx/2.7.1ac-0.98 libwww-FM/2.14") (defparameter *user-agent* "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1)") -(defparameter *user-agent* "CLOSURE/0.1") +(defparameter *user-agent* "Closure/200507") #|| @@ -549,20 +549,19 @@ response-header))) ((301 302 303) - ;; moved permanently; moved temponary; see other - (multiple-value-bind (input header) - (http-open-document - (url:parse-url - (or (get-header-field response-header :location) - (error "301/302 Response from ~A lacks a 'Location' field." - (url:url-host url)))) - :yet-urls (cons url yet-urls)) - (values input - (append header - (list - (cons "Location" - (get-header-field response-header :location))))))) - + ;; moved permanently; moved temporary; see other + ;; + ;; the Location field may be either a complete URI, or just a path + (let* ((new-location (or (url:parse-url + (get-header-field response-header :location)) + (error "301/302 Response from ~A lacks a 'Location' field." + (url:url-host url)))) + (new-url (if (url:url-host new-location) new-location + (url:merge-url new-location url)))) + (multiple-value-bind (input header) + (apply #'http-open-document new-url :yet-urls (cons url yet-urls) options) + (values input `(,@header ("Location" . ,(unparse-url new-url))))))) + (304 ;; not modified (values (cl-byte-stream->gstream (open (hce-pathname (http-cache) ce)

1 0

[closure-cvs] CVS update: closure/src/renderer/x11.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-serv16821/src/renderer Modified Files: x11.lisp Log Message: Reducing debug output to console. Date: Sun Jul 17 11:41:35 2005 Author: emarsden Index: closure/src/renderer/x11.lisp diff -u closure/src/renderer/x11.lisp:1.8 closure/src/renderer/x11.lisp:1.9 --- closure/src/renderer/x11.lisp:1.8 Wed Jul 13 15:44:56 2005 +++ closure/src/renderer/x11.lisp Sun Jul 17 11:41:35 2005 @@ -397,7 +397,6 @@ (setf worst-index (list red green blue) worst-delta (second (aref cube red green blue))))))) (destructuring-bind (bm bd nd) (apply #'aref cube worst-index) - (print (list worst-index worst-delta bm bd nd)) (setf (apply #'aref cube worst-index) (list (list nd (elt my k)) 0

1 0

[closure-cvs] CVS update: closure/src/renderer/clim-device.lisp closure/src/renderer/images.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-serv16745/src/renderer Modified Files: clim-device.lisp images.lisp Log Message: Reduce amount of debugging information printed to console. Date: Sun Jul 17 11:38:54 2005 Author: emarsden Index: closure/src/renderer/clim-device.lisp diff -u closure/src/renderer/clim-device.lisp:1.12 closure/src/renderer/clim-device.lisp:1.13 --- closure/src/renderer/clim-device.lisp:1.12 Wed Jul 13 15:44:55 2005 +++ closure/src/renderer/clim-device.lisp Sun Jul 17 11:38:54 2005 @@ -221,8 +221,6 @@ res)) (defun background-pixmap+mask (document drawable bg) - #+emarsden2005-06-23 - (print `(background-pixmap+mask ,bg)) (cond ((r2::background-%pixmap bg) ;; already there (values (r2::background-%pixmap bg) @@ -371,6 +369,7 @@ (unless (eql (r2::background-image bg) :none) (multiple-value-bind (pixmap mask) (background-pixmap+mask document (sheet-direct-mirror (medium-sheet medium)) bg) + #+emarsden2005-07-15 (print (list 'x11-draw-background pixmap mask)) (unless (eql pixmap :none) (let* ((iw (xlib:drawable-width pixmap)) Index: closure/src/renderer/images.lisp diff -u closure/src/renderer/images.lisp:1.2 closure/src/renderer/images.lisp:1.3 --- closure/src/renderer/images.lisp:1.2 Sun Mar 13 19:03:24 2005 +++ closure/src/renderer/images.lisp Sun Jul 17 11:38:54 2005 @@ -79,7 +79,7 @@ (t (warn "Auch das hat nix genuetzt.") (cond (deliver-broken-image-p - (format T "~%;; ~A -> using broken image." url) + (format *debug-io* "~%;; ~A -> using broken image." url) (broken-aimage document)) (t (error "Image mime type `~A' or `~A' not understood." @@ -88,10 +88,10 @@ (cond ((null aimage) (cond (deliver-broken-image-p (progn - (format T "~%;; ~A -> using broken image. [zweite variante]" url) + (format *debug-io* "~%;; ~A -> using broken image. [zweite variante]" url) (broken-aimage document) )) (t - (format T "~&;; Was unable to read ~S as image, because of:~%;; | ~A." + (format *debug-io* "~&;; Was unable to read ~S as image, because of:~%;; | ~A." url condition) (values nil condition)))) (t @@ -173,7 +173,7 @@ (let ((cmd (format nil "~A <~A >~A" filter-name (namestring (truename temp-filename)) (namestring pnm-filename)))) - (format T "~%;; running: ~A" cmd) + (format *debug-io* "~%;; running: ~A" cmd) (run-unix-shell-command cmd)) (progn ;ignore-errors (with-open-file (input pnm-filename @@ -235,4 +235,4 @@ :direction :output :if-exists :new-version :element-type '(unsigned-byte 8)) - (write-ppm-image aimage sink))) \ No newline at end of file + (write-ppm-image aimage sink)))

1 0