[elpa] externals/psgml 56c70dc: * psgml-parse.el (sgml-pi-asl-parser): New function

[Stefan Monnier]

branch: externals/psgml
commit 56c70dc6d528728e8ded03333ce75c7ea9c1fa16
Author: Lucien Pullen <address@hidden>
Commit: Stefan Monnier <address@hidden>

    * psgml-parse.el (sgml-pi-asl-parser): New function
    
    Copyright-paperwork-exempt: yes
    
    A convenience function for parsing the text of a PI like an attribute
    specification list with a couple syntax enhancements.  May be called to
    parse the PI instead of using the string argument to `sgml-pi-function'.
    
    The makes available for other processing the parsing work of
    `sgml--pi-element-handler'.
    
    (sgml-parse-name-or-literal, sgml-pi-asl-parser): New functions extracted 
from
     sgml--pi-element-handler.
    (sgml--pi-element-handler): Reimplement using those.
---
 psgml-parse.el | 57 ++++++++++++++++++++++++++++++++++++++++-----------------
 1 file changed, 40 insertions(+), 17 deletions(-)

diff --git a/psgml-parse.el b/psgml-parse.el
index 5609767..3cd762b 100644
--- a/psgml-parse.el
+++ b/psgml-parse.el
@@ -1620,27 +1620,50 @@ in any of them."
                (sgml-log-warning "Unknown processing instruction for PSGML: %s"
                                  command)))))))
 
-
-(defun sgml--pi-element-handler ()
+(defun sgml-parse-name-or-literal ()
+  "Parse an SGML token or literal and return it as a string."
   (sgml-parse-s)
-  (let ((eltype (sgml-lookup-eltype (sgml-parse-name)))
-        name value)
+  (if (looking-at "['\"]")
+      (sgml-parse-literal)
+    (sgml-parse-name)))
+
+(defun sgml-pi-asl-parser (&optional value-fn)
+  "Parse the processing instruction like an attribute specification list.
+
+Returns a list of VALUE and (NAME . VALUE) pairs in the order
+they were written in; atom strings when there is no value
+indicator and conses when there is.
+
+  The NAME and VALUE can be an SGML literal.  This is an
+  extension to SGML syntax that requires NAME and a VALUE without
+  a 'name=' to be a name token.
+
+The optional argument VALUE-FN (default
+`sgml-parse-name-or-literal') is called with zero arguments to
+parse the value part of a name=value pair."
+  (let ((acc '())
+        name
+        (implied (cons nil nil)))
     (sgml-parse-s)
-    (while (setq name (sgml-parse-name))
-      ;; FIXME: check name not reserved
+    (while (setq name (sgml-parse-name-or-literal))
       (sgml-parse-s)
-      (cond ((sgml-parse-delim "VI")
-             (sgml-parse-s)
-             (setq value
-                   (if (looking-at "['\"]")
-                       (sgml-parse-literal)
-                     (read (current-buffer)))))
-            (t
-             (setq value t)))
-      (message "%s = %S" name value)
-      (setf (sgml-eltype-appdata eltype (intern (downcase name))) value)
-      (sgml-parse-s))))
+      (let ((val (if (sgml-parse-delim "VI")
+                     (funcall (or value-fn 'sgml-parse-name-or-literal))
+                   implied)))
+        (push (if (eq val implied) name (cons name val)) acc))
+      (sgml-parse-s))
+    (nreverse acc)))
 
+(defun sgml--pi-element-handler ()
+  (cl-destructuring-bind (elname &rest options)
+      (sgml-pi-asl-parser (lambda () (read (current-buffer))))
+    (let ((eltype (sgml-lookup-eltype elname)))
+      (dolist (option options)
+        ;; FIXME: check name not reserved
+        (let ((name (if (consp option) (car option) option))
+              (value (if (consp option) (cdr option) t)))
+          (message "%s = %S" name value)
+          (setf (sgml-eltype-appdata eltype (intern (downcase name))) 
value))))))
 
 ;;[lenst/1998-03-09 19:52:08]  Perhaps not the right place
 (defun sgml-general-insert-case (text)