[Emacs-diffs] trunk r118076: Enhance terpri to allow conditionally output a newline

[Leo Liu]

------------------------------------------------------------
revno: 118076
revision-id: address@hidden
parent: address@hidden
fixes bug: http://debbugs.gnu.org/18652
committer: Leo Liu <address@hidden>
branch nick: trunk
timestamp: Thu 2014-10-09 06:05:48 +0800
message:
  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)
added:
  test/automated/print-tests.el  printtests.el-20141008164835-ijb2swwjb1ypi1tv-1
modified:
  doc/lispref/ChangeLog          changelog-20091113204419-o5vbwnq5f7feedwu-6155
  doc/lispref/streams.texi       
streams.texi-20091113204419-o5vbwnq5f7feedwu-6211
  doc/misc/ChangeLog             changelog-20091113204419-o5vbwnq5f7feedwu-6331
  doc/misc/cl.texi               cl.texi-20091113204419-o5vbwnq5f7feedwu-6292
  lisp/ChangeLog                 changelog-20091113204419-o5vbwnq5f7feedwu-1432
  lisp/emacs-lisp/cl-extra.el    clextra.el-20091113204419-o5vbwnq5f7feedwu-611
  src/ChangeLog                  changelog-20091113204419-o5vbwnq5f7feedwu-1438
  src/keyboard.c                 keyboard.c-20091113204419-o5vbwnq5f7feedwu-449
  src/keymap.c                   keymap.c-20091113204419-o5vbwnq5f7feedwu-219
  src/print.c                    print.c-20091113204419-o5vbwnq5f7feedwu-262
  test/ChangeLog                 changelog-20091113204419-o5vbwnq5f7feedwu-8588

=== modified file 'doc/lispref/ChangeLog'
--- a/doc/lispref/ChangeLog     2014-10-04 08:20:24 +0000
+++ b/doc/lispref/ChangeLog     2014-10-08 22:05:48 +0000
@@ -1,3 +1,8 @@
+2014-10-08  Leo Liu  <address@hidden>
+
+       * streams.texi (Output Functions): Document new argument ENSURE to
+       terpri.  (Bug#18652)
+
 2014-10-04  Martin Rudalics  <address@hidden>
 
        * display.texi (Scroll Bars): Add description of horizontal scroll

=== modified file 'doc/lispref/streams.texi'
--- a/doc/lispref/streams.texi  2014-03-18 01:19:03 +0000
+++ b/doc/lispref/streams.texi  2014-10-08 22:05:48 +0000
@@ -615,10 +615,13 @@
 @end example
 @end defun
 
address@hidden terpri &optional stream
address@hidden 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

=== modified file 'doc/misc/ChangeLog'
--- a/doc/misc/ChangeLog        2014-10-06 18:26:24 +0000
+++ b/doc/misc/ChangeLog        2014-10-08 22:05:48 +0000
@@ -1,3 +1,7 @@
+2014-10-08  Leo Liu  <address@hidden>
+
+       * cl.texi (Porting Common Lisp): Remove parse-integer.
+
 2014-10-06  Ulf Jasper  <address@hidden>
 
        * newsticker.texi (Supported Formats): Fix order of subheading and

=== modified file 'doc/misc/cl.texi'
--- a/doc/misc/cl.texi  2014-09-26 00:15:21 +0000
+++ b/doc/misc/cl.texi  2014-10-08 22:05:48 +0000
@@ -4707,9 +4707,8 @@
 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},
address@hidden/dpb}, @code{parse-integer}, @code{cerror}.
+A few more notable Common Lisp features not included in this package:
address@hidden, @code{prog}, @code{ldb/dpb}, @code{cerror}.
 
 @item
 Recursion.  While recursion works in Emacs Lisp just like it

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2014-10-08 18:30:45 +0000
+++ b/lisp/ChangeLog    2014-10-08 22:05:48 +0000
@@ -1,3 +1,7 @@
+2014-10-08  Leo Liu  <address@hidden>
+
+       * emacs-lisp/cl-extra.el (cl-fresh-line): New function.
+
 2014-10-08  Glenn Morris  <address@hidden>
 
        * calendar/cal-x.el (calendar-dedicate-diary):

=== modified file 'lisp/emacs-lisp/cl-extra.el'
--- a/lisp/emacs-lisp/cl-extra.el       2014-09-26 02:01:17 +0000
+++ b/lisp/emacs-lisp/cl-extra.el       2014-10-08 22:05:48 +0000
@@ -647,6 +647,13 @@
        (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)

=== modified file 'src/ChangeLog'
--- a/src/ChangeLog     2014-10-08 12:32:38 +0000
+++ b/src/ChangeLog     2014-10-08 22:05:48 +0000
@@ -1,3 +1,14 @@
+2014-10-08  Leo Liu  <address@hidden>
+
+       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  <address@hidden>
 
        * w32inevt.c (maybe_generate_resize_event): Pass non-zero as the

=== modified file 'src/keyboard.c'
--- a/src/keyboard.c    2014-10-05 23:18:31 +0000
+++ b/src/keyboard.c    2014-10-08 22:05:48 +0000
@@ -1126,7 +1126,7 @@
     {
       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

=== modified file 'src/keymap.c'
--- a/src/keymap.c      2014-10-01 03:28:16 +0000
+++ b/src/keymap.c      2014-10-08 22:05:48 +0000
@@ -3364,7 +3364,7 @@
 {
   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,

=== modified file 'src/print.c'
--- a/src/print.c       2014-09-11 06:21:55 +0000
+++ b/src/print.c       2014-10-08 22:05:48 +0000
@@ -58,6 +58,9 @@
 #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 @@
        }
       else if (noninteractive)
        {
+         printchar_stdout_last = ch;
          fwrite (str, 1, len, stdout);
          noninteractive_need_newline = 1;
        }
@@ -515,19 +519,33 @@
 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)
 {
+  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,

=== modified file 'test/ChangeLog'
--- a/test/ChangeLog    2014-10-06 02:02:04 +0000
+++ b/test/ChangeLog    2014-10-08 22:05:48 +0000
@@ -1,3 +1,8 @@
+2014-10-08  Leo Liu  <address@hidden>
+
+       * automated/print-tests.el: New file.
+       (terpri): Tests for terpri.  (Bug#18652)
+
 2014-10-06  Glenn Morris  <address@hidden>
 
        * automated/icalendar-tests.el (icalendar--calendar-style):

=== added file 'test/automated/print-tests.el'
--- a/test/automated/print-tests.el     1970-01-01 00:00:00 +0000
+++ b/test/automated/print-tests.el     2014-10-08 22:05:48 +0000
@@ -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