closure-cvs

closure-cvs@common-lisp.net

208 discussions

[closure-cvs] CVS closure/src/util
by dlichteblau 29 Dec '06

29 Dec '06

Update of /project/closure/cvsroot/closure/src/util In directory clnet:/tmp/cvs-serv9505/src/util Modified Files: clex.lisp lalr.lisp xterm.lisp Log Message: Use CXML's rune implementation and XML parser. --- /project/closure/cvsroot/closure/src/util/clex.lisp 2005/03/13 18:03:57 1.3 +++ /project/closure/cvsroot/closure/src/util/clex.lisp 2006/12/29 21:29:44 1.4 @@ -27,7 +27,7 @@ ;;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. (defpackage :clex - (:use :glisp) + (:use :glisp :runes) (:export #:deflexer #:backup #:begin #:initial #:bag)) --- /project/closure/cvsroot/closure/src/util/lalr.lisp 2002/07/22 02:27:19 1.1.1.1 +++ /project/closure/cvsroot/closure/src/util/lalr.lisp 2006/12/29 21:29:44 1.2 @@ -7,7 +7,7 @@ ;;; (c) 1988 Mark Johnson (defpackage :lalr - (:use :glisp) + (:use :glisp :runes) (:export #:DEFINE-GRAMMAR)) (in-package :LALR) --- /project/closure/cvsroot/closure/src/util/xterm.lisp 2005/03/13 18:03:58 1.2 +++ /project/closure/cvsroot/closure/src/util/xterm.lisp 2006/12/29 21:29:44 1.3 @@ -28,7 +28,7 @@ (defpackage :XTERM - (:use :glisp) + (:use :glisp :runes) (:export #:open-terminal ))

1 0

[closure-cvs] CVS closure/src/renderer
by dlichteblau 29 Dec '06

29 Dec '06

Update of /project/closure/cvsroot/closure/src/renderer In directory clnet:/tmp/cvs-serv9505/src/renderer Modified Files: clim-draw.lisp list-item.lisp raux.lisp renderer.lisp renderer2.lisp Log Message: Use CXML's rune implementation and XML parser. --- /project/closure/cvsroot/closure/src/renderer/clim-draw.lisp 2005/07/11 15:57:56 1.4 +++ /project/closure/cvsroot/closure/src/renderer/clim-draw.lisp 2006/12/29 21:29:34 1.5 @@ -4,7 +4,7 @@ ;;; Created: 2003-03-08 ;;; Author: Gilbert Baumann <gilbert(a)base-engineering.com> ;;; License: MIT style (see below) -;;; $Id: clim-draw.lisp,v 1.4 2005/07/11 15:57:56 crhodes Exp $ +;;; $Id: clim-draw.lisp,v 1.5 2006/12/29 21:29:34 dlichteblau Exp $ ;;; --------------------------------------------------------------------------- ;;; (c) copyright 1997-2003 by Gilbert Baumann @@ -197,7 +197,7 @@ (let ((x 0)) (loop for i from start to (1- end) do (let* ((rune (aref runes i))) - (if (white-space-rune-p rune) (setf rune 32)) + (if (white-space-rune-p rune) (setf rune #/U+0020)) (progn (let ((cw (+ (if (white-space-rune-p rune) (+ (rune-width font rune) word-spacing) @@ -236,12 +236,12 @@ (type css-font-desc $font)) (let ((x 0) ($rune 0)) - (declare (type rune $rune)) + (declare (type fixnum $rune)) (declare (type fixnum x)) (loop for i #-GCL of-type #-GCL fixnum from ,start to (the fixnum (1- ,end)) do (locally (declare (fixnum i)) - (setq $rune (aref (the rod ,runes) i)) + (setq $rune (rune-code (aref (the rod ,runes) i))) (if (white-space-rune-p*/no-nl $rune) (setf $rune 32)) (let (($cw 0)) @@ -278,10 +278,10 @@ (let ((buffer-size (length buffer))) (prog1 (iterate-over-runes - (lambda (rune index x cw) + (lambda (code index x cw) index - (let ((fid (css-font-desc-glyph-fid (text-style-font text-style) rune)) - (i (css-font-desc-glyph-index (text-style-font text-style) rune))) + (let* ((fid (css-font-desc-glyph-fid (text-style-font text-style) code)) + (i (css-font-desc-glyph-index (text-style-font text-style) code))) (when (or (not (eq font fid)) (= bptr buffer-size)) ;; we have to spill --- /project/closure/cvsroot/closure/src/renderer/list-item.lisp 2005/06/13 10:14:23 1.3 +++ /project/closure/cvsroot/closure/src/renderer/list-item.lisp 2006/12/29 21:29:38 1.4 @@ -112,19 +112,19 @@ (:circle (coerce (vector (elt +list-style-type-glyphs/circle+ 0)) 'rod)) (:square (coerce (vector (elt +list-style-type-glyphs/square+ 0)) 'rod)) (:decimal - (map 'rod #'char-code + (map 'rod #'char-rune (format nil "~D." n))) (:lower-roman - (map 'rod #'char-code + (map 'rod #'char-rune (format nil "~(~@R~)." n))) (:upper-roman - (map 'rod #'char-code + (map 'rod #'char-rune (format nil "~:@(~@R~)." n))) (:lower-alpha - (map 'rod #'char-code + (map 'rod #'char-rune (format nil "~(~A~)." (integer->abc n)))) (:upper-alpha - (map 'rod #'char-code + (map 'rod #'char-rune (format nil "~:@(~A~)." (integer->abc n)))) (:none (map 'rod #'identity nil)))) --- /project/closure/cvsroot/closure/src/renderer/raux.lisp 2005/03/13 18:03:24 1.5 +++ /project/closure/cvsroot/closure/src/renderer/raux.lisp 2006/12/29 21:29:38 1.6 @@ -30,7 +30,7 @@ (defun pt-data (x) (cond ((text-element-p x) - (map 'string #'code-char (element-text x))) + (map 'string #'rune-char (element-text x))) ((apply 'concatenate 'string (mapcar #'pt-data (element-children x)))))) --- /project/closure/cvsroot/closure/src/renderer/renderer.lisp 2005/03/13 18:03:25 1.10 +++ /project/closure/cvsroot/closure/src/renderer/renderer.lisp 2006/12/29 21:29:39 1.11 @@ -4,7 +4,7 @@ ;;; Created: long ago ;;; Author: Gilbert Baumann <gilbert(a)base-engineering.com> ;;; License: MIT style (see below) -;;; $Id: renderer.lisp,v 1.10 2005/03/13 18:03:25 gbaumann Exp $ +;;; $Id: renderer.lisp,v 1.11 2006/12/29 21:29:39 dlichteblau Exp $ ;;; --------------------------------------------------------------------------- ;;; (c) copyright 1997-2002 by Gilbert Baumann @@ -91,15 +91,15 @@ (defvar +list-style-type-glyphs/disc+ (list ;;u/black-circle u/bullet u/white-bullet u/white-circle - (char-code #\o))) + (char-rune #\o))) (defvar +list-style-type-glyphs/circle+ (list ;;u/white-circle u/white-bullet u/bullet u/black-circle - (char-code #\*))) + (char-rune #\*))) (defvar +list-style-type-glyphs/square+ (list ;;u/black-square u/white-square u/white-bullet u/bullet - (char-code #\-))) + (char-rune #\-))) ;;;; @@ -117,7 +117,7 @@ ;;; ---- Believed to be correct ----------------------------------------------- (defsubst rune-width (font rune) - (css-font-desc-glyph-width font rune)) + (css-font-desc-glyph-width font (rune-code rune))) (defun parse-url* (url) (cond ((url:url-p url) url) --- /project/closure/cvsroot/closure/src/renderer/renderer2.lisp 2006/11/06 19:43:01 1.15 +++ /project/closure/cvsroot/closure/src/renderer/renderer2.lisp 2006/12/29 21:29:39 1.16 @@ -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.15 2006/11/06 19:43:01 thenriksen Exp $ +;;; $Id: renderer2.lisp,v 1.16 2006/12/29 21:29:39 dlichteblau Exp $ ;;; --------------------------------------------------------------------------- ;;; (c) copyright 1997-2003 by Gilbert Baumann @@ -2261,8 +2261,8 @@ collect (table-column-maximum-width (table-column table i)))) (min (reduce #'+ mins)) (max (reduce #'+ maxs)) - (gutter (* (1+ (table-number-of-columns table)) (table-horizontal-border-spacing table)))) - ;; + (gutter (* (1+ (table-number-of-columns table)) (table-horizontal-border-spacing table)))) + ;; (setf table.width (cond ;; | 2. If the 'table' or 'inline-table' element has 'width: auto', the @@ -2761,12 +2761,13 @@ before-markers) ;; first off the first thing must be a block-open (unless (eq (caar q) :open) - (error "Barf!")) + (error "Barf! (1)")) (push (my-setup-style (cadar q) (car ss) cbss) ss) ;; (setf mes (car ss)) (unless (cooked-style-block-element-p (car ss)) - (error "Barf!")) + (error "Barf! (2) -- Expected cooked-style-block-element, found ~A" + (cooked-style-display (car ss)))) (setf me (cadar q)) (pop q) @@ -2960,9 +2961,8 @@ (defun make-black-chunk* (char style) (cons-black-chunk :style style - :data (map '(simple-array (unsigned-byte 16) (*)) - #'identity - (list char)))) + :data (map 'rod ;; war: (simple-array (unsigned-byte 16) (*)) + #'identity (list char)))) ;;; first-letter pseudo elements @@ -3072,7 +3072,7 @@ for i fixnum from 0 do (cond ,@(AND (EQL :PRE WHITE-SPACE) - (list `((= c 10) + (list `((eql c #/U+0010) (let ((ocontext context)) ,(OR LETTER-SPACING-APPLICABLE-P '(unless (= blacki i) @@ -3152,10 +3152,10 @@ (reverse ncontext)) :%here ,(IF LETTER-SPACING-APPLICABLE-P `(if (eql word-spacing :normal) - (list (make-black-chunk* 32 (car ss))) - (list (make-black-chunk* 32 (car ss)) + (list (make-black-chunk* #/U+0020 (car ss))) + (list (make-black-chunk* #/U+0020 (car ss)) (make-kern-chunk word-spacing))) - `(list (make-black-chunk* 32 (car ss)))))) + `(list (make-black-chunk* #/U+0020 (car ss)))))) #-NIL (push (make-instance 'disc-chunk @@ -3169,30 +3169,30 @@ (reverse ncontext)) :%here ,(IF LETTER-SPACING-APPLICABLE-P `(if (eql word-spacing :normal) - (list (make-black-chunk* 32 (car ss))) - (list (make-black-chunk* 32 (car ss)) + (list (make-black-chunk* #/U+0020 (car ss))) + (list (make-black-chunk* #/U+0020 (car ss)) (make-kern-chunk word-spacing))) - `(list (make-black-chunk* 32 (car ss))))) + `(list (make-black-chunk* #/U+0020 (car ss))))) res))) ((:PRE) `(progn ,(IF LETTER-SPACING-APPLICABLE-P `(if (eql word-spacing :normal) - (push (make-black-chunk* 32 (car ss)) res) + (push (make-black-chunk* #/U+0020 (car ss)) res) (progn - (push (make-black-chunk* 32 (car ss)) res) + (push (make-black-chunk* #/U+0020 (car ss)) res) (push (make-kern-chunk word-spacing) res))) - `(push (make-black-chunk* 32 (car ss)) res) ) + `(push (make-black-chunk* #/U+0020 (car ss)) res) ) (setf blacki (+ i 1)))) ((:NOWRAP) `(progn ,(IF LETTER-SPACING-APPLICABLE-P `(if (eql word-spacing :normal) - (push (make-black-chunk* 32 (car ss)) res) + (push (make-black-chunk* #/U+0020 (car ss)) res) (progn - (push (make-black-chunk* 32 (car ss)) res) + (push (make-black-chunk* #/U+0020 (car ss)) res) (push (make-kern-chunk word-spacing) res))) - `(push (make-black-chunk* 32 (car ss)) res) ))))))) + `(push (make-black-chunk* #/U+0020 (car ss)) res) ))))))) (t ,(AND LETTER-SPACING-APPLICABLE-P @@ -4969,6 +4969,9 @@ ;; $Log: renderer2.lisp,v $ +;; Revision 1.16 2006/12/29 21:29:39 dlichteblau +;; Use CXML's rune implementation and XML parser. +;; ;; Revision 1.15 2006/11/06 19:43:01 thenriksen ;; Remove compiler-killing evil character from comment. ;;

1 0

[closure-cvs] CVS closure/src/protocols
by dlichteblau 29 Dec '06

29 Dec '06

Update of /project/closure/cvsroot/closure/src/protocols In directory clnet:/tmp/cvs-serv9505/src/protocols Modified Files: package.lisp Log Message: Use CXML's rune implementation and XML parser. --- /project/closure/cvsroot/closure/src/protocols/package.lisp 2005/03/13 18:03:05 1.3 +++ /project/closure/cvsroot/closure/src/protocols/package.lisp 2006/12/29 21:29:33 1.4 @@ -27,7 +27,7 @@ ;;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. (defpackage :CLOSURE-PROTOCOL - (:use :glisp) + (:use :glisp :runes) (:export ;; Basic Element Protocol #:element-p

1 0

[closure-cvs] CVS closure/src/parse
by dlichteblau 29 Dec '06

29 Dec '06

Update of /project/closure/cvsroot/closure/src/parse In directory clnet:/tmp/cvs-serv9505/src/parse Modified Files: package.lisp sgml-dtd.lisp sgml-parse.lisp Log Message: Use CXML's rune implementation and XML parser. --- /project/closure/cvsroot/closure/src/parse/package.lisp 2005/03/13 18:02:40 1.3 +++ /project/closure/cvsroot/closure/src/parse/package.lisp 2006/12/29 21:29:30 1.4 @@ -29,7 +29,7 @@ (in-package :CL-USER) (defpackage :sgml - (:use :glisp) + (:use :glisp :runes) (:export #:SGML-PARSE #:PPT #:SGML-UNPARSE --- /project/closure/cvsroot/closure/src/parse/sgml-dtd.lisp 2005/03/13 18:02:40 1.4 +++ /project/closure/cvsroot/closure/src/parse/sgml-dtd.lisp 2006/12/29 21:29:30 1.5 @@ -367,7 +367,7 @@ ((eq (car def) 'def-entity) (push (cons (second def) (resolve-entities-in-string - (map '(simple-array (unsigned-byte 16) (*)) #'char-code (third def)) + (string-rod (third def)) (dtd-entities dtd))) (dtd-entities dtd))) ((eq (car def) 'defelement) @@ -835,4 +835,4 @@ (defun undump-dtd (filename) (first (excl:fasl-read (open filename :element-type '(unsigned-byte 8))))) -||# \ No newline at end of file +||# --- /project/closure/cvsroot/closure/src/parse/sgml-parse.lisp 2005/03/13 18:02:40 1.4 +++ /project/closure/cvsroot/closure/src/parse/sgml-parse.lisp 2006/12/29 21:29:30 1.5 @@ -240,36 +240,36 @@ (defmacro a-read-byte (input) (let ((c (gensym))) - `(let ((,c (xml:read-rune ,input))) + `(let ((,c (runes:read-rune ,input))) (if (eq ,c :eof) nil ,c)))) (defmacro a-peek-byte (input) (let ((c (gensym))) - `(let ((,c (xml:peek-rune ,input))) + `(let ((,c (runes:peek-rune ,input))) (if (eq ,c :eof) nil ,c)))) (defmacro a-unread-byte (byte input) - `(xml:unread-rune ,byte ,input)) + `(runes:unread-rune ,byte ,input)) (defmacro a-stream-position (input) - `(xml:xstream-position ,input)) + `(runes:xstream-position ,input)) (defun make-a-stream (&key cl-stream) - (xml:make-xstream cl-stream :initial-speed 1 :speed 8192)) + (runes:make-xstream cl-stream :initial-speed 1 :speed 8192)) -(defmethod xml::read-octets (sequence (stream glisp:gstream) start end) +(defmethod runes::read-octets (sequence (stream glisp:gstream) start end) (glisp:g/read-byte-sequence sequence stream :start start :end end)) -(defmethod xml::xstream/close ((stream glisp:gstream)) +(defmethod runes::xstream/close ((stream glisp:gstream)) (glisp:g/close stream)) ;; a fake definition -- XXX non-reentrant! (defun a-stream-scratch (input) - (getf (xml::xstream-plist input) 'scratch-pad)) + (getf (runes::xstream-plist input) 'scratch-pad)) (defun (setf a-stream-scratch) (new-value input) - (setf (getf (xml::xstream-plist input) 'scratch-pad) new-value)) + (setf (getf (runes::xstream-plist input) 'scratch-pad) new-value)) ;;;; ------------------------------------------------------------------------- ;;;; Reporting Errors @@ -295,8 +295,8 @@ (when (>= level *parse-warn-level*) (unless *options/parser-silent-p* (let ((preample (format nil ";; Parser warning: ~11@<Line ~D,~> ~11@<column ~D~>: ~5A " - (and input (ignore-errors (xml:xstream-line-number input))) - (and input (ignore-errors (xml:xstream-column-number input))) + (and input (ignore-errors (runes:xstream-line-number input))) + (and input (ignore-errors (runes:xstream-column-number input))) (make-string level :initial-element #\*)))) (fresh-line *trace-output*) (write-string preample *trace-output*) @@ -351,7 +351,10 @@ (declare (type fixnum sp se)) (loop (let ((ch (a-read-byte input))) - (declare (type (or null (unsigned-byte 8)) ch)) + ;; FIXME: why was this declared as (u-b 8), not (u-b 16)? + ;; a-read-byte returns a rune. +;;; (declare (type (or null (unsigned-byte 8)) ch)) + (declare (type (or null rune) ch)) (cond ((null ch) ;eof (return)) ((rune= ch #/<) ;end of pcdata @@ -622,7 +625,8 @@ (read-sloopy-value input)) (t (read-tag-error input "Bad value '~A' seen" - (or (code-char ch) (format nil "U+~4,'0X" ch))))))) + (or (rune-char ch) + (format nil "U+~4,'0X" (rune-code ch)))))))) (defun read-literal (input dtd delim) (let* ((scratch (a-stream-scratch input)) ;scratch pad @@ -633,7 +637,10 @@ (declare (type fixnum sp se)) (loop (let ((ch (a-read-byte input))) - (declare (type (or null (unsigned-byte 8)) ch)) + ;; FIXME: why was this declared as (u-b 8), not (u-b 16)? + ;; a-read-byte returns a rune. +;;; (declare (type (or null (unsigned-byte 8)) ch)) + (declare (type (or null rune) ch)) (cond ((null ch) ;eof (read-tag-error input "Eof in literal")) ((rune= ch delim) @@ -1038,8 +1045,8 @@ (handle-meta-tag-in-parser input (caddr ausgabe)))) ;; when the BODY tag is openend, switch the streams speed to full speed. (cond ((and (eq (cadr ausgabe) :body)) - (setf (xml::xstream-speed input) - (length (xml::xstream-os-buffer input))))) + (setf (runes::xstream-speed input) + (length (runes::xstream-os-buffer input))))) (let ((n (sgml::make-pt/low :name (cadr ausgabe) :attrs (caddr ausgabe) @@ -1294,7 +1301,7 @@ (defun parse-html (input &optional (charset :iso-8859-1)) (let ((dtd cl-user::*html-dtd*)) - (let ((input (xml:make-xstream input :initial-speed 1 :speed 128))) + (let ((input (runes:make-xstream input :initial-speed 1 :speed 128))) (setf (a-stream-scratch input) (make-array #.(* 2 *buf-size*) :element-type 'rune)) (setup-code-vector input charset) @@ -1583,9 +1590,9 @@ ;; (defun setup-code-vector (input charset) - (let ((enc (xml::find-encoding charset))) + (let ((enc (cxml::find-encoding charset))) (cond ((not (null enc)) - (setf (xml:xstream-encoding input) enc)) + (setf (runes:xstream-encoding input) enc)) (t (parse-warn input 4 "There is no such encoding: ~S." charset))))) @@ -1795,7 +1802,7 @@ #|| (format T "~&;; Parse error (line ~D column ~D): [~A] Saw ~A in ~A." - (xml:xstream-line-number input) - (xml:xstream-column-number input)) + (runes:xstream-line-number input) + (runes:xstream-column-number input)) -||# \ No newline at end of file +||#

1 0

[closure-cvs] CVS closure/src/net
by dlichteblau 29 Dec '06

29 Dec '06

Update of /project/closure/cvsroot/closure/src/net In directory clnet:/tmp/cvs-serv9505/src/net Modified Files: package.lisp url.lisp Log Message: Use CXML's rune implementation and XML parser. --- /project/closure/cvsroot/closure/src/net/package.lisp 2005/03/13 18:02:19 1.2 +++ /project/closure/cvsroot/closure/src/net/package.lisp 2006/12/29 21:29:29 1.3 @@ -30,7 +30,7 @@ (defpackage :ws/netlib (:nicknames :netlib) - (:use :glisp :url) + (:use :glisp :url :runes) (:export #:*options/connection-timeout* #:open-document #:with-open-document --- /project/closure/cvsroot/closure/src/net/url.lisp 2005/03/13 18:02:19 1.5 +++ /project/closure/cvsroot/closure/src/net/url.lisp 2006/12/29 21:29:29 1.6 @@ -41,7 +41,7 @@ ;(require :glisp) (defpackage :url - (:use :glisp) + (:use :glisp :runes) (:export #:parse-url #:unparse-url @@ -206,11 +206,7 @@ (declaim (inline ascii-digit-char-p)) (defun parse-url (input &key (plain-query-p t)) - (cond ((sloopy-rod-p input) - ;; zzz use UTF-8 - (parse-url (map 'string (lambda (x) (or (code-char x) #\?)) input) - :plain-query-p plain-query-p)) - ((stringp input) + (cond ((stringp input) (let ((anchor nil) (protocol nil) (net-loc nil) @@ -263,6 +259,10 @@ :path (mapcar #'unescape-string path) :query (if plain-query-p query (parse-query query)) :anchor (unescape-string anchor)) ))))) + ((sloopy-rod-p input) + ;; zzz use UTF-8 + (parse-url (map 'string (lambda (x) (or (rune-char x) #\?)) input) + :plain-query-p plain-query-p)) ((eq input NIL) (warn "Saw NIL as input to URL:PARSE-URL; fix your program.") (parse-url "" :plain-query-p plain-query-p))

1 0

[closure-cvs] CVS closure/src/html
by dlichteblau 29 Dec '06

29 Dec '06

Update of /project/closure/cvsroot/closure/src/html In directory clnet:/tmp/cvs-serv9505/src/html Modified Files: html-style.lisp Log Message: Use CXML's rune implementation and XML parser. --- /project/closure/cvsroot/closure/src/html/html-style.lisp 2005/07/17 09:38:52 1.7 +++ /project/closure/cvsroot/closure/src/html/html-style.lisp 2006/12/29 21:29:28 1.8 @@ -94,7 +94,7 @@ (defun pt-all-data (x) (cond ((member (element-gi x) '(:pcdata :comment)) - (map 'string (lambda (x) (or (code-char x) #\?)) + (map 'string (lambda (x) (or (rune-char x) #\?)) (element-text x))) ((apply 'concatenate 'string (mapcar #'pt-all-data (element-children x)))))) @@ -112,7 +112,7 @@ (defun pt-attr/latin1 (pt attr &optional default) (let ((r (pt-attr/low pt attr))) (if r - (map 'string (lambda (x) (if (< x 256) (code-char x) #\?)) r) + (map 'string (lambda (x) (if (< (rune-code x) 256) (rune-char x) #\?)) r) default))) (defmethod closure-protocol:element-explicit-style (document (pt sgml::pt)) @@ -191,9 +191,6 @@ (t (format nil "[invalid html-length: ~S]" value)))) -(defun rune->char (x) - (or (code-char x) #\?)) - (defun rod->string (x) (map 'simple-string (lambda (x) (or (code-char x) #\?)) x)) @@ -233,7 +230,7 @@ (let ((val (some (lambda (key) (and (= (length s) (length (symbol-name key))) (every (lambda (x y) - (char-equal (rune->char x) y)) + (char-equal (rune-char x) y)) s (symbol-name key)) key)) keys)))

1 0

[closure-cvs] CVS closure/src/imagelib
by dlichteblau 29 Dec '06

29 Dec '06

Update of /project/closure/cvsroot/closure/src/imagelib In directory clnet:/tmp/cvs-serv9505/src/imagelib Modified Files: package.lisp Log Message: Use CXML's rune implementation and XML parser. --- /project/closure/cvsroot/closure/src/imagelib/package.lisp 2005/03/13 18:02:01 1.2 +++ /project/closure/cvsroot/closure/src/imagelib/package.lisp 2006/12/29 21:29:28 1.3 @@ -29,7 +29,7 @@ (in-package :CL-USER) (defpackage :imagelib - (:use :glisp) + (:use :glisp :runes) (:export #:aimage #:aimage-width

1 0

[closure-cvs] CVS closure/src/gui
by dlichteblau 29 Dec '06

29 Dec '06

Update of /project/closure/cvsroot/closure/src/gui In directory clnet:/tmp/cvs-serv9505/src/gui Modified Files: clue-gui.lisp Log Message: Use CXML's rune implementation and XML parser. --- /project/closure/cvsroot/closure/src/gui/clue-gui.lisp 2005/03/13 18:01:37 1.3 +++ /project/closure/cvsroot/closure/src/gui/clue-gui.lisp 2006/12/29 21:29:27 1.4 @@ -115,7 +115,7 @@ ((member mime-type (list (netlib:find-mime-type "text/html"))) (sgml::parse-html input charset)) ((member mime-type (list (netlib:find-mime-type "text/xml"))) - (xml::parse-stream input)) + (cxml:parse-stream input (cxml-dom:make-dom-builder) :recode nil)) ((or t #+NIL @@ -214,6 +214,10 @@ (serial :initarg :serial) (dumpee :initarg :dumpee :initform nil) ) ) +(defmethod runes::figure-encoding ((stream glisp:gstream)) + ;; For HTML iso-8859-1 is the default + (values (cxml::find-encoding :iso-8859-1) nil)) + (defmethod g/read-byte ((stream pb-stream) &optional (eof-error-p t) eof-value) (with-slots (nread ntotal proxee dumpee) stream (let ((res (g/read-byte proxee eof-error-p eof-value)))

1 0

[closure-cvs] CVS closure/src/glisp
by dlichteblau 29 Dec '06

29 Dec '06

Update of /project/closure/cvsroot/closure/src/glisp In directory clnet:/tmp/cvs-serv9505/src/glisp Modified Files: package.lisp util.lisp Log Message: Use CXML's rune implementation and XML parser. --- /project/closure/cvsroot/closure/src/glisp/package.lisp 2005/03/13 18:01:15 1.4 +++ /project/closure/cvsroot/closure/src/glisp/package.lisp 2006/12/29 21:29:25 1.5 @@ -285,35 +285,6 @@ "LREDUCE*" "WITH-UNIQUE-NAMES" - ;; runes.lisp - "RUNE" - "ROD" - "SIMPLE-ROD" - "%RUNE" - "ROD-CAPITALIZE" - "CODE-RUNE" - "RUNE-CODE" - "RUNE-DOWNCASE" - "RUNE-UPCASE" - "ROD-DOWNCASE" - "ROD-UPCASE" - "WHITE-SPACE-RUNE-P" - "DIGIT-RUNE-P" - "RUNE=" - "RUNE<=" - "RUNE>=" - "RUNE-EQUAL" - "RUNEP" - "SLOOPY-ROD-P" - "ROD=" - "ROD-EQUAL" - "MAKE-ROD" - "CHAR-RUNE" - "RUNE-CHAR" - "ROD-STRING" - "STRING-ROD" - "ROD-SUBSEQ" - "G/MAKE-HASH-TABLE" "G/HASHGET" "G/CLRHASH" --- /project/closure/cvsroot/closure/src/glisp/util.lisp 2005/03/13 18:01:16 1.4 +++ /project/closure/cvsroot/closure/src/glisp/util.lisp 2006/12/29 21:29:25 1.5 @@ -216,14 +216,16 @@ (t (subseq string start))))) (defun sanify-rod (string &optional (begin? t) (end? t) (start 0)) - (let ((i (position-if #'white-space-rune-p string :start start))) + (let ((i (position-if #'runes:white-space-rune-p string :start start))) (cond (i - (let ((j (position-if-not #'white-space-rune-p string :start i))) + (let ((j (position-if-not #'runes:white-space-rune-p + string + :start i))) (if j - (concatenate 'rod (subseq string start i) + (concatenate 'runes:rod (subseq string start i) (if (and (= i start) begin?) '#() '#(32)) (sanify-rod string nil end? j)) - (concatenate 'rod (subseq string start i) + (concatenate 'runes:rod (subseq string start i) (if (not end?) '#(32) '#()))))) (t (subseq string start)))))

1 0

[closure-cvs] CVS closure/src/css
by dlichteblau 29 Dec '06

29 Dec '06

Update of /project/closure/cvsroot/closure/src/css In directory clnet:/tmp/cvs-serv9505/src/css Modified Files: css-parse.lisp css-selector.lisp css-support.lisp package.lisp Log Message: Use CXML's rune implementation and XML parser. --- /project/closure/cvsroot/closure/src/css/css-parse.lisp 2005/07/17 09:38:51 1.5 +++ /project/closure/cvsroot/closure/src/css/css-parse.lisp 2006/12/29 21:29:23 1.6 @@ -1145,7 +1145,16 @@ (defmacro generate-slot-constants () (generate-slot-constants-1)) +;;; Fixme! Some parts of the CSS parser use code integers rather than runes. +;;; Here some dummy definitions to use in those cases: +(defun white-space-hieroglyph-p (x) + (white-space-rune-p (code-rune x))) +(defun hieroglyph= (a b) + (eql a b)) +(defun hieroglyph-equal (a b) + (equal a b)) + (defun find-value-parser (slot) + (unless (typep slot 'rod) + (setf slot (map 'rod #'code-rune slot))) (gethash (rod-downcase slot) *value-parsers*)) - - --- /project/closure/cvsroot/closure/src/css/css-selector.lisp 2006/12/26 14:19:18 1.7 +++ /project/closure/cvsroot/closure/src/css/css-selector.lisp 2006/12/29 21:29:24 1.8 @@ -272,22 +272,22 @@ ((pclass) (cond ((and (= (length (cdr pred)) 1) - (rod-equal #.(map 'vector #'char-code "first-child") (cadr pred))) + (rod-equal #"first-child" (cadr pred))) (null (pt-predecessor element))) ((and (= (length (cdr pred)) 1) - (rod-equal #.(map 'vector #'char-code "link") (cadr pred))) + (rod-equal #"link" (cadr pred))) (pseudo-class-matches-p :link element)) ((and (= (length (cdr pred)) 1) - (rod-equal #.(map 'vector #'char-code "first-line") (cadr pred))) + (rod-equal #"first-line" (cadr pred))) (pseudo-class-matches-p :first-line element)) ((and (= (length (cdr pred)) 1) - (rod-equal #.(map 'vector #'char-code "first-letter") (cadr pred))) + (rod-equal #"first-letter" (cadr pred))) (pseudo-class-matches-p :first-letter element)) ((and (= (length (cdr pred)) 1) - (rod-equal #.(map 'vector #'char-code "before") (cadr pred))) + (rod-equal #"before" (cadr pred))) (pseudo-class-matches-p :before element)) ((and (= (length (cdr pred)) 1) - (rod-equal #.(map 'vector #'char-code "after") (cadr pred))) + (rod-equal #"after" (cadr pred))) (pseudo-class-matches-p :after element)) ;; lang fehlt. (t @@ -374,13 +374,13 @@ ;; what should (rod-contains-p .. "" ..) yield? (dotimes (i (- (length haystack) (length needle) -1) nil) (when (and (or (= i 0) - (white-space-rune-p (rune haystack (1- i)))) + (white-space-hieroglyph-p (hieroglyph haystack (1- i)))) (or (= (+ i (length needle)) (length haystack)) - (white-space-rune-p (rune haystack (+ i (length needle)))))) + (white-space-hieroglyph-p (hieroglyph haystack (+ i (length needle)))))) (when (dotimes (j (length needle) t) (unless (if case-sensitive-p - (rune= (rune needle j) (rune haystack (+ i j))) - (rune-equal (rune needle j) (rune haystack (+ i j)))) + (hieroglyph= (hieroglyph needle j) (hieroglyph haystack (+ i j))) + (hieroglyph-equal (hieroglyph needle j) (hieroglyph haystack (+ i j)))) (return nil))) (return t))))) @@ -392,7 +392,7 @@ (rod= (subseq v 0 (length string)) string) (rod-equal (subseq v 0 (length string)) string)) (or (= (length string) (length v)) - (rune= (code-rune #.(char-code #\-)) (rune v (length string))))))) + (hieroglyph= (code-hieroglyph #.(char-code #\-)) (hieroglyph v (length string))))))) (defun skip-group (seq p &optional (level 0)) (cond ((>= p (length seq)) @@ -825,8 +825,9 @@ (multiple-value-bind (sel-list condition) (ignore-errors (parse-css2-selector-list seq p0 p1)) (cond (condition - (warn "CSS selector list does not parse: `~A'." - (as-string (subseq seq p0 p1))) + (warn "CSS selector list does not parse: `~A'.~% [~A]" + (as-string (subseq seq p0 p1)) + condition) (setq sel-list nil))) (nconc (multiplex-selectors sel-list (parse-assignment-list --- /project/closure/cvsroot/closure/src/css/css-support.lisp 2005/03/13 18:00:58 1.3 +++ /project/closure/cvsroot/closure/src/css/css-support.lisp 2006/12/29 21:29:24 1.4 @@ -39,7 +39,7 @@ (defun intern-attribute-name (string) ;; XXX hack - (intern (string-upcase (map 'string (lambda (x) (or (code-char x) #\?)) string)) :keyword)) + (intern (string-upcase (map 'string (lambda (x) (or (rune-char x) #\?)) string)) :keyword)) (defun intern-gi (string) (intern-attribute-name string)) --- /project/closure/cvsroot/closure/src/css/package.lisp 2005/03/13 18:00:58 1.3 +++ /project/closure/cvsroot/closure/src/css/package.lisp 2006/12/29 21:29:24 1.4 @@ -28,7 +28,7 @@ (in-package :CL-USER) (defpackage :css - (:use :glisp) + (:use :glisp :runes) ;; (:import-from "CLOSURE-PROTOCOL" ;; basic element protocol

1 0

← Newer
1
...
9
10
11
12
13
14
15
...
21
Older →

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

closure-cvs