[ELPA] Update proposal: psgml: asl-like parsing in PI

[Lucien Pullen]

I was wanting to do some processing of processing instructions 
similar to how <?PSGML ELEMENT> works without having to write my 
own SGML parser, since there's already one loaded.  I wrote a 
slight adjustment that separates the SGML parsing from the 
handling of the PI text and made it available as a standalone 
function (sgml-pi-asl-parser).

It works like attribute specification list parsing but also allows 
literals without a name= and when the format is name=value you can 
specify a function to call to parse the value instead of 
sgml-parse-literal or sgml-parse-name.

Instead of operating immediately on the values it returns a list 
of strings and (name . value) pairs that the handler function can 
operate on instead, with sgml--pi-element-handler as an example.

See the attached patch file for specifics.  I'd appreciate some 
feedback on the docstring and the possibility of turning on and 
off floating literals as an optional argument so it could be used 
as the parser for sgml-parse-attribute-specification-list as well.

>From daa7b2c0919ca39b374cd2cf25176f089b89bf38 Mon Sep 17 00:00:00 2001
From: Lucien Pullen <address@hidden>
Date: Sun, 19 Nov 2017 18:27:03 -0700
Subject: [PATCH] * psgml-parse.el (sgml-pi-asl-parser): a procedure for PI
 handlers

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 parsing work of sgml--pi-element-handler made available for other
processing.
---
 psgml-parse.el | 52 ++++++++++++++++++++++++++++++++++++----------------
 1 file changed, 36 insertions(+), 16 deletions(-)

diff --git a/psgml-parse.el b/psgml-parse.el
index 5609767..0710287 100644
--- a/psgml-parse.el
+++ b/psgml-parse.el
@@ -1620,27 +1620,47 @@ 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 ()
   (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 strings and (name-string . value-string) pairs
+in the order they were written in; atom strings when there is no
+value indicator and conses when there is.
+
+As an extension, the atom string can appear as a literal instead
+of only a token.
+
+As an extension, the value of a name-value pair can be parsed by
+calling value-fn with no arguments instead of as a token or
+literal."
+  (let ((acc '())
+        name val)
     (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))))
+             (setq val (funcall (if value-fn value-fn 
'sgml-parse-name-or-literal))))
+            (t (setq val nil)))
+      (push (if (null val) name (cons name val)) acc)
+      (sgml-parse-s))
+    (nreverse acc)))
 
+(defun sgml--pi-element-handler ()
+  (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)
-- 
2.3.4