add support for texinfo parsed arguments, like @acronym

* module/texinfo.scm (texi-command-specs): Add a new kind of texinfo
  command, inline-text-args, a sort of a cross between inline-args,
  which are unparsed, and inline-text, which is.  Perhaps this should
  supersede inline-args at some point.  In any case, add acronym as an
  inline-text-args element.
  (inline-content?, arguments->attlist, complete-start-command)
  (parse-inline-text-args, make-dom-parser): Adapt for
  inline-text-args.

* module/texinfo/serialize.scm (inline-text-args): Add serialization for
  @acronym.

* test-suite/tests/texinfo.test ("test-texinfo->stexinfo"): Add some
  tests.

3 files changed, 87 insertions, 12 deletions

diff --git a/module/texinfo.scm b/module/texinfo.scm
index 8798eb3c1..2ffd85393 100644
--- a/module/texinfo.scm
+++ b/module/texinfo.scm
@@ -1,6 +1,6 @@
 ;;;; (texinfo) -- parsing of texinfo into SXML
 ;;;;
-;;;; 	Copyright (C) 2009, 2010, 2011  Free Software Foundation, Inc.
+;;;; 	Copyright (C) 2009, 2010, 2011, 2012  Free Software Foundation, Inc.
 ;;;;    Copyright (C) 2004, 2009 Andy Wingo <wingo at pobox dot com>
 ;;;;    Copyright (C) 2001,2002 Oleg Kiselyov <oleg at pobox dot com>
 ;;;;
@@ -128,6 +128,8 @@ Parsed arguments until end of line
 Unparsed arguments ending with @code{#\\@}}
 @item INLINE-TEXT
 Parsed arguments ending with @code{#\\@}}
+@item INLINE-TEXT-ARGS
+Parsed arguments ending with @code{#\\@}}
 @item ENVIRON
 The tag is an environment tag, expect @code{@@end foo}.
 @item TABLE-ENVIRON
@@ -169,7 +171,7 @@ entry.
 @item args
 Named arguments to the command, in the same format as the formals for a
 lambda. Only present for @code{INLINE-ARGS}, @code{EOL-ARGS},
-@code{ENVIRON}, @code{TABLE-ENVIRON} commands.
+@code{INLINE-TEXT-ARGS}, @code{ENVIRON}, @code{TABLE-ENVIRON} commands.
 @end table"
   '(;; Special commands
     (include            #f) ;; this is a low-level token
@@ -224,6 +226,9 @@ lambda. Only present for @code{INLINE-ARGS}, @code{EOL-ARGS},
     (tie                INLINE-ARGS . ())
     (image              INLINE-ARGS . (file #:opt width height alt-text extension))
 
+    ;; Inline parsed args commands
+    (acronym            INLINE-TEXT-ARGS . (acronym #:opt meaning))
+
     ;; EOL args elements
     (node               EOL-ARGS . (name #:opt next previous up))
     (c                  EOL-ARGS . all)
@@ -383,7 +388,9 @@ Examples:
       (parser-error #f "Unknown command" command)))
 
 (define (inline-content? content)
-  (or (eq? content 'INLINE-TEXT) (eq? content 'INLINE-ARGS)))
+  (case content
+    ((INLINE-TEXT INLINE-ARGS INLINE-TEXT-ARGS) #t)
+    (else #f)))
 
 
 ;;========================================================================
@@ -572,6 +579,7 @@ Examples:
 ;; Content model     Port position
 ;; =============     =============
 ;; INLINE-TEXT       One character after the #\{.
+;; INLINE-TEXT-ARGS  One character after the #\{.
 ;; INLINE-ARGS       The first character after the #\}.
 ;; EOL-TEXT          The first non-whitespace character after the command.
 ;; ENVIRON, TABLE-ENVIRON, EOL-ARGS, EOL-TEXT
@@ -599,7 +607,9 @@ Examples:
                         (car names))))
      (else
       (loop (cdr in) (cdr names) opt?
-            (cons (list (car names) (car in)) out))))))
+            (acons (car names)
+                   (if (list? (car in)) (car in) (list (car in)))
+                   out))))))
 
 (define (parse-table-args command port)
   (let* ((line (string-trim-both (read-text-line port)))
@@ -648,6 +658,9 @@ Examples:
       ((INLINE-ARGS)
        (assert-curr-char '(#\{) "Inline element lacks {" port)
        (values command (get-arguments type arg-names #\}) type))
+      ((INLINE-TEXT-ARGS)
+       (assert-curr-char '(#\{) "Inline element lacks {" port)
+       (values command '() type))
       ((EOL-ARGS)
        (values command (get-arguments type arg-names #\newline) type))
       ((ENVIRON ENTRY INDEX)
@@ -998,15 +1011,48 @@ Examples:
                  (cons (apply string-append strs) result))))
               '() #t)))))))
 
+(define (parse-inline-text-args port spec text)
+  (let lp ((in text) (cur '()) (out '()))
+    (cond
+     ((null? in)
+      (if (and (pair? cur)
+               (string? (car cur))
+               (string-whitespace? (car cur)))
+          (lp in (cdr cur) out)
+          (let ((args (reverse (if (null? cur)
+                                   out
+                                   (cons (reverse cur) out)))))
+            (arguments->attlist port args (cddr spec)))))
+     ((pair? (car in))
+      (lp (cdr in) (cons (car in) cur) out))
+     ((string-index (car in) #\,)
+      (let* ((parts (string-split (car in) #\,))
+             (head (string-trim-right (car parts)))
+             (rev-tail (reverse (cdr parts)))
+             (last (string-trim (car rev-tail))))
+        (lp (cdr in)
+            (if (string-null? last) cur (cons last cur))
+            (append (cdr rev-tail)
+                    (cons (reverse (if (string-null? head) cur (cons head cur)))
+                          out)))))
+     (else
+      (lp (cdr in)
+          (cons (if (null? cur) (string-trim (car in)) (car in)) cur)
+          out)))))
+
 (define (make-dom-parser)
   (make-command-parser
    (lambda (command args content seed)      ; fdown
      '())
    (lambda (command args parent-seed seed)  ; fup
-     (let ((seed (reverse-collect-str-drop-ws seed)))
-       (acons command
-              (if (null? args) seed (acons '% args seed))
-              parent-seed)))
+     (let ((seed (reverse-collect-str-drop-ws seed))
+           (spec (command-spec command)))
+       (if (eq? (cadr spec) 'INLINE-TEXT-ARGS)
+           (cons (list command (cons '% (parse-inline-text-args #f spec seed)))
+                 parent-seed)
+           (acons command
+                  (if (null? args) seed (acons '% args seed))
+                  parent-seed))))
    (lambda (string1 string2 seed)           ; str-handler
      (if (string-null? string2)
          (cons string1 seed)
diff --git a/module/texinfo/serialize.scm b/module/texinfo/serialize.scm
index 6a32d2346..1436ad5f9 100644
--- a/module/texinfo/serialize.scm
+++ b/module/texinfo/serialize.scm
@@ -1,6 +1,6 @@
 ;;;; (texinfo serialize) -- rendering stexinfo as texinfo
 ;;;;
-;;;; 	Copyright (C) 2009  Free Software Foundation, Inc.
+;;;; 	Copyright (C) 2009, 2012  Free Software Foundation, Inc.
 ;;;;    Copyright (C) 2003,2004,2009  Andy Wingo <wingo at pobox dot com>
 ;;;; 
 ;;;; This library is free software; you can redistribute it and/or
@@ -98,6 +98,20 @@
               ","))
          "{" command "@" accum))
 
+(define (inline-text-args exp lp command type formals args accum)
+  (list* "}"
+         (if (not args) ""
+             (apply
+              append
+              (list-intersperse
+               (map
+                (lambda (x) (append-map (lambda (x) (lp x '())) (reverse x)))
+                (drop-while not
+                            (map (lambda (x) (assq-ref args x))
+                                 (reverse formals))))
+               '(","))))
+         "{" command "@" accum))
+
 (define (serialize-text-args lp formals args)
   (apply
    append
@@ -202,6 +216,7 @@
   `((EMPTY-COMMAND . ,empty-command)
     (INLINE-TEXT . ,inline-text)
     (INLINE-ARGS . ,inline-args)
+    (INLINE-TEXT-ARGS . ,inline-text-args)
     (EOL-TEXT . ,eol-text)
     (EOL-TEXT-ARGS . ,eol-text-args)
     (INDEX . ,eol-text-args)
diff --git a/test-suite/tests/texinfo.test b/test-suite/tests/texinfo.test
index 49d108698..98c44b91b 100644
--- a/test-suite/tests/texinfo.test
+++ b/test-suite/tests/texinfo.test
@@ -1,6 +1,6 @@
 ;;;; texinfo.test                 -*- scheme -*-
 ;;;;
-;;;; Copyright (C) 2010, 2011  Free Software Foundation, Inc.
+;;;; Copyright (C) 2010, 2011, 2012  Free Software Foundation, Inc.
 ;;;; Copyright (C) 2001,2002 Oleg Kiselyov <oleg at pobox dot com>
 ;;;;
 ;;;; This library is free software; you can redistribute it and/or
@@ -177,8 +177,9 @@
     (test (string-append "foo bar baz\n@settitle " title "\n" str)
           expected-res))
   (define (test-body str expected-res)
-    (pass-if (equal? expected-res
-                     (cddr (try-with-title "zog" str)))))
+    (pass-if str
+      (equal? expected-res
+              (cddr (try-with-title "zog" str)))))
 
   (define (list-intersperse src-l elem)
     (if (null? src-l) src-l
@@ -218,6 +219,19 @@
              '((para (code "abc " (code)))))
   (test-body "@code{ arg               }"
              '((para (code "arg"))))
+
+  (test-body "@acronym{GNU}"
+             '((para (acronym (% (acronym "GNU"))))))
+
+  (test-body "@acronym{GNU, not unix}"
+             '((para (acronym (% (acronym "GNU")
+                                 (meaning "not unix"))))))
+
+  (test-body "@acronym{GNU, @acronym{GNU}'s Not Unix}"
+             '((para (acronym (% (acronym "GNU")
+                                 (meaning (acronym (% (acronym "GNU")))
+                                          "'s Not Unix"))))))
+
   (test-body "@example\n foo asdf  asd  sadf asd  \n@end example\n"
              '((example " foo asdf  asd  sadf asd  ")))
   (test-body (join-lines