mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-16 16:50:21 +02:00
Merge remote-tracking branch 'origin/stable-2.0'
Conflicts: libguile/ports.c libguile/ports.h libguile/read.c libguile/vm-i-system.c
This commit is contained in:
Andy Wingo
commit
a3ded46520
12 changed files with 225 additions and 116 deletions
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -1,6 +1,6 @@
|
|||
;;;; (texinfo docbook) -- translating sdocbook into stexinfo
|
||||
;;;;
|
||||
;;;; Copyright (C) 2009, 2010 Free Software Foundation, Inc.
|
||||
;;;; Copyright (C) 2009, 2010, 2012 Free Software Foundation, Inc.
|
||||
;;;; Copyright (C) 2007, 2009 Andy Wingo <wingo at pobox dot com>
|
||||
;;;;
|
||||
;;;; This library is free software; you can redistribute it and/or
|
||||
|
|
@ -89,14 +89,20 @@ a number of generic rules for transforming docbook into texinfo."
|
|||
`(item ,@body))))
|
||||
. ,(lambda (tag . body)
|
||||
`(itemize ,@body)))
|
||||
(acronym . ,(lambda (tag . body)
|
||||
`(acronym (% (acronym . ,body)))))
|
||||
(term . ,detag-one)
|
||||
(informalexample . ,detag-one)
|
||||
(section . ,identity)
|
||||
(subsection . ,identity)
|
||||
(subsubsection . ,identity)
|
||||
(ulink . ,(lambda (tag attrs . body)
|
||||
`(uref (% ,(assq 'url (cdr attrs))
|
||||
(title ,@body)))))
|
||||
(cond
|
||||
((assq 'url (cdr attrs))
|
||||
=> (lambda (url)
|
||||
`(uref (% ,url (title ,@body)))))
|
||||
(else
|
||||
(car body)))))
|
||||
(*text* . ,detag-one)
|
||||
(*default* . ,(lambda (tag . body)
|
||||
(let ((subst (assq tag tag-replacements)))
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue