[closure-cvs] CVS closure/src/css

[dlichteblau]

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