Changeset 3377

Show
Ignore:
Timestamp:
06/29/08 16:25:31 (6 months ago)
Author:
hans
Message:

pull from git

Files:

Legend:

Unmodified
Added
Removed
Modified
Copied
Moved

  • trunk/thirdparty/xuriella/.git/logs/HEAD

    r3108 r3377  
    110000000000000000000000000000000000000000 597e3261a39717ea6937c225486e2263a438ab87 Hans Huebner <hans@netzhansa.com> 1210314314 +0000 
     2597e3261a39717ea6937c225486e2263a438ab87 5932fdcf8c40e0d81b5f344dc9d98ee064f0ce06 Hans Huebner <hans@voltaren.huebner.org> 1214749586 +0000     pull : Fast forward 

  • trunk/thirdparty/xuriella/.git/logs/refs/heads/master

    r3108 r3377  
    110000000000000000000000000000000000000000 597e3261a39717ea6937c225486e2263a438ab87 Hans Huebner <hans@netzhansa.com> 1210314314 +0000 
     2597e3261a39717ea6937c225486e2263a438ab87 5932fdcf8c40e0d81b5f344dc9d98ee064f0ce06 Hans Huebner <hans@voltaren.huebner.org> 1214749586 +0000     pull : Fast forward 

  • trunk/thirdparty/xuriella/.git/logs/refs/remotes/origin/master

    r3108 r3377  
    110000000000000000000000000000000000000000 597e3261a39717ea6937c225486e2263a438ab87 Hans Huebner <hans@netzhansa.com> 1210314314 +0000    clone: from git://repo.or.cz/xuriella.git 
     2597e3261a39717ea6937c225486e2263a438ab87 5932fdcf8c40e0d81b5f344dc9d98ee064f0ce06 Hans Huebner <hans@voltaren.huebner.org> 1214749530 +0000     pull : fast forward 

  • trunk/thirdparty/xuriella/.git/refs/heads/master

    r3108 r3377  
    1 597e3261a39717ea6937c225486e2263a438ab87 
     15932fdcf8c40e0d81b5f344dc9d98ee064f0ce06 

  • trunk/thirdparty/xuriella/.git/refs/remotes/origin/master

    r3108 r3377  
    1 597e3261a39717ea6937c225486e2263a438ab87 
     15932fdcf8c40e0d81b5f344dc9d98ee064f0ce06 

  • trunk/thirdparty/xuriella/package.lisp

    r3108 r3377  
    5454           #:define-extension-compiler 
    5555           #:parse-body 
    56            #:compile-instruction) 
     56           #:compile-instruction 
     57 
     58           #:enable-profiling 
     59           #:disable-profiling 
     60           #:report) 
    5761  (:import-from :xpath-protocol #:define-default-method) 
    5862  (:documentation 
    …… 
    7882      @aboutfun{parse-stylesheet} 
    7983      @aboutclass{stylesheet} 
     84    @end{section} 
     85    @begin[Profiling support]{section} 
     86     The profiling facility records the run time of XSLT templates. 
     87 
     88     @aboutfun{enable-profiling} 
     89     @aboutfun{disable-profiling} 
     90     @aboutfun{report} 
    8091    @end{section} 
    8192    @begin[Defining extension elements]{section} 

  • trunk/thirdparty/xuriella/parser.lisp

    r3108 r3377  
    210210        `(xsl:terminate 
    211211           (xsl:text 
    212             "no fallback children in unknown element using forwards compatible processing"))))) 
     212            ,(format nil "no fallback children in unknown element ~A/~A using forwards compatible processing" 
     213                     (stp:local-name node) 
     214                     (stp:namespace-uri node))))))) 
    213215 
    214216(defmacro define-instruction-parser (name (node-var) &body body) 

  • trunk/thirdparty/xuriella/unparse.lisp

    r3148 r3377  
    5757  (funcall fn *sink*)) 
    5858 
     59(defmacro defun/unparse (name (&rest args) &body body) 
     60  `(defun ,name ,args 
     61     (with-profile-counter (*unparse-xml-counter*) 
     62       (let ((*unparse-xml-counter* nil)) 
     63         ,@body)))) 
     64 
    5965(defmacro with-element 
    6066    ((local-name uri &key suggested-prefix extra-namespaces process-aliases) 
    …… 
    6773                        :process-aliases ,process-aliases)) 
    6874 
    69 (defun doctype (name public-id system-id &optional internal-subset) 
     75(defun/unparse doctype (name public-id system-id &optional internal-subset) 
    7076  (sax:start-dtd *sink* name public-id system-id) 
    7177  (when internal-subset 
    7278    (sax:unparsed-internal-subset *sink* internal-subset)) 
    7379  (sax:end-dtd *sink*)) 
    74  
    75 (defstruct sink-element 
    76   local-name 
    77   uri 
    78   suggested-prefix 
    79   all-namespaces 
    80   new-namespaces 
    81   used-prefixes 
    82   attributes 
    83   actual-qname) 
    84  
    85 (defstruct sink-attribute 
    86   local-name 
    87   uri 
    88   suggested-prefix 
    89   value) 
    9080 
    9181(defun maybe-emit-start-tag () 
    …… 
    187177   :value uri)) 
    188178 
     179(defstruct sink-element 
     180  local-name 
     181  uri 
     182  suggested-prefix 
     183  all-namespaces 
     184  new-namespaces 
     185  used-prefixes 
     186  attributes 
     187  actual-qname) 
     188 
     189(defstruct sink-attribute 
     190  local-name 
     191  uri 
     192  suggested-prefix 
     193  value) 
     194 
    189195(defparameter *initial-unparse-namespaces* 
    190196  '(("" . "") 
    …… 
    199205(defun invoke-with-element 
    200206    (fn local-name uri &key suggested-prefix extra-namespaces process-aliases) 
    201   (check-type local-name string) 
    202   (check-type uri string) 
    203   (check-type suggested-prefix (or null string)) 
    204   (maybe-emit-start-tag) 
    205   (when process-aliases 
    206     (setf uri (unalias-uri uri))) 
     207  ;; fixme: don't litter this function with calls to with-profile-counter 
     208  (with-profile-counter (*unparse-xml-counter*) 
     209    (check-type local-name string) 
     210    (check-type uri string) 
     211    (check-type suggested-prefix (or null string)) 
     212    (maybe-emit-start-tag) 
     213    (when process-aliases 
     214      (setf uri (unalias-uri uri)))) 
    207215  (let* ((parent *current-element*) 
    208216         (elt (make-sink-element 
    …… 
    217225         (*current-element* elt) 
    218226         (*start-tag-written-p* nil)) 
    219     ;; always establish explicitly copied namespaces first 
    220     ;; (not including declarations of the default namespace) 
    221     (process-extra-namespaces elt extra-namespaces process-aliases) 
    222     ;; establish the element's prefix (which might have to be the default 
    223     ;; namespace if it's the empty URI) 
    224     (ensure-prefix-for-uri elt uri suggested-prefix) 
     227    (with-profile-counter (*unparse-xml-counter*) 
     228      ;; always establish explicitly copied namespaces first 
     229      ;; (not including declarations of the default namespace) 
     230      (process-extra-namespaces elt extra-namespaces process-aliases) 
     231      ;; establish the element's prefix (which might have to be the default 
     232      ;; namespace if it's the empty URI) 
     233      (ensure-prefix-for-uri elt uri suggested-prefix)) 
    225234    ;; we'll do attributes incrementally 
    226235    (multiple-value-prog1 
    227236        (funcall fn) 
    228       (maybe-emit-start-tag) 
    229       (sax:end-element *sink* uri local-name (sink-element-actual-qname elt)) 
    230       (loop 
    231          for (prefix . uri) in (sink-element-new-namespaces elt) do 
    232          (sax:end-prefix-mapping *sink* prefix))))) 
     237      (with-profile-counter (*unparse-xml-counter*) 
     238        (maybe-emit-start-tag) 
     239        (sax:end-element *sink* uri local-name (sink-element-actual-qname elt)) 
     240        (loop 
     241           for (prefix . uri) in (sink-element-new-namespaces elt) do 
     242           (sax:end-prefix-mapping *sink* prefix)))))) 
    233243 
    234244(defun process-extra-namespace (elt prefix uri process-aliases) 
    …… 
    270280       (push cons (sink-element-new-namespaces elt)))))) 
    271281 
    272 (defun write-attribute 
     282(defun/unparse write-attribute 
    273283    (local-name uri value &key suggested-prefix process-aliases) 
    274284  (check-type local-name string) 
    …… 
    297307                            (sink-element-attributes *current-element*))))))) 
    298308 
    299 (defun write-extra-namespace (prefix uri process-aliases) 
     309(defun/unparse write-extra-namespace (prefix uri process-aliases) 
    300310  (check-type prefix string) 
    301311  (check-type uri string) 
    …… 
    310320     (process-extra-namespace *current-element* prefix uri process-aliases)))) 
    311321 
    312 (defun write-text (data) 
     322(defun/unparse write-text (data) 
    313323  (maybe-emit-start-tag) 
    314324  (sax:characters *sink* data) 
    315325  data) 
    316326 
    317 (defun write-comment (data) 
     327(defun/unparse write-comment (data) 
    318328  (maybe-emit-start-tag) 
    319329  ;; kludge: rewrite this in a nicer way 
    …… 
    330340       (cxml::nc-name-p str))) 
    331341 
    332 (defun write-processing-instruction (target data) 
     342(defun/unparse write-processing-instruction (target data) 
    333343  (maybe-emit-start-tag) 
    334344  (setf data (cl-ppcre:regex-replace-all "[?]>" data "? >")) 
    …… 
    340350  data) 
    341351 
    342 (defun write-unescaped (str) 
     352(defun/unparse write-unescaped (str) 
    343353  (maybe-emit-start-tag) 
    344354  (sax:unescaped *sink* str)) 

  • trunk/thirdparty/xuriella/xslt.lisp

    r3148 r3377  
    151151;;;     (funcall fn))) 
    152152 
     153(defstruct profile-counter calls run real) 
     154 
     155(defvar *apply-stylesheet-counter* (make-profile-counter)) 
     156(defvar *parse-stylesheet-counter* (make-profile-counter)) 
     157(defvar *parse-xml-counter* (make-profile-counter)) 
     158(defvar *unparse-xml-counter* (make-profile-counter)) 
     159 
     160(defmacro with-profile-counter ((var) &body body) 
     161  `((lambda (fn) 
     162      (if (and *profiling-enabled-p* ,var) 
     163          (invoke-with-profile-counter fn ,var) 
     164          (funcall fn))) 
     165    (lambda () ,@body))) 
     166 
    153167 
    154168;;;; Helper functions and macros 
    …… 
    525539    (stp:append-child new-document-element new-template) 
    526540    (stp:append-child new-template literal-result-element) 
     541    (setf (stp:base-uri new-template) (stp:base-uri literal-result-element)) 
    527542    new-document-element)) 
    528543 
    …… 
    716731 
    717732(defvar *stylesheet*) 
    718  
    719 (defstruct template 
    720   match-expression 
    721   compiled-pattern 
    722   name 
    723   import-priority 
    724   apply-imports-limit 
    725   priority 
    726   position 
    727   mode 
    728   mode-qname 
    729   params 
    730   body 
    731   n-variables) 
    732733 
    733734(defun parse-stylesheet (designator &key uri-resolver) 
    …… 
    12311232        (with-import-magic (<template> env) 
    12321233          (dolist (template (compile-template <template> env i)) 
     1234            (setf (template-stylesheet template) stylesheet) 
     1235            (setf (template-base-uri template) (stp:base-uri <template>)) 
    12331236            (let ((name (template-name template))) 
    12341237              (if name 
    …… 
    13901393  (let ((instruction-base-uri *instruction-base-uri*)) 
    13911394    (lambda (ctx) 
    1392       (let* ((object (funcall object ctx)) 
    1393              (node-set (and node-set (funcall node-set ctx))) 
    1394              (base-uri 
    1395               (if node-set 
    1396                   (document-base-uri (xpath::textually-first-node node-set)) 
    1397                   instruction-base-uri))) 
    1398         (xpath-sys:make-node-set 
    1399          (if (xpath:node-set-p object) 
    1400              (xpath:map-node-set->list 
    1401               (lambda (node) 
    1402                 (%document (xpath:string-value node) 
    1403                            (if node-set 
    1404                                base-uri 
    1405                                (document-base-uri node)))) 
    1406               object) 
    1407              (list (%document (xpath:string-value object) base-uri)))))))) 
     1395      (with-profile-counter (*parse-xml-counter*) 
     1396        (let* ((object (funcall object ctx)) 
     1397               (node-set (and node-set (funcall node-set ctx))) 
     1398               (base-uri 
     1399                (if node-set 
     1400                    (document-base-uri (xpath::textually-first-node node-set)) 
     1401                    instruction-base-uri))) 
     1402          (xpath-sys:make-node-set 
     1403           (if (xpath:node-set-p object) 
     1404               (xpath:map-node-set->list 
     1405                (lambda (node) 
     1406                  (%document (xpath:string-value node) 
     1407                             (if node-set 
     1408                                 base-uri 
     1409                                 (document-base-uri node)))) 
     1410                object) 
     1411               (list (%document (xpath:string-value object) base-uri))))))))) 
    14081412 
    14091413 
    …… 
    16031607 
    16041608   @see{parse-stylesheet}" 
    1605   (when (typep stylesheet 'xml-designator) 
    1606     (setf stylesheet 
    1607           (handler-bind 
    1608               ((cxml:xml-parse-error 
    1609                 (lambda (c) 
    1610                   (xslt-error "cannot parse stylesheet: ~A" c)))) 
    1611             (parse-stylesheet stylesheet :uri-resolver uri-resolver)))) 
    1612   (with-resignalled-errors () 
    1613     (invoke-with-output-sink 
    1614      (lambda () 
    1615        (let* ((*uri-to-document* (make-hash-table :test 'equal)) 
    1616               (*root-to-document* 
    1617                ;; fixme? should be xpath-protocol:node-equal 
    1618                (make-hash-table :test 'equal)) 
    1619               (xpath:*navigator* (or navigator :default-navigator)) 
    1620               (puri:*strict-parse* nil) 
    1621               (*stylesheet* stylesheet) 
    1622               (*empty-mode* (make-mode)) 
    1623               (*default-mode* (find-mode stylesheet nil)) 
    1624               (global-variable-chains 
    1625                (stylesheet-global-variables stylesheet)) 
    1626               (*global-variable-values* 
    1627                (make-variable-value-array (length global-variable-chains))) 
    1628               (*uri-resolver* uri-resolver) 
    1629               (source-document 
    1630                (if (typep source-designator 'xml-designator) 
    1631                    (cxml:parse source-designator (stp:make-builder)) 
    1632                    source-designator)) 
    1633               (xpath-root-node 
    1634                (make-whitespace-stripper 
    1635                 source-document 
    1636                 (stylesheet-strip-thunk stylesheet))) 
    1637               (ctx (xpath:make-context xpath-root-node)) 
    1638               (document (make-source-document 
    1639                          :id 0 
    1640                          :root-node xpath-root-node))) 
    1641          (when (pathnamep source-designator) ;fixme: else use base uri? 
    1642            (setf (gethash source-designator *uri-to-document*) document)) 
    1643          (setf (gethash xpath-root-node *root-to-document*) document) 
    1644          (map nil 
    1645               (lambda (chain) 
    1646                 (let ((head (car (variable-chain-definitions chain)))) 
    1647                   (when (variable-param-p head) 
    1648                     (let ((value 
    1649                            (find-parameter-value 
    1650                             (variable-chain-local-name chain) 
    1651                             (variable-chain-uri chain) 
    1652                             parameters))) 
    1653                       (when value 
    1654                         (setf (global-variable-value 
    1655                                (variable-chain-index chain)) 
    1656                               value)))))) 
    1657               global-variable-chains) 
    1658          (map nil 
    1659               (lambda (chain) 
    1660                 (funcall (variable-chain-thunk chain) ctx)) 
    1661               global-variable-chains) 
    1662          ;; zzz we wouldn't have to mask float traps here if we used the 
    1663          ;; XPath API properly.  Unfortunately I've been using FUNCALL 
    1664          ;; everywhere instead of EVALUATE, so let's paper over that 
    1665          ;; at a central place to be sure: 
    1666          (xpath::with-float-traps-masked () 
    1667            (apply-templates ctx :mode *default-mode*)))) 
    1668      (stylesheet-output-specification stylesheet) 
    1669      output))) 
     1609  (with-profile-counter (*apply-stylesheet-counter*) 
     1610    (when (typep stylesheet 'xml-designator) 
     1611      (with-profile-counter (*parse-stylesheet-counter*) 
     1612        (setf stylesheet 
     1613              (handler-bind 
     1614                  ((cxml:xml-parse-error 
     1615                    (lambda (c) 
     1616                      (xslt-error "cannot parse stylesheet: ~A" c)))) 
     1617                (parse-stylesheet stylesheet :uri-resolver uri-resolver))))) 
     1618    (with-resignalled-errors () 
     1619      (invoke-with-output-sink 
     1620       (lambda () 
     1621         (let* ((*uri-to-document* (make-hash-table :test 'equal)) 
     1622                (*root-to-document* 
     1623                 ;; fixme? should be xpath-protocol:node-equal 
     1624                 (make-hash-table :test 'equal)) 
     1625                (xpath:*navigator* (or navigator :default-navigator)) 
     1626                (puri:*strict-parse* nil) 
     1627                (*stylesheet* stylesheet) 
     1628                (*empty-mode* (make-mode)) 
     1629                (*default-mode* (find-mode stylesheet nil)) 
     1630                (global-variable-chains 
     1631                 (stylesheet-global-variables stylesheet)) 
     1632                (*global-variable-values* 
     1633                 (make-variable-value-array (length global-variable-chains))) 
     1634                (*uri-resolver* uri-resolver) 
     1635                (source-document 
     1636                 (if (typep source-designator 'xml-designator) 
     1637                     (with-profile-counter (*parse-xml-counter*) 
     1638                       (cxml:parse source-designator (stp:make-builder))) 
     1639                     source-designator)) 
     1640                (xpath-root-node 
     1641                 (make-whitespace-stripper 
     1642                  source-document 
     1643                  (stylesheet-strip-thunk stylesheet))) 
     1644                (ctx (xpath:make-context xpath-root-node)) 
     1645                (document (make-source-document 
     1646                           :id 0 
     1647                           :root-node xpath-root-node))) 
     1648           (when (pathnamep source-designator) ;fixme: else use base uri? 
     1649             (setf (gethash source-designator *uri-to-document*) document)) 
     1650           (setf (gethash xpath-root-node *root-to-document*) document) 
     1651           (map nil 
     1652                (lambda (chain) 
     1653                  (let ((head (car (variable-chain-definitions chain)))) 
     1654                    (when (variable-param-p head) 
     1655                      (let ((value 
     1656                             (find-parameter-value 
     1657                              (variable-chain-local-name chain) 
     1658                              (variable-chain-uri chain) 
     1659                              parameters))) 
     1660                        (when value 
     1661                          (setf (global-variable-value 
     1662                                 (variable-chain-index chain)) 
     1663                                value)))))) 
     1664                global-variable-chains) 
     1665           (map nil 
     1666                (lambda (chain) 
     1667                  (funcall (variable-chain-thunk chain) ctx)) 
     1668                global-variable-chains) 
     1669           ;; zzz we wouldn't have to mask float traps here if we used the 
     1670           ;; XPath API properly.  Unfortunately I've been using FUNCALL 
     1671           ;; everywhere instead of EVALUATE, so let's paper over that 
     1672           ;; at a central place to be sure: 
     1673           (xpath::with-float-traps-masked () 
     1674             (apply-templates ctx :mode *default-mode*)))) 
     1675       (stylesheet-output-specification stylesheet) 
     1676       output)))) 
    16701677 
    16711678(defun find-attribute-set (local-name uri &optional (stylesheet *stylesheet*)) 
    …… 
    17271734 
    17281735(defvar *apply-imports*) 
     1736(defvar *profiling-enabled-p* nil) 
    17291737 
    17301738(defun apply-applicable-templates (ctx templates param-bindings finally) 
    …… 
    17391747                            (<= low (template-import-priority x) high)) 
    17401748                          templates)) 
    1741                    (invoke-template ctx this actual-param-bindings)) 
     1749                   (if *profiling-enabled-p* 
     1750                       (invoke-template/profile ctx this actual-param-bindings) 
     1751                       (invoke-template ctx this actual-param-bindings))) 
    17421752                 (funcall finally)))) 
    17431753    (let ((*apply-imports* #'apply-imports)) 
    …… 
    18661876           (make-auto-detect-sink (make-combi-sink) method-key))))))) 
    18671877 
     1878(defstruct template 
     1879  match-expression 
     1880  compiled-pattern 
     1881  name 
     1882  import-priority 
     1883  apply-imports-limit 
     1884  priority 
     1885  position 
     1886  mode 
     1887  mode-qname 
     1888  params 
     1889  body 
     1890  n-variables 
     1891  ;; for profiling output only: 
     1892  unparsed-qname 
     1893  stylesheet 
     1894  base-uri) 
     1895 
    18681896(defun expression-priority (form) 
    18691897  (let ((step (second form))) 
    …… 
    19701998                             :params param-bindings 
    19711999                             :body outer-body-thunk 
    1972                              :n-variables n-variables)))) 
     2000                             :n-variables n-variables 
     2001                             ;; record unparsed `name' for profiler output: 
     2002                             :unparsed-qname name)))) 
    19732003         (when match 
    19742004           (mapcar (lambda (expression) 

  • trunk/thirdparty/xuriella/xuriella.asd

    r3108 r3377  
    2929     (:file "stpx") 
    3030     (:file "extensions") 
     31     (:file "profile") 
    3132     (:file "test")) 
    3233    :depends-on (:cxml :cxml-stp :closure-html :xpath :split-sequence))