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)

12 files changed, 125 insertions, 13 deletions

diff --git a/doc/lispref/ChangeLog b/doc/lispref/ChangeLog
index 510f9e983c3..4d4d0b529cc 100644
--- a/doc/lispref/ChangeLog
+++ b/doc/lispref/ChangeLog
@@ -1,3 +1,8 @@
+2014-10-08  Leo Liu  <sdl.web@gmail.com>
+
+        * streams.texi (Output Functions): Document new argument ENSURE to
+        terpri.  (Bug#18652)
+
 2014-10-04  Martin Rudalics  <rudalics@gmx.at>
 
         * display.texi (Scroll Bars): Add description of horizontal scroll
diff --git a/doc/lispref/streams.texi b/doc/lispref/streams.texi
index 1d549ae8916..c287b617713 100644
--- a/doc/lispref/streams.texi
+++ b/doc/lispref/streams.texi
@@ -615,10 +615,13 @@ spacing between calls.
 @end example
 @end defun
 
-@defun terpri &optional stream
+@defun terpri &optional stream ensure
 @cindex newline in print
-This function outputs a newline to @var{stream}.  The name stands
-for ``terminate print''.
+This function outputs a newline to @var{stream}.  The name stands for
+``terminate print''.  If @var{ensure} is non-nil no newline is printed
+if @var{stream} is already at the beginning of a line.  Note in this
+case @var{stream} can not be a function and an error is signalled if
+it is.  This function returns @code{t} if a newline is printed.
 @end defun
 
 @defun write-char character &optional stream
diff --git a/doc/misc/ChangeLog b/doc/misc/ChangeLog
index 050c3339c8b..70207de3b3b 100644
--- a/doc/misc/ChangeLog
+++ b/doc/misc/ChangeLog
@@ -1,3 +1,7 @@
+2014-10-08  Leo Liu  <sdl.web@gmail.com>
+
+        * cl.texi (Porting Common Lisp): Remove parse-integer.
+
 2014-10-06  Ulf Jasper  <ulf.jasper@web.de>
 
         * newsticker.texi (Supported Formats): Fix order of subheading and
diff --git a/doc/misc/cl.texi b/doc/misc/cl.texi
index 04a0e5725e8..c15918afc4e 100644
--- a/doc/misc/cl.texi
+++ b/doc/misc/cl.texi
@@ -4707,9 +4707,8 @@ exactly the same thing, so this package has not bothered to
 implement a Common Lisp-style @code{make-list}.
 
 @item
-A few more notable Common Lisp features not included in this
-package:  @code{compiler-let}, @code{tagbody}, @code{prog},
-@code{ldb/dpb}, @code{parse-integer}, @code{cerror}.
+A few more notable Common Lisp features not included in this package:
+@code{compiler-let}, @code{prog}, @code{ldb/dpb}, @code{cerror}.
 
 @item
 Recursion.  While recursion works in Emacs Lisp just like it
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index ef1bdfba0d6..87852d64a46 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,7 @@
+2014-10-08  Leo Liu  <sdl.web@gmail.com>
+
+        * emacs-lisp/cl-extra.el (cl-fresh-line): New function.
+
 2014-10-08  Glenn Morris  <rgm@gnu.org>
 
         * calendar/cal-x.el (calendar-dedicate-diary):
diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el
index e10844069ef..a7970261608 100644
--- a/lisp/emacs-lisp/cl-extra.el
+++ b/lisp/emacs-lisp/cl-extra.el
@@ -647,6 +647,13 @@ PROPLIST is a list of the sort returned by `symbol-plist'.
         (progn (setplist sym (cdr (cdr plist))) t)
       (cl--do-remf plist tag))))
 
+;;; Streams.
+
+;;;###autoload
+(defun cl-fresh-line (&optional stream)
+  "Output a newline unless already at the beginning of a line."
+  (terpri stream 'ensure))
+
 ;;; Some debugging aids.
 
 (defun cl-prettyprint (form)
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,
diff --git a/test/ChangeLog b/test/ChangeLog
index 3d930be56c1..5c2032e7e85 100644
--- a/test/ChangeLog
+++ b/test/ChangeLog
@@ -1,3 +1,8 @@
+2014-10-08  Leo Liu  <sdl.web@gmail.com>
+
+        * automated/print-tests.el: New file.
+        (terpri): Tests for terpri.  (Bug#18652)
+
 2014-10-06  Glenn Morris  <rgm@gnu.org>
 
         * automated/icalendar-tests.el (icalendar--calendar-style):
diff --git a/test/automated/print-tests.el b/test/automated/print-tests.el
new file mode 100644
index 00000000000..1974cc452a6
--- /dev/null
+++ b/test/automated/print-tests.el
@@ -0,0 +1,56 @@
+;;; print-tests.el --- tests for src/print.c         -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2014 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'ert)
+
+(ert-deftest terpri ()
+  (should (string= (with-output-to-string
+                     (princ 'abc)
+                     (should (terpri nil t)))
+                   "abc\n"))
+  (should (string= (with-output-to-string
+                     (should-not (terpri nil t))
+                     (princ 'xyz))
+                   "xyz"))
+  (message nil)
+  (if noninteractive
+      (progn (should            (terpri nil t))
+             (should-not        (terpri nil t))
+             (princ 'abc)
+             (should            (terpri nil t))
+             (should-not        (terpri nil t)))
+    (should (string= (progn (should-not (terpri nil t))
+                            (princ 'abc)
+                            (should (terpri nil t))
+                            (current-message))
+                     "abc\n")))
+  (let ((standard-output
+         (with-current-buffer (get-buffer-create "*terpri-test*")
+           (insert "--------")
+           (point-max-marker))))
+    (should     (terpri nil t))
+    (should-not (terpri nil t))
+    (should (string= (with-current-buffer (marker-buffer standard-output)
+                       (buffer-string))
+                     "--------\n"))))
+
+(provide 'print-tests)
+;;; print-tests.el ends here