Use HORIZONTAL ELLIPSIS' when available in truncated-print'.

* module/ice-9/pretty-print.scm (truncated-print): Set
  `%default-port-encoding' to the encoding of PORT.  Choose either
  U+2026 or "..." depending on PORT's encoding.

* test-suite/tests/print.test ("truncated-print")[tprint]: New ENCODING
  argument.  Update existing tests accordingly. Add UTF-8 tests.

* doc/ref/misc-modules.texi (Pretty Printing): Mention the possible use
  of U+2026.

doc/ref/misc-modules.texi

@@ -83,9 +83,11 @@ line in which to do so.
 @print{} #<directory (gui...>
 @end lisp
 
-@code{truncated-print} will not output a trailing newline. If an
+@code{truncated-print} will not output a trailing newline. If an expression does
-expression does not fit in the given width, it will be truncated --
+not fit in the given width, it will be truncated -- possibly
-possibly ellipsized, or in the worst case, displayed as @nicode{#}. 
+ellipsized@footnote{On Unicode-capable ports, the ellipsis is represented by
+character `HORIZONTAL ELLIPSIS' (U+2026), otherwise it is represented by three
+dots.}, or in the worst case, displayed as @nicode{#}.
 
 @deffn {Scheme Procedure} truncated-print obj [port] [keyword-options]
 Print @var{obj}, truncating the output, if necessary, to make it fit

module/ice-9/pretty-print.scm

@@ -1,6 +1,6 @@
-;;;; -*-scheme-*-
+;;;; -*- coding: utf-8; mode: scheme -*-
 ;;;;
-;;;; 	Copyright (C) 2001, 2004, 2006, 2009 Free Software Foundation, Inc.
+;;;; 	Copyright (C) 2001, 2004, 2006, 2009, 2010 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
@@ -271,6 +271,7 @@ port directly after OBJ, like (pretty-print OBJ PORT)."
 		 per-line-prefix
 		 (lambda (s) (display s port) #t)))
 
+
 ;; `truncated-print' was written in 2009 by Andy Wingo, and is not from
 ;; genwrite.scm.
 (define* (truncated-print x #:optional port*
@@ -285,11 +286,28 @@ into @var{width} characters. By default, @var{x} will be printed using
 @var{display?} keyword argument.
 
 The default behaviour is to print depth-first, meaning that the entire
-remaining width will be available to each sub-expressoin of @var{x} --
+remaining width will be available to each sub-expression of @var{x} --
 e.g., if @var{x} is a vector, each member of @var{x}. One can attempt to
 \"ration\" the available width, trying to allocate it equally to each
 sub-expression, via the @var{breadth-first?} keyword argument."
 
+  ;; Make sure string ports are created with the right encoding.
+  (with-fluids ((%default-port-encoding (port-encoding port)))
+
+    (define ellipsis
+      ;; Choose between `HORIZONTAL ELLIPSIS' (U+2026) and three dots, depending
+      ;; on the encoding of PORT.
+      (let ((e "…"))
+        (catch 'encoding-error
+          (lambda ()
+            (with-output-to-string
+              (lambda ()
+                (display e))))
+          (lambda (key . args)
+            "..."))))
+
+    (let ((ellipsis-width (string-length ellipsis)))
+
       (define (print-sequence x width len ref next)
         (let lp ((x x)
                  (width width)
@@ -300,16 +318,18 @@ sub-expression, via the @var{breadth-first?} keyword argument."
            ((= i len)) ; catches 0-length case
            ((= i (1- len))
             (print (ref x i) (if (zero? i) width (1- width))))
-       ((<= width 4)
+           ((<= width (+ 1 ellipsis-width))
             (display "..."))
            (else
-        (let ((str (with-output-to-string
+            (let ((str
+                   (with-fluids ((%default-port-encoding (port-encoding port)))
+                     (with-output-to-string
                            (lambda ()
                              (print (ref x i)
                                     (if breadth-first?
                                         (max 1
                                              (1- (floor (/ width (- len i)))))
-                                  (- width 4)))))))
+                                        (- width (+ 1 ellipsis-width)))))))))
               (display str)
               (lp (next x) (- width 1 (string-length str)) (1+ i)))))))
 
@@ -348,11 +368,13 @@ sub-expression, via the @var{breadth-first?} keyword argument."
                      width
                      (+ (string-length (caar fixes))
                         (string-length (cdar fixes))
-                    3)))
+                        ellipsis-width)))
-        (format #f "~a~a...~a"
+            (format #f "~a~a~a~a"
                     (caar fixes)
                     (substring str (string-length (caar fixes))
-                           (- width (string-length (cdar fixes)) 3))
+                               (- width (string-length (cdar fixes))
+                                  ellipsis-width))
+                    ellipsis
                     (cdar fixes)))
            (else
             (lp (cdr fixes))))))
@@ -363,17 +385,19 @@ sub-expression, via the @var{breadth-first?} keyword argument."
           (error "expected a positive width" width))
          ((list? x)
           (cond
-       ((>= width 5)
+           ((>= width (+ 2 ellipsis-width))
             (display "(")
-        (print-sequence x (- width 2) (length x) (lambda (x i) (car x)) cdr)
+            (print-sequence x (- width 2) (length x)
+                            (lambda (x i) (car x)) cdr)
             (display ")"))
            (else
             (display "#"))))
          ((vector? x)
           (cond
-       ((>= width 6)
+           ((>= width (+ 3 ellipsis-width))
             (display "#(")
-        (print-sequence x (- width 3) (vector-length x) vector-ref identity)
+            (print-sequence x (- width 3) (vector-length x)
+                            vector-ref identity)
             (display ")"))
            (else
             (display "#"))))
@@ -388,7 +412,7 @@ sub-expression, via the @var{breadth-first?} keyword argument."
             (display "#"))))
          ((pair? x)
           (cond
-       ((>= width 7)
+           ((>= width (+ 4 ellipsis-width))
             (display "(")
             (print-tree x (- width 2))
             (display ")"))
@@ -404,4 +428,4 @@ sub-expression, via the @var{breadth-first?} keyword argument."
 
       (with-output-to-port port
         (lambda ()
-      (print x width))))
+          (print x width))))))

test-suite/tests/print.test

@@ -1,4 +1,4 @@
-;;;; -*- scheme -*-
+;;;; -*- coding: utf-8; mode: scheme; -*-
 ;;;;
 ;;;; Copyright (C) 2010  Free Software Foundation, Inc.
 ;;;;
@@ -22,25 +22,33 @@
 
 (with-test-prefix "truncated-print"
   (define exp '(a b #(c d e) f . g))
-  (define (tprint x width)
+
+  (define (tprint x width encoding)
+    (with-fluids ((%default-port-encoding encoding))
       (with-output-to-string
 	(lambda ()
-        (truncated-print x #:width width))))
+	  (truncated-print x #:width width)))))
 
-  (pass-if (equal? (tprint exp 10)
+  (pass-if (equal? (tprint exp 10 "ISO-8859-1")
 		   "(a b . #)"))
 
-  (pass-if (equal? (tprint exp 15)
+  (pass-if (equal? (tprint exp 15 "ISO-8859-1")
 		   "(a b # f . g)"))
 
-  (pass-if (equal? (tprint exp 18)
+  (pass-if (equal? (tprint exp 18 "ISO-8859-1")
 		   "(a b #(c ...) . #)"))
 
-  (pass-if (equal? (tprint exp 20)
+  (pass-if (equal? (tprint exp 20 "ISO-8859-1")
 		   "(a b #(c d e) f . g)"))
 
-  (pass-if (equal? (tprint "The quick brown fox" 20)
+  (pass-if (equal? (tprint "The quick brown fox" 20 "ISO-8859-1")
 		   "\"The quick brown...\""))
 
-  (pass-if (equal? (tprint (current-module) 20)
+  (pass-if (equal? (tprint "The quick brown fox" 20 "UTF-8")
-                   "#<directory (tes...>")))
+		   "\"The quick brown f…\""))
+
+  (pass-if (equal? (tprint (current-module) 20 "ISO-8859-1")
+		   "#<directory (tes...>"))
+
+  (pass-if (equal? (tprint (current-module) 20 "UTF-8")
+		   "#<directory (test-…>")))