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