From d44c702718baea4c4557d12ca8dd7dab724c7fb6 Mon Sep 17 00:00:00 2001
From: Ricardo Wurmus <rekado@elephly.net>
Date: Mon, 4 Feb 2019 21:39:06 +0100
Subject: [PATCH] sxml: xml->sxml: Record and use namespace abbreviations.

* module/sxml/simple.scm (xml->sxml)
[name->sxml]: Accept namespaces argument to look up abbreviation.
Return name with abbreviation prefix.
[parser]: Let FINISH-ELEMENT procedure return namespaces in addition to
the SXML tree's attributes.
---
 module/sxml/simple.scm | 34 +++++++++++++++++++++++++---------
 1 file changed, 25 insertions(+), 9 deletions(-)

diff --git a/module/sxml/simple.scm b/module/sxml/simple.scm
index 703ad9137..2bb332c83 100644
--- a/module/sxml/simple.scm
+++ b/module/sxml/simple.scm
@@ -1,7 +1,8 @@
 ;;;; (sxml simple) -- a simple interface to the SSAX parser
 ;;;;
-;;;; 	Copyright (C) 2009, 2010, 2013  Free Software Foundation, Inc.
+;;;; 	Copyright (C) 2009, 2010, 2013, 2019  Free Software Foundation, Inc.
 ;;;;    Modified 2004 by Andy Wingo <wingo at pobox dot com>.
+;;;;    Modified 2019 by Ricardo Wurmus <rekado@elephly.net>.
 ;;;;    Originally written by Oleg Kiselyov <oleg at pobox dot com> as SXML-to-HTML.scm.
 ;;;; 
 ;;;; This library is free software; you can redistribute it and/or
@@ -30,6 +31,7 @@
   #:use-module (sxml ssax)
   #:use-module (sxml transform)
   #:use-module (ice-9 match)
+  #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-13)
   #:export (xml->sxml sxml->xml sxml->string))
 
@@ -123,10 +125,15 @@ port."
         (acons '*DEFAULT* default-entity-handler entities)
         entities))
 
-  (define (name->sxml name)
+  (define (name->sxml name namespaces)
     (match name
       ((prefix . local-part)
-       (symbol-append prefix (string->symbol ":") local-part))
+       (let ((abbrev (and=> (find (match-lambda
+                                    ((abbrev uri . rest)
+                                     (and (eq? uri prefix) abbrev)))
+                                  namespaces)
+                            first)))
+         (symbol-append abbrev (string->symbol ":") local-part)))
       (_ name)))
 
   (define (doctype-continuation seed)
@@ -150,12 +157,21 @@ port."
        (let ((seed (if trim-whitespace?
                        (ssax:reverse-collect-str-drop-ws seed)
                        (ssax:reverse-collect-str seed)))
-             (attrs (attlist-fold
-                     (lambda (attr accum)
-                       (cons (list (name->sxml (car attr)) (cdr attr))
-                             accum))
-                     '() attributes)))
-         (acons (name->sxml elem-gi)
+             (attrs (append
+                     ;; Namespace declarations
+                     (filter-map (match-lambda
+                                   (('*DEFAULT* . _) #f)
+                                   ((abbrev uri . _)
+                                    (list (symbol-append 'xmlns: abbrev)
+                                          (symbol->string uri))))
+                                 namespaces)
+                     (attlist-fold
+                      (lambda (attr accum)
+                        (cons (list (name->sxml (car attr) namespaces)
+                                    (cdr attr))
+                              accum))
+                      '() attributes))))
+         (acons (name->sxml elem-gi namespaces)
                 (if (null? attrs)
                     seed
                     (cons (cons '@ attrs) seed))
-- 
2.20.1