Enhance terpri to allow conditionally output a newline

* doc/lispref/streams.texi (Output Functions): Document new argument ENSURE to
terpri.

* doc/misc/cl.texi (Porting Common Lisp): Remove parse-integer.

* lisp/emacs-lisp/cl-extra.el (cl-fresh-line): New function.

* src/keymap.c (describe_vector_princ):
* src/keyboard.c (Fcommand_error_default_function): Adapt to change to
Fterpri.

* src/print.c (printchar_stdout_last): Declare.
(printchar): Record the last char written to stdout.
(Fterpri): Add optional argument ENSURE.

* test/automated/print-tests.el: New file.
(terpri): Tests for terpri.  (Bug#18652)

4 files changed, 36 insertions, 7 deletions

diff --git a/src/ChangeLog b/src/ChangeLog
index 07e4a148ba2..e01c70f3dce 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,14 @@
+2014-10-08  Leo Liu  <sdl.web@gmail.com>
+
+        Enhance terpri to allow conditionally output a newline.  (Bug#18652)
+        * keymap.c (describe_vector_princ):
+        * keyboard.c (Fcommand_error_default_function): Adapt to change to
+        Fterpri.
+
+        * print.c (printchar_stdout_last): Declare.
+        (printchar): Record the last char written to stdout.
+        (Fterpri): Add optional argument ENSURE.
+
 2014-10-08  Eli Zaretskii  <eliz@gnu.org>
 
         * w32inevt.c (maybe_generate_resize_event): Pass non-zero as the
diff --git a/src/keyboard.c b/src/keyboard.c
index 0d042132d8e..6730536dc1d 100644
--- a/src/keyboard.c
+++ b/src/keyboard.c
@@ -1126,7 +1126,7 @@ Default value of `command-error-function'.  */)
     {
       print_error_message (data, Qexternal_debugging_output,
                            SSDATA (context), signal);
-      Fterpri (Qexternal_debugging_output);
+      Fterpri (Qexternal_debugging_output, Qnil);
       Fkill_emacs (make_number (-1));
     }
   else
diff --git a/src/keymap.c b/src/keymap.c
index fa2d4e942b8..d633bdcaae7 100644
--- a/src/keymap.c
+++ b/src/keymap.c
@@ -3364,7 +3364,7 @@ describe_vector_princ (Lisp_Object elt, Lisp_Object fun)
 {
   Findent_to (make_number (16), make_number (1));
   call1 (fun, elt);
-  Fterpri (Qnil);
+  Fterpri (Qnil, Qnil);
 }
 
 DEFUN ("describe-vector", Fdescribe_vector, Sdescribe_vector, 1, 2, 0,
diff --git a/src/print.c b/src/print.c
index 7381db61211..49331ef0984 100644
--- a/src/print.c
+++ b/src/print.c
@@ -58,6 +58,9 @@ static ptrdiff_t new_backquote_output;
 #define PRINT_CIRCLE 200
 static Lisp_Object being_printed[PRINT_CIRCLE];
 
+/* Last char printed to stdout by printchar.  */
+static unsigned int printchar_stdout_last;
+
 /* When printing into a buffer, first we put the text in this
    block, then insert it all at once.  */
 static char *print_buffer;
@@ -238,6 +241,7 @@ printchar (unsigned int ch, Lisp_Object fun)
         }
       else if (noninteractive)
         {
+          printchar_stdout_last = ch;
           fwrite (str, 1, len, stdout);
           noninteractive_need_newline = 1;
         }
@@ -515,19 +519,33 @@ static void print_preprocess (Lisp_Object);
 static void print_preprocess_string (INTERVAL, Lisp_Object);
 static void print_object (Lisp_Object, Lisp_Object, bool);
 
-DEFUN ("terpri", Fterpri, Sterpri, 0, 1, 0,
+DEFUN ("terpri", Fterpri, Sterpri, 0, 2, 0,
        doc: /* Output a newline to stream PRINTCHARFUN.
+If ENSURE is non-nil only output a newline if not already at the
+beginning of a line.  Value is non-nil if a newline is printed.
 If PRINTCHARFUN is omitted or nil, the value of `standard-output' is used.  */)
-  (Lisp_Object printcharfun)
+  (Lisp_Object printcharfun, Lisp_Object ensure)
 {
-  PRINTDECLARE;
+  Lisp_Object val = Qnil;
 
+  PRINTDECLARE;
   if (NILP (printcharfun))
     printcharfun = Vstandard_output;
   PRINTPREPARE;
-  PRINTCHAR ('\n');
+
+  if (NILP (ensure))
+    val = Qt;
+  /* Difficult to check if at line beginning so abort.  */
+  else if (FUNCTIONP (printcharfun))
+    signal_error ("Unsupported function argument", printcharfun);
+  else if (noninteractive && !NILP (printcharfun))
+    val = printchar_stdout_last == 10 ? Qnil : Qt;
+  else if (NILP (Fbolp ()))
+    val = Qt;
+
+  if (!NILP (val)) PRINTCHAR ('\n');
   PRINTFINISH;
-  return Qt;
+  return val;
 }
 
 DEFUN ("prin1", Fprin1, Sprin1, 1, 2, 0,