January 2007 - closure-cvs@common-lisp.net

[closure-cvs] CVS closure/src/gui
by emarsden 07 Jan '07

07 Jan '07

Update of /project/closure/cvsroot/closure/src/gui In directory clnet:/tmp/cvs-serv17755 Modified Files: clim-gui.lisp Log Message: Follow HTTP redirects (HTML-level redirects still not supported). --- /project/closure/cvsroot/closure/src/gui/clim-gui.lisp 2007/01/03 16:14:57 1.29 +++ /project/closure/cvsroot/closure/src/gui/clim-gui.lisp 2007/01/07 19:32:06 1.30 @@ -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.29 2007/01/03 16:14:57 emarsden Exp $ +;;; $Id: clim-gui.lisp,v 1.30 2007/01/07 19:32:06 emarsden Exp $ ;;; --------------------------------------------------------------------------- ;;; (c) copyright 2002 by Gilbert Baumann @@ -28,6 +28,9 @@ ;;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. ;; $Log: clim-gui.lisp,v $ +;; Revision 1.30 2007/01/07 19:32:06 emarsden +;; Follow HTTP redirects (HTML-level redirects still not supported). +;; ;; 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 @@ -601,8 +604,13 @@ (setf (sheet-pointer-cursor *pane*) :busy) (setq url (r2::parse-url* url)) (let ((request (clue-gui2::make-request :url url :method :get))) - (multiple-value-bind (io header) (clue-gui2::open-document-4 request) - (write-status "Fetching Document ...") + (write-status "Fetching Document ...") + (multiple-value-bind (io header) + (clue-gui2::open-document-4 request) + (let ((new-location (netlib::get-header-field header :location))) + (when new-location + (unless (string-equal new-location (url:unparse-url url)) + (setq url (url:parse-url new-location))))) (let* ((doc (make-instance 'r2::document :processes-hooks nil :location (r2::parse-url* url)

1 0

[closure-cvs] CVS closure/resources
by thenriksen 07 Jan '07

07 Jan '07

Update of /project/closure/cvsroot/closure/resources In directory clnet:/tmp/cvs-serv21553/resources Modified Files: resources.lisp Log Message: Make Closure work better with common-lisp-controller-like setups. --- /project/closure/cvsroot/closure/resources/resources.lisp 2005/03/13 18:00:55 1.3 +++ /project/closure/cvsroot/closure/resources/resources.lisp 2007/01/07 17:29:47 1.4 @@ -36,7 +36,7 @@ #+NIL (defparameter *resources-base-directory* *load-truename*) -(let ((load-truename *load-truename*)) +(let ((load-truename (load-time-value (or #.*compile-file-pathname* *load-pathname*)))) (setf (url:url-logical-host-translator "closure") (lambda (url) (let ((res (url:copy-url url)))

1 0

[closure-cvs] CVS closure/src/renderer
by emarsden 05 Jan '07

05 Jan '07

Update of /project/closure/cvsroot/closure/src/renderer In directory clnet:/tmp/cvs-serv24543 Modified Files: renderer2.lisp Log Message: Fix rendering of preformatted content. --- /project/closure/cvsroot/closure/src/renderer/renderer2.lisp 2007/01/05 11:19:30 1.18 +++ /project/closure/cvsroot/closure/src/renderer/renderer2.lisp 2007/01/05 23:10:33 1.19 @@ -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.18 2007/01/05 11:19:30 crhodes Exp $ +;;; $Id: renderer2.lisp,v 1.19 2007/01/05 23:10:33 emarsden Exp $ ;;; --------------------------------------------------------------------------- ;;; (c) copyright 1997-2003 by Gilbert Baumann @@ -3086,7 +3086,7 @@ for i fixnum from 0 do (cond ,@(AND (EQL :PRE WHITE-SPACE) - (list `((eql c #/U+0010) + (list `((eql c #/U+000A) (let ((ocontext context)) ,(OR LETTER-SPACING-APPLICABLE-P '(unless (= blacki i) @@ -4983,6 +4983,9 @@ ;; $Log: renderer2.lisp,v $ +;; Revision 1.19 2007/01/05 23:10:33 emarsden +;; Fix rendering of preformatted content. +;; ;; Revision 1.18 2007/01/05 11:19:30 crhodes ;; Rune fixes for TeX Mode ;;

1 0

[closure-cvs] CVS closure/src/renderer
by crhodes 05 Jan '07

05 Jan '07

Update of /project/closure/cvsroot/closure/src/renderer In directory clnet:/tmp/cvs-serv26089/src/renderer Modified Files: renderer2.lisp Log Message: Rune fixes for TeX Mode --- /project/closure/cvsroot/closure/src/renderer/renderer2.lisp 2006/12/30 15:13:55 1.17 +++ /project/closure/cvsroot/closure/src/renderer/renderer2.lisp 2007/01/05 11:19:30 1.18 @@ -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.17 2006/12/30 15:13:55 emarsden Exp $ +;;; $Id: renderer2.lisp,v 1.18 2007/01/05 11:19:30 crhodes Exp $ ;;; --------------------------------------------------------------------------- ;;; (c) copyright 1997-2003 by Gilbert Baumann @@ -4823,8 +4823,8 @@ (let ((data (black-chunk-data x))) (loop for j from 0 for c across data do - (cond ((or (<= #/a c #/z) - (<= #/A c #/Z)) + (cond ((or (rune<= #/a c #/z) + (rune<= #/A c #/Z)) (push (list i j c) curword)) (t (spill-word)))))) @@ -4836,7 +4836,7 @@ ;; #+NIL (let ((hps nil)) (dolist (word words) - (let* ((s (map 'string (lambda (x) (code-char (third x))) word)) + (let* ((s (map 'string (lambda (x) (rune-char (third x))) word)) (z (hyphen-points (hyphenation-table) s))) (dolist (k (reverse z)) (push (elt word k) hps)))) ;; an assert a day keeps the surprise away. @@ -4983,6 +4983,9 @@ ;; $Log: renderer2.lisp,v $ +;; Revision 1.18 2007/01/05 11:19:30 crhodes +;; Rune fixes for TeX Mode +;; ;; Revision 1.17 2006/12/30 15:13:55 emarsden ;; - use CL from Closure packages ;; - minor rod fixes

1 0

[closure-cvs] CVS closure/src/gui
by emarsden 04 Jan '07

04 Jan '07

Update of /project/closure/cvsroot/closure/src/gui In directory clnet:/tmp/cvs-serv12921/src/gui Modified Files: clue-gui.lisp Log Message: Add title to the PT that is generated for image/* and text/plain pages; adapt to new LHTML syntax. --- /project/closure/cvsroot/closure/src/gui/clue-gui.lisp 2006/12/31 15:42:40 1.6 +++ /project/closure/cvsroot/closure/src/gui/clue-gui.lisp 2007/01/04 23:49:13 1.7 @@ -97,15 +97,18 @@ (let ((cs (assoc :charset parameters :test #'string-equal))) (when cs (setf charset (cdr cs)))) - (netlib::find-mime-type (format nil "~A/~A" type subtype))))) + (netlib::find-mime-type (format nil "~A/~A" type subtype)))) + (url-text (url:unparse-url url))) (let ((pt (progn (cond ((member mime-type (list (netlib:find-mime-type "image/png") (netlib:find-mime-type "image/gif") (netlib:find-mime-type "image/jpeg"))) (sgml:lhtml->pt `(:HTML + (:HEAD + (:TITLE ,url-text)) (:BODY - (:IMG :SRC ,(url:unparse-url url)))))) + ((:IMG :SRC ,url-text)))))) ((member mime-type (list (netlib:find-mime-type "text/lml"))) (sgml:lhtml->pt (read-from-string (with-output-to-string (bag) (do ((x (glisp:g/read-byte input nil nil) @@ -123,6 +126,8 @@ (netlib:find-mime-type "text/css")))) (sgml:lhtml->pt `(:HTML + (:HEAD + (:TITLE ,url-text)) (:BODY (:PRE ,(gstream-as-string input))))))

1 0

[closure-cvs] CVS closure/src/glisp
by emarsden 04 Jan '07

04 Jan '07

Update of /project/closure/cvsroot/closure/src/glisp In directory clnet:/tmp/cvs-serv12710/src/glisp Modified Files: dep-cmucl.lisp Log Message: Cleanups. --- /project/closure/cvsroot/closure/src/glisp/dep-cmucl.lisp 2007/01/02 13:12:58 1.8 +++ /project/closure/cvsroot/closure/src/glisp/dep-cmucl.lisp 2007/01/04 23:46:26 1.9 @@ -65,7 +65,7 @@ (apply #'make-array length :element-type 'base-char options)) -(defun glisp:run-unix-shell-command (command) +(defun glisp::run-unix-shell-command (command) (ext:process-exit-code (ext:run-program "/bin/sh" (list "-c" command) :wait t :input nil :output nil))) (defun glisp::getenv (string)

1 0

[closure-cvs] CVS closure/src/parse
by emarsden 04 Jan '07

04 Jan '07

Update of /project/closure/cvsroot/closure/src/parse In directory clnet:/tmp/cvs-serv12710/src/parse Modified Files: pt.lisp Log Message: Cleanups. --- /project/closure/cvsroot/closure/src/parse/pt.lisp 2007/01/03 16:07:25 1.6 +++ /project/closure/cvsroot/closure/src/parse/pt.lisp 2007/01/04 23:46:26 1.7 @@ -78,7 +78,6 @@ (pprint k stream))) ;; (pprint-newline :mandatory stream) '(format stream "</~A>" (gi object)) )) -||# #-CLISP (defun print-pt (self sink depth) @@ -136,11 +135,7 @@ #'prin1 sink) (write-string ")" sink))))) - - -(defun print-pt (self sink depth) - (declare (ignore depth)) - (format sink "#<~S ~A ..>" (type-of self) (pt-name self))) +||# (defun make-pt (&key name attrs children) (let ((res (make-pt/low :name name :attrs attrs :children children)))

1 0

[closure-cvs] CVS closure/src/css
by emarsden 04 Jan '07

04 Jan '07

Update of /project/closure/cvsroot/closure/src/css In directory clnet:/tmp/cvs-serv12710/src/css Modified Files: css-parse.lisp Log Message: Cleanups. --- /project/closure/cvsroot/closure/src/css/css-parse.lisp 2006/12/31 12:05:33 1.7 +++ /project/closure/cvsroot/closure/src/css/css-parse.lisp 2007/01/04 23:46:25 1.8 @@ -1019,6 +1019,7 @@ (defun parse-style-sheet-from-url (url &key (name "Anonymous Sheet")) (netlib:with-open-document ((input mime-type) url) + (declare (ignore mime-type)) (css:parse-style-sheet input nil :name name :base-url url))) @@ -1118,8 +1119,7 @@ r)))) (defun generate-slot-constants-1 () - (let ((defconstants nil) - (k 0)) + (let ((defconstants nil)) ;; we go to some length to keep the indicies stable ... (let ((props nil) (taken nil))

1 0

[closure-cvs] CVS closure/src/renderer
by emarsden 04 Jan '07

04 Jan '07

Update of /project/closure/cvsroot/closure/src/renderer In directory clnet:/tmp/cvs-serv12710/src/renderer Modified Files: document.lisp Log Message: Cleanups. --- /project/closure/cvsroot/closure/src/renderer/document.lisp 2006/12/31 15:42:41 1.6 +++ /project/closure/cvsroot/closure/src/renderer/document.lisp 2007/01/04 23:46:26 1.7 @@ -157,10 +157,6 @@ ;; STYLE and combine, as if they occured via @import. (let ((sheets nil) (pt (document-pt doc))) - - (setq cl-user::pt pt) - - ;; (dolist (link (document-links doc)) (when (and (style-sheet-link-p link) (style-link-does-apply-p link selected-style)

1 0

[closure-cvs] CVS closure
by emarsden 04 Jan '07

04 Jan '07

Update of /project/closure/cvsroot/closure In directory clnet:/tmp/cvs-serv12710 Modified Files: closure.asd Log Message: Cleanups. --- /project/closure/cvsroot/closure/closure.asd 2007/01/03 15:39:28 1.17 +++ /project/closure/cvsroot/closure/closure.asd 2007/01/04 23:46:25 1.18 @@ -159,7 +159,7 @@ ((:file "package") (:file "pt" :depends-on ("package")) (:file "sgml-dtd" :depends-on ("package")) - (:file "sgml-parse" :depends-on ("package" "sgml-dtd")) )) + (:file "sgml-parse" :depends-on ("package" "sgml-dtd" "pt")) )) ;; More Random Utilities

1 0