From 2dbd7a37a809e2dcef6c8e7323ac15c98b051cd9 Mon Sep 17 00:00:00 2001 From: Leo Liu Date: Thu, 9 Oct 2014 06:05:48 +0800 Subject: [PATCH] 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) --- doc/lispref/ChangeLog | 5 ++++ doc/lispref/streams.texi | 9 ++++-- doc/misc/ChangeLog | 4 +++ doc/misc/cl.texi | 5 ++-- lisp/ChangeLog | 4 +++ lisp/emacs-lisp/cl-extra.el | 7 +++++ src/ChangeLog | 11 +++++++ src/keyboard.c | 2 +- src/keymap.c | 2 +- src/print.c | 28 ++++++++++++++---- test/ChangeLog | 5 ++++ test/automated/print-tests.el | 56 +++++++++++++++++++++++++++++++++++ 12 files changed, 125 insertions(+), 13 deletions(-) create mode 100644 test/automated/print-tests.el 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 + + * streams.texi (Output Functions): Document new argument ENSURE to + terpri. (Bug#18652) + 2014-10-04 Martin Rudalics * 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 + + * cl.texi (Porting Common Lisp): Remove parse-integer. + 2014-10-06 Ulf Jasper * 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 + + * emacs-lisp/cl-extra.el (cl-fresh-line): New function. + 2014-10-08 Glenn Morris * 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 + + 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 * 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 + + * automated/print-tests.el: New file. + (terpri): Tests for terpri. (Bug#18652) + 2014-10-06 Glenn Morris * 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 . + +;;; 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 -- 2.39.5