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

[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

[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