summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2012-05-08 22:43:04 +0200
committerAndy Wingo <wingo@pobox.com>2012-05-08 22:43:04 +0200
commita3ded46520b35a8dbda22097b74792b8282d12ce (patch)
tree9af4c888be060263851d602031dc162023e1d55e
parent4d497b629b73afda35ba409c3dcbfb665fe41dde (diff)
parent33672b071118f54ee637afa00349f2a4404a84da (diff)
downloadguile-a3ded46520b35a8dbda22097b74792b8282d12ce.tar.gz
Merge remote-tracking branch 'origin/stable-2.0'
Conflicts: libguile/ports.c libguile/ports.h libguile/read.c libguile/vm-i-system.c
-rw-r--r--benchmark-suite/benchmarks/read.bm15
-rw-r--r--configure.ac4
-rw-r--r--libguile/fports.c25
-rw-r--r--libguile/ports.c14
-rw-r--r--libguile/ports.h4
-rw-r--r--libguile/read.c142
-rw-r--r--libguile/vm-i-system.c1
-rw-r--r--module/texinfo.scm62
-rw-r--r--module/texinfo/docbook.scm12
-rw-r--r--module/texinfo/serialize.scm17
-rw-r--r--test-suite/tests/ports.test25
-rw-r--r--test-suite/tests/texinfo.test20
12 files changed, 225 insertions, 116 deletions
diff --git a/benchmark-suite/benchmarks/read.bm b/benchmark-suite/benchmarks/read.bm
index e5cf7de93..f0b25f541 100644
--- a/benchmark-suite/benchmarks/read.bm
+++ b/benchmark-suite/benchmarks/read.bm
@@ -1,6 +1,6 @@
;;; read.bm --- Exercise the reader. -*- Scheme -*-
;;;
-;;; Copyright (C) 2008, 2010 Free Software Foundation, Inc.
+;;; Copyright (C) 2008, 2010, 2012 Free Software Foundation, Inc.
;;;
;;; This program is free software; you can redistribute it and/or
;;; modify it under the terms of the GNU Lesser General Public License
@@ -43,6 +43,11 @@
(load-file-with-reader file read buffering))
%files-to-load))
+(define small "\"hello, world!\"")
+(define large (string-append "\"" (make-string 1234 #\A) "\""))
+
+(fluid-set! %default-port-encoding "UTF-8") ; for string ports
+
(with-benchmark-prefix "read"
@@ -59,4 +64,10 @@
(exercise-read (list _IOFBF 8192)))
(benchmark "_IOFBF 16384" 10
- (exercise-read (list _IOFBF 16384))))
+ (exercise-read (list _IOFBF 16384)))
+
+ (benchmark "small strings" 100000
+ (call-with-input-string small read))
+
+ (benchmark "large strings" 100000
+ (call-with-input-string large read)))
diff --git a/configure.ac b/configure.ac
index e2ccb8c67..60d0164eb 100644
--- a/configure.ac
+++ b/configure.ac
@@ -1495,8 +1495,6 @@ case "$GCC" in
## We had -Wstrict-prototypes in here for a bit, but Guile does too
## much stuff with generic function pointers for that to really be
## less than exasperating.
- ## -Wpointer-arith was here too, but something changed in gcc/glibc
- ## and it became equally exasperating (gcc 2.95 and/or glibc 2.1.2).
## -Wundef was removed because Gnulib prevented it (see
## <http://thread.gmane.org/gmane.lisp.guile.bugs/5329>.)
@@ -1505,7 +1503,7 @@ case "$GCC" in
## <http://lists.gnu.org/archive/html/guile-devel/2012-01/msg00487.html>.
POTENTIAL_GCC_CFLAGS="-Wall -Wmissing-prototypes \
- -Wdeclaration-after-statement \
+ -Wdeclaration-after-statement -Wpointer-arith \
-Wswitch-enum -fno-strict-aliasing"
# Do this here so we don't screw up any of the tests above that might
# not be "warning free"
diff --git a/libguile/fports.c b/libguile/fports.c
index 2dc23758f..94ce434d1 100644
--- a/libguile/fports.c
+++ b/libguile/fports.c
@@ -174,7 +174,8 @@ SCM_DEFINE (scm_setvbuf, "setvbuf", 2, 1, 0,
{
int cmode;
long csize;
- SCM drained;
+ size_t ndrained;
+ char *drained;
scm_t_port *pt;
port = SCM_COERCE_OUTPORT (port);
@@ -211,9 +212,21 @@ SCM_DEFINE (scm_setvbuf, "setvbuf", 2, 1, 0,
pt = SCM_PTAB_ENTRY (port);
if (SCM_INPUT_PORT_P (port))
- drained = scm_drain_input (port);
+ {
+ /* Drain pending input from PORT. Don't use `scm_drain_input' since
+ it returns a string, whereas we want binary input here. */
+ ndrained = pt->read_end - pt->read_pos;
+ if (pt->read_buf == pt->putback_buf)
+ ndrained += pt->saved_read_end - pt->saved_read_pos;
+
+ if (ndrained > 0)
+ {
+ drained = scm_gc_malloc_pointerless (ndrained, "file port");
+ scm_take_from_input_buffers (port, drained, ndrained);
+ }
+ }
else
- drained = scm_nullstr;
+ ndrained = 0;
if (SCM_OUTPUT_PORT_P (port))
scm_flush_unlocked (port);
@@ -232,8 +245,10 @@ SCM_DEFINE (scm_setvbuf, "setvbuf", 2, 1, 0,
scm_fport_buffer_add (port, csize, csize);
- if (scm_is_true (drained) && scm_c_string_length (drained))
- scm_unread_string (drained, port);
+ if (ndrained > 0)
+ /* Put DRAINED back to PORT. */
+ while (ndrained-- > 0)
+ scm_unget_byte (drained[ndrained], port);
return SCM_UNSPECIFIED;
}
diff --git a/libguile/ports.c b/libguile/ports.c
index f5ab24ed2..b45378592 100644
--- a/libguile/ports.c
+++ b/libguile/ports.c
@@ -2101,20 +2101,21 @@ scm_fill_input (SCM port)
return ret;
}
-/* move up to read_len chars from port's putback and/or read buffers
- into memory starting at dest. returns the number of chars moved. */
+/* Move up to READ_LEN bytes from PORT's putback and/or read buffers
+ into memory starting at DEST. Return the number of bytes moved.
+ PORT's line/column numbers are left unchanged. */
size_t
scm_take_from_input_buffers (SCM port, char *dest, size_t read_len)
{
scm_t_port *pt = SCM_PTAB_ENTRY (port);
- size_t chars_read = 0;
+ size_t bytes_read = 0;
size_t from_buf = min (pt->read_end - pt->read_pos, read_len);
if (from_buf > 0)
{
memcpy (dest, pt->read_pos, from_buf);
pt->read_pos += from_buf;
- chars_read += from_buf;
+ bytes_read += from_buf;
read_len -= from_buf;
dest += from_buf;
}
@@ -2127,10 +2128,11 @@ scm_take_from_input_buffers (SCM port, char *dest, size_t read_len)
{
memcpy (dest, pt->saved_read_pos, from_buf);
pt->saved_read_pos += from_buf;
- chars_read += from_buf;
+ bytes_read += from_buf;
}
}
- return chars_read;
+
+ return bytes_read;
}
/* Clear a port's read buffers, returning the contents. */
diff --git a/libguile/ports.h b/libguile/ports.h
index 2d277e031..f33f792b9 100644
--- a/libguile/ports.h
+++ b/libguile/ports.h
@@ -324,8 +324,8 @@ SCM_API scm_t_wchar scm_getc_unlocked (SCM port);
SCM_API SCM scm_read_char (SCM port);
/* Pushback. */
-SCM_INTERNAL void scm_unget_byte (int c, SCM port);
-SCM_INTERNAL void scm_unget_byte_unlocked (int c, SCM port);
+SCM_API void scm_unget_byte (int c, SCM port);
+SCM_API void scm_unget_byte_unlocked (int c, SCM port);
SCM_API void scm_ungetc (scm_t_wchar c, SCM port);
SCM_API void scm_ungetc_unlocked (scm_t_wchar c, SCM port);
SCM_API void scm_ungets (const char *s, int n, SCM port);
diff --git a/libguile/read.c b/libguile/read.c
index dff9d85d1..5738e2ed8 100644
--- a/libguile/read.c
+++ b/libguile/read.c
@@ -161,8 +161,8 @@ scm_i_read_hash_procedures_set_x (SCM value)
/* Size of the C buffer used to read symbols and numbers. */
#define READER_BUFFER_SIZE 128
-/* Size of the C buffer used to read strings. */
-#define READER_STRING_BUFFER_SIZE 512
+/* Number of 32-bit codepoints in the buffer used to read strings. */
+#define READER_STRING_BUFFER_SIZE 128
/* The maximum size of Scheme character names. */
#define READER_CHAR_NAME_MAX_SIZE 50
@@ -208,8 +208,8 @@ static SCM scm_get_hash_procedure (int);
fewer than BUF_SIZE bytes, non-zero otherwise. READ will be set the number of
bytes actually read. */
static int
-read_token (SCM port, char *buf, const size_t buf_size, size_t *read)
- {
+read_token (SCM port, char *buf, size_t buf_size, size_t *read)
+{
*read = 0;
while (*read < buf_size)
@@ -235,20 +235,15 @@ read_token (SCM port, char *buf, const size_t buf_size, size_t *read)
return 1;
}
-/* Read from PORT until a delimiter (e.g., a whitespace) is read. Put the
- result in the pre-allocated buffer BUFFER, if the whole token has fewer than
- BUFFER_SIZE bytes, or into OVERFLOW_BUFFER, allocated here to be freed by the
- caller. Return zero if the token fits in BUFFER, non-zero otherwise. READ
- will be set the number of bytes actually read. */
-static int
-read_complete_token (SCM port, char *buffer, const size_t buffer_size,
- char **overflow_buffer, size_t *read)
+/* Like `read_token', but return either BUFFER, or a GC-allocated buffer
+ if the token doesn't fit in BUFFER_SIZE bytes. */
+static char *
+read_complete_token (SCM port, char *buffer, size_t buffer_size,
+ size_t *read)
{
int overflow = 0;
- size_t bytes_read, overflow_size;
-
- *overflow_buffer = NULL;
- overflow_size = 0;
+ size_t bytes_read, overflow_size = 0;
+ char *overflow_buffer = NULL;
do
{
@@ -259,14 +254,19 @@ read_complete_token (SCM port, char *buffer, const size_t buffer_size,
{
if (overflow_size == 0)
{
- *overflow_buffer = scm_malloc (bytes_read);
- memcpy (*overflow_buffer, buffer, bytes_read);
+ overflow_buffer = scm_gc_malloc_pointerless (bytes_read, "read");
+ memcpy (overflow_buffer, buffer, bytes_read);
overflow_size = bytes_read;
}
else
{
- *overflow_buffer = scm_realloc (*overflow_buffer, overflow_size + bytes_read);
- memcpy (*overflow_buffer + overflow_size, buffer, bytes_read);
+ char *new_buf =
+ scm_gc_malloc_pointerless (overflow_size + bytes_read, "read");
+
+ memcpy (new_buf, overflow_buffer, overflow_size);
+ memcpy (new_buf + overflow_size, buffer, bytes_read);
+
+ overflow_buffer = new_buf;
overflow_size += bytes_read;
}
}
@@ -278,7 +278,7 @@ read_complete_token (SCM port, char *buffer, const size_t buffer_size,
else
*read = bytes_read;
- return (overflow_size != 0);
+ return (overflow_size > 0 ? overflow_buffer : buffer);
}
/* Skip whitespace from PORT and return the first non-whitespace character
@@ -493,15 +493,14 @@ scm_read_string (int chr, SCM port)
/* For strings smaller than C_STR, this function creates only one Scheme
object (the string returned). */
- SCM str = SCM_BOOL_F;
- unsigned c_str_len = 0;
- scm_t_wchar c;
+ SCM str = SCM_EOL;
+ size_t c_str_len = 0;
+ scm_t_wchar c, c_str[READER_STRING_BUFFER_SIZE];
/* Need to capture line and column numbers here. */
long line = SCM_LINUM (port);
int column = SCM_COL (port) - 1;
- str = scm_i_make_string (READER_STRING_BUFFER_SIZE, NULL, 0);
while ('"' != (c = scm_getc_unlocked (port)))
{
if (c == EOF)
@@ -511,12 +510,11 @@ scm_read_string (int chr, SCM port)
"end of file in string constant", SCM_EOL);
}
- if (c_str_len + 1 >= scm_i_string_length (str))
- {
- SCM addy = scm_i_make_string (READER_STRING_BUFFER_SIZE, NULL, 0);
-
- str = scm_string_append (scm_list_2 (str, addy));
- }
+ if (c_str_len + 1 >= READER_STRING_BUFFER_SIZE)
+ {
+ str = scm_cons (scm_from_utf32_stringn (c_str, c_str_len), str);
+ c_str_len = 0;
+ }
if (c == '\\')
{
@@ -580,12 +578,22 @@ scm_read_string (int chr, SCM port)
scm_list_1 (SCM_MAKE_CHAR (c)));
}
}
- str = scm_i_string_start_writing (str);
- scm_i_string_set_x (str, c_str_len++, c);
- scm_i_string_stop_writing ();
+
+ c_str[c_str_len++] = c;
}
- return maybe_annotate_source (scm_i_substring_copy (str, 0, c_str_len),
- port, line, column);
+
+ if (scm_is_null (str))
+ /* Fast path: we got a string that fits in C_STR. */
+ str = scm_from_utf32_stringn (c_str, c_str_len);
+ else
+ {
+ if (c_str_len > 0)
+ str = scm_cons (scm_from_utf32_stringn (c_str, c_str_len), str);
+
+ str = scm_string_concatenate_reverse (str, SCM_UNDEFINED, SCM_UNDEFINED);
+ }
+
+ return maybe_annotate_source (str, port, line, column);
}
#undef FUNC_NAME
@@ -594,10 +602,8 @@ static SCM
scm_read_number (scm_t_wchar chr, SCM port)
{
SCM result, str = SCM_EOL;
- char buffer[READER_BUFFER_SIZE];
- char *overflow_buffer = NULL;
+ char local_buffer[READER_BUFFER_SIZE], *buffer;
size_t bytes_read;
- int overflow;
scm_t_port *pt = SCM_PTAB_ENTRY (port);
/* Need to capture line and column numbers here. */
@@ -605,14 +611,10 @@ scm_read_number (scm_t_wchar chr, SCM port)
int column = SCM_COL (port) - 1;
scm_ungetc_unlocked (chr, port);
- overflow = read_complete_token (port, buffer, sizeof (buffer),
- &overflow_buffer, &bytes_read);
+ buffer = read_complete_token (port, local_buffer, sizeof local_buffer,
+ &bytes_read);
- if (!overflow)
- str = scm_from_stringn (buffer, bytes_read, pt->encoding, pt->ilseq_handler);
- else
- str = scm_from_stringn (overflow_buffer, bytes_read, pt->encoding,
- pt->ilseq_handler);
+ str = scm_from_stringn (buffer, bytes_read, pt->encoding, pt->ilseq_handler);
result = scm_string_to_number (str, SCM_UNDEFINED);
if (scm_is_false (result))
@@ -625,8 +627,6 @@ scm_read_number (scm_t_wchar chr, SCM port)
else if (SCM_NIMP (result))
result = maybe_annotate_source (result, port, line, column);
- if (overflow)
- free (overflow_buffer);
SCM_COL (port) += scm_i_string_length (str);
return result;
}
@@ -638,29 +638,20 @@ scm_read_mixed_case_symbol (scm_t_wchar chr, SCM port)
int ends_with_colon = 0;
size_t bytes_read;
int postfix = scm_is_eq (SCM_PACK (SCM_KEYWORD_STYLE), scm_keyword_postfix);
- int overflow;
- char buffer[READER_BUFFER_SIZE], *overflow_buffer;
+ char local_buffer[READER_BUFFER_SIZE], *buffer;
scm_t_port *pt = SCM_PTAB_ENTRY (port);
SCM str;
scm_ungetc_unlocked (chr, port);
- overflow = read_complete_token (port, buffer, READER_BUFFER_SIZE,
- &overflow_buffer, &bytes_read);
+ buffer = read_complete_token (port, local_buffer, sizeof local_buffer,
+ &bytes_read);
if (bytes_read > 0)
- {
- if (!overflow)
- ends_with_colon = buffer[bytes_read - 1] == ':';
- else
- ends_with_colon = overflow_buffer[bytes_read - 1] == ':';
- }
+ ends_with_colon = buffer[bytes_read - 1] == ':';
if (postfix && ends_with_colon && (bytes_read > 1))
{
- if (!overflow)
- str = scm_from_stringn (buffer, bytes_read - 1, pt->encoding, pt->ilseq_handler);
- else
- str = scm_from_stringn (overflow_buffer, bytes_read - 1, pt->encoding,
- pt->ilseq_handler);
+ str = scm_from_stringn (buffer, bytes_read - 1,
+ pt->encoding, pt->ilseq_handler);
if (SCM_CASE_INSENSITIVE_P)
str = scm_string_downcase_x (str);
@@ -668,19 +659,14 @@ scm_read_mixed_case_symbol (scm_t_wchar chr, SCM port)
}
else
{
- if (!overflow)
- str = scm_from_stringn (buffer, bytes_read, pt->encoding, pt->ilseq_handler);
- else
- str = scm_from_stringn (overflow_buffer, bytes_read, pt->encoding,
- pt->ilseq_handler);
+ str = scm_from_stringn (buffer, bytes_read,
+ pt->encoding, pt->ilseq_handler);
if (SCM_CASE_INSENSITIVE_P)
str = scm_string_downcase_x (str);
result = scm_string_to_symbol (str);
}
- if (overflow)
- free (overflow_buffer);
SCM_COL (port) += scm_i_string_length (str);
return result;
}
@@ -691,8 +677,7 @@ scm_read_number_and_radix (scm_t_wchar chr, SCM port)
{
SCM result;
size_t read;
- char buffer[READER_BUFFER_SIZE], *overflow_buffer;
- int overflow;
+ char local_buffer[READER_BUFFER_SIZE], *buffer;
unsigned int radix;
SCM str;
scm_t_port *pt;
@@ -725,21 +710,14 @@ scm_read_number_and_radix (scm_t_wchar chr, SCM port)
radix = 10;
}
- overflow = read_complete_token (port, buffer, sizeof (buffer),
- &overflow_buffer, &read);
+ buffer = read_complete_token (port, local_buffer, sizeof local_buffer,
+ &read);
pt = SCM_PTAB_ENTRY (port);
- if (!overflow)
- str = scm_from_stringn (buffer, read, pt->encoding, pt->ilseq_handler);
- else
- str = scm_from_stringn (overflow_buffer, read, pt->encoding,
- pt->ilseq_handler);
+ str = scm_from_stringn (buffer, read, pt->encoding, pt->ilseq_handler);
result = scm_string_to_number (str, scm_from_uint (radix));
- if (overflow)
- free (overflow_buffer);
-
SCM_COL (port) += scm_i_string_length (str);
if (scm_is_true (result))
diff --git a/libguile/vm-i-system.c b/libguile/vm-i-system.c
index b6c15d28e..ef559ae52 100644
--- a/libguile/vm-i-system.c
+++ b/libguile/vm-i-system.c
@@ -310,6 +310,7 @@ VM_DEFINE_INSTRUCTION (25, variable_ref, "variable-ref", 0, 1, 1)
{
SCM var_name;
+ SYNC_ALL ();
/* Attempt to provide the variable name in the error message. */
var_name = scm_module_reverse_lookup (scm_current_module (), x);
vm_error_unbound (program, scm_is_true (var_name) ? var_name : x);
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/docbook.scm b/module/texinfo/docbook.scm
index 72779263a..c5a8d659f 100644
--- a/module/texinfo/docbook.scm
+++ b/module/texinfo/docbook.scm
@@ -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)))
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/ports.test b/test-suite/tests/ports.test
index d4a333f56..5ca416daf 100644
--- a/test-suite/tests/ports.test
+++ b/test-suite/tests/ports.test
@@ -2,7 +2,7 @@
;;;; Jim Blandy <jimb@red-bean.com> --- May 1999
;;;;
;;;; Copyright (C) 1999, 2001, 2004, 2006, 2007, 2009, 2010,
-;;;; 2011 Free Software Foundation, Inc.
+;;;; 2011, 2012 Free Software Foundation, Inc.
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
@@ -1064,6 +1064,29 @@
(list read read-char read-line)
'("read" "read-char" "read-line")))
+
+
+(with-test-prefix "setvbuf"
+
+ (pass-if "line/column number preserved"
+ ;; In Guile 2.0.5, `setvbuf' would erroneously decrease the port's
+ ;; line and/or column number.
+ (call-with-output-file (test-file)
+ (lambda (p)
+ (display "This is GNU Guile.\nWelcome." p)))
+ (call-with-input-file (test-file)
+ (lambda (p)
+ (and (eq? #\T (read-char p))
+ (let ((line (port-line p))
+ (col (port-column p)))
+ (and (= line 0) (= col 1)
+ (begin
+ (setvbuf p _IOFBF 777)
+ (let ((line* (port-line p))
+ (col* (port-column p)))
+ (and (= line line*)
+ (= col col*)))))))))))
+
(delete-file (test-file))
;;; Local Variables:
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